1 files changed, 416 insertions, 0 deletions
diff --git a/.config/emacs/lisp/libs/compat-31.el b/.config/emacs/lisp/libs/compat-31.el
new file mode 100644
index 0000000..2b61749
--- /dev/null
+++ b/.config/emacs/lisp/libs/compat-31.el
@@ -0,0 +1,416 @@
+;;; compat-31.el --- Functionality added in Emacs 31 -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025-2026 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Functionality added in Emacs 31, needed by older Emacs versions.
+
+;;; Code:
+
+(eval-when-compile (load "compat-macs.el" nil t t))
+(compat-require compat-30 "30.1")
+
+;; TODO Update to 31.1 as soon as the Emacs emacs-31 branch version bumped
+(compat-version "31.0.50")
+
+;;;; Defined in subr.el
+
+(compat-defun error-type-p (symbol) ;; <compat-tests:error-api>
+  "Return non-nil if SYMBOL is a condition type."
+  (get symbol 'error-conditions))
+
+(compat-defun error-has-type-p (error condition) ;; <compat-tests:error-api>
+  "Return non-nil if ERROR is of type CONDITION (or a subtype of it)."
+  (unless (let ((type (car-safe error)))
+            (and type (symbolp type) (listp (cdr error))
+                 (error-type-p type)))
+    (signal 'wrong-type-argument (list error)))
+  (or (eq condition t)
+      (memq condition (get (car error) 'error-conditions))))
+
+(compat-defalias error-type car ;; <compat-tests:error-api>
+ "Return the symbol which represents the type of ERROR.
+\n(fn ERROR)")
+
+(compat-defalias error-slot-value elt ;; <compat-tests:error-api>
+  "Access the SLOT of object ERROR.
+Slots are specified by position, and slot 0 is the error symbol.
+\n(fn ERROR SLOT)")
+
+(compat-defun ensure-proper-list (object) ;; <compat-tests:ensure-proper-list>
+  "Return OBJECT as a list.
+If OBJECT is already a proper list, return OBJECT itself.  If it's not a
+proper list, return a one-element list containing OBJECT.
+
+`ensure-list' is usually preferable because that function runs in
+constant time, but this one has to traverse the whole of OBJECT."
+  (declare (side-effect-free error-free))
+  (if (proper-list-p object)
+      object
+    (list object)))
+
+(compat-defun set-local (variable value) ;; <compat-tests:set-local>
+  "Make VARIABLE buffer local and set it to VALUE."
+  (set (make-local-variable variable) value))
+
+(compat-defun take-while (pred list) ;; <compat-tests:take-while>
+  "Return the longest prefix of LIST whose elements satisfy PRED."
+  (let ((r nil))
+    (while (and list (funcall pred (car list)))
+      (push (car list) r)
+      (setq list (cdr list)))
+    (nreverse r)))
+
+(compat-defun drop-while (pred list) ;; <compat-tests:drop-while>
+  "Skip initial elements of LIST satisfying PRED and return the rest."
+  (while (and list (funcall pred (car list)))
+    (setq list (cdr list)))
+  list)
+
+(compat-defun all (pred list) ;; <compat-tests:all>
+  "Non-nil if PRED is true for all elements in LIST."
+  (not (drop-while pred list)))
+
+(compat-defun member-if (pred list) ;; <compat-tests:member-if>
+  "Non-nil if PRED is true for at least one element in LIST.
+Returns the LIST suffix starting at the first element that satisfies PRED,
+or nil if none does."
+  (drop-while (lambda (x) (not (funcall pred x))) list))
+
+(compat-defalias any member-if) ;; <compat-tests:member-if>
+
+(compat-defun hash-table-contains-p (key table) ;; <compat-tests:hash-table-contains-p>
+  "Return non-nil if TABLE has an element with KEY."
+  (declare (side-effect-free t))
+  (let ((missing '#:missing))
+    (not (eq (gethash key table missing) missing))))
+
+(compat-defmacro static-when (condition &rest body) ;; <compat-tests:static-when>
+  "A conditional compilation macro.
+Evaluate CONDITION at macro-expansion time.  If it is non-nil,
+expand the macro to evaluate all BODY forms sequentially and return
+the value of the last one, or nil if there are none."
+  (declare (indent 1) (debug t))
+  (if body
+      (if (eval condition lexical-binding)
+          (cons 'progn body)
+        nil)
+    (macroexp-warn-and-return (format-message "`static-when' with empty body")
+                              (list 'progn nil nil) '(empty-body static-when) t)))
+
+(compat-defmacro static-unless (condition &rest body) ;; <compat-tests:static-unless>
+  "A conditional compilation macro.
+Evaluate CONDITION at macro-expansion time.  If it is nil,
+expand the macro to evaluate all BODY forms sequentially and return
+the value of the last one, or nil if there are none."
+  (declare (indent 1) (debug t))
+  (if body
+      (if (eval condition lexical-binding)
+          nil
+        (cons 'progn body))
+    (macroexp-warn-and-return (format-message "`static-unless' with empty body")
+                              (list 'progn nil nil) '(empty-body static-unless) t)))
+
+(compat-defun oddp (integer) ;; <compat-tests:oddp>
+  "Return t if INTEGER is odd."
+  (not (eq (% integer 2) 0)))
+
+(compat-defun evenp (integer) ;; <compat-tests:evenp>
+  "Return t if INTEGER is even."
+  (eq (% integer 2) 0))
+
+(compat-defun plusp (number) ;; <compat-tests:plusp>
+  "Return t if NUMBER is positive."
+  (> number 0))
+
+(compat-defun minusp (number) ;; <compat-tests:minusp>
+  "Return t if NUMBER is negative."
+  (< number 0))
+
+(compat-defmacro incf (place &optional delta) ;; <compat-tests:incf>
+  "Increment PLACE by DELTA (default to 1).
+
+The DELTA is first added to PLACE, and then stored in PLACE.
+Return the incremented value of PLACE.
+
+See also `decf'."
+  (gv-letplace (getter setter) place
+    (funcall setter `(+ ,getter ,(or delta 1)))))
+
+(compat-defmacro decf (place &optional delta) ;; <compat-tests:decf>
+  "Decrement PLACE by DELTA (default to 1).
+
+The DELTA is first subtracted from PLACE, and then stored in PLACE.
+Return the decremented value of PLACE.
+
+See also `incf'."
+  (gv-letplace (getter setter) place
+    (funcall setter `(- ,getter ,(or delta 1)))))
+
+;;;; Defined in color.el
+
+(compat-defun color-blend (a b &optional alpha) ;; <compat-tests:color-blend>
+  "Blend the two colors A and B in linear space with ALPHA.
+A and B should be lists (RED GREEN BLUE), where each element is
+between 0.0 and 1.0, inclusive.  ALPHA controls the influence A
+has on the result and should be between 0.0 and 1.0, inclusive.
+
+For instance:
+
+   (color-blend \\='(1 0.5 1) \\='(0 0 0) 0.75)
+      => (0.75 0.375 0.75)"
+  (setq alpha (or alpha 0.5))
+  (let (blend)
+    (dotimes (i 3)
+      (push (+ (* (nth i a) alpha) (* (nth i b) (- 1 alpha))) blend))
+    (nreverse blend)))
+
+;;;; Defined in time-date.el
+
+(compat-defvar seconds-to-string ;; <compat-tests:seconds-to-string>
+  (list (list 1 "ms" 0.001)
+        (list 100 "s" 1)
+        (list (* 60 100) "m" 60.0)
+        (list (* 3600 30) "h" 3600.0)
+        (list (* 3600 24 400) "d" (* 3600.0 24.0))
+        (list nil "y" (* 365.25 24 3600)))
+  "Formatting used by the function `seconds-to-string'.")
+
+(compat-defvar seconds-to-string-readable ;; <compat-tests:seconds-to-string>
+  `(("Y" "year"   "years"   ,(round (* 60 60 24 365.2425)))
+    ("M" "month"  "months"  ,(round (* 60 60 24 30.436875)))
+    ("w" "week"   "weeks"   ,(* 60 60 24 7))
+    ("d" "day"    "days"    ,(* 60 60 24))
+    ("h" "hour"   "hours"   ,(* 60 60))
+    ("m" "minute" "minutes" 60)
+    ("s" "second" "seconds" 1))
+  "Formatting used by the function `seconds-to-string' with READABLE set.
+The format is an alist, with string keys ABBREV-UNIT, and elements like:
+
+  (ABBREV-UNIT UNIT UNIT-PLURAL SECS)
+
+where UNIT is a unit of time, ABBREV-UNIT is the abbreviated form of
+UNIT, UNIT-PLURAL is the plural form of UNIT, and SECS is the number of
+seconds per UNIT.")
+
+(compat-defun seconds-to-string (delay &optional readable abbrev precision) ;; <compat-tests:seconds-to-string>
+  "Handle optional arguments READABLE, ABBREV and PRECISION."
+  :extended t
+  (cond
+   ((< delay 0)
+    (concat "-" (seconds-to-string (- delay) readable precision)))
+   (readable
+    (let* ((stsa seconds-to-string-readable)
+           (expanded (eq readable 'expanded))
+           digits
+           (round-to (cond
+                      ((wholenump precision)
+                       (setq digits precision)
+                       (expt 10 (- precision)))
+                      ((and (floatp precision) (< precision 1.))
+                       (setq digits (- (floor (log precision 10))))
+                       precision)
+                      (t (setq digits 0) 1)))
+           (dformat (if (> digits 0) (format "%%0.%df" digits)))
+           (padding (if abbrev "" " "))
+           here cnt cnt-pre here-pre cnt-val isfloatp)
+      (if (= (round delay round-to) 0)
+          (format "0%s" (if abbrev "s" " seconds"))
+        (while (and (setq here (pop stsa)) stsa
+                    (< (/ delay (nth 3 here)) 1)))
+        (or (and
+             expanded stsa 	; smaller unit remains
+             (progn
+               (setq
+                here-pre here here (car stsa)
+                cnt-pre (floor (/ (float delay) (nth 3 here-pre)))
+                cnt (round
+                     (/ (- (float delay) (* cnt-pre (nth 3 here-pre)))
+                        (nth 3 here))
+                     round-to))
+               (if (> cnt 0) t (setq cnt cnt-pre here here-pre here-pre nil))))
+            (setq cnt (round (/ (float delay) (nth 3 here)) round-to)))
+        (setq cnt-val (* cnt round-to)
+              isfloatp (and (> digits 0)
+                            (> (- cnt-val (floor cnt-val)) 0.)))
+        (cl-labels
+            ((unit (val here &optional plural)
+               (cond (abbrev (car here))
+                     ((and (not plural) (<= (floor val) 1)) (nth 1 here))
+                     (t (nth 2 here)))))
+          (concat
+           (when here-pre
+             (concat (number-to-string cnt-pre) padding
+                     (unit cnt-pre here-pre) " "))
+           (if isfloatp (format dformat cnt-val)
+             (number-to-string (floor cnt-val)))
+           padding
+           (unit cnt-val here isfloatp)))))) ; float formats are always plural
+   ((= 0 delay) "0s")
+   (t (let ((sts seconds-to-string) here)
+        (while (and (car (setq here (pop sts)))
+                    (<= (car here) delay)))
+        (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))
+
+;;;; Defined in minibuffer.el
+
+(compat-defun completion-list-candidate-at-point (&optional pt) ;; <compat-tests:completion-list-candidate-at-point>
+  "Candidate string and bounds at PT in completions buffer.
+The return value has the format (STR BEG END).
+The optional argument PT defaults to (point)."
+  (let ((pt (or pt (point))) beg end)
+    (cond
+     ((and (/= pt (point-max)) (get-text-property pt 'mouse-face))
+      (setq end pt beg (1+ pt)))
+     ((and (/= pt (point-min)) (get-text-property (1- pt) 'mouse-face))
+      (setq end (1- pt) beg pt)))
+    (when (and beg end)
+      (setq beg (previous-single-property-change beg 'mouse-face))
+      (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
+      (list (or (get-text-property beg 'completion--string)
+                (buffer-substring beg end))
+            beg end))))
+
+(compat-defun completion-table-with-metadata (table metadata) ;; <compat-tests:completion-table-with-metadata>
+  "Return new completion TABLE with METADATA.
+METADATA should be an alist of completion metadata.  See
+`completion-metadata' for a list of supported metadata."
+  (lambda (string pred action)
+    (if (eq action 'metadata)
+        `(metadata . ,metadata)
+      (complete-with-action action table string pred))))
+
+;;;; Defined in subr-x.el
+
+(compat-defun add-remove--display-text-property (start end spec value &optional object remove)  ;; <compat-tests:add-display-text-property>
+  "Helper function for `add-display-text-property' and `remove-display-text-property'."
+  (let ((sub-start start)
+        (sub-end 0)
+        (limit (if (stringp object)
+                   (min (length object) end)
+                 (min end (point-max))))
+        disp)
+    (while (< sub-end end)
+      (setq sub-end (next-single-property-change sub-start 'display object
+                                                 limit))
+      (if (not (setq disp (get-text-property sub-start 'display object)))
+          (unless remove
+            (put-text-property sub-start sub-end 'display (list spec value)
+                               object))
+        (let ((changed nil)
+              type)
+          (setq disp
+                (cond
+                 ((vectorp disp)
+                  (setq type 'vector)
+                  (seq-into disp 'list))
+                 ((or (not (consp (car-safe disp)))
+                      (eq (caar disp) 'margin))
+                  (setq type 'scalar)
+                  (list disp))
+                 (t
+                  (setq type 'list)
+                  disp)))
+          (when-let* ((old (assoc spec disp)))
+            (setq disp (if (eq type 'list)
+                           (remove old disp)
+                         (delete old disp))
+                  changed t))
+          (unless remove
+            (setq disp (cons (list spec value) disp)
+                  changed t))
+          (when changed
+            (if (not disp)
+                (remove-text-properties sub-start sub-end '(display nil) object)
+              (when (eq type 'vector)
+                (setq disp (seq-into disp 'vector)))
+              (put-text-property sub-start sub-end 'display disp object)))))
+      (setq sub-start sub-end))))
+
+(compat-defun remove-display-text-property (start end spec &optional object) ;; <compat-tests:remove-display-text-property>
+  "Remove the display specification SPEC from the text from START to END.
+SPEC is the car of the display specification to remove, e.g. `height'.
+If any text in the region has other display specifications, those specs
+are retained.
+
+OBJECT is either a string or a buffer to remove the specification from.
+If omitted, OBJECT defaults to the current buffer."
+  (add-remove--display-text-property start end spec nil object 'remove))
+
+(compat-defvar work-buffer-limit 10 ;; <compat-tests:with-work-buffer>
+  "Maximum number of reusable work buffers.
+When this limit is exceeded, newly allocated work buffers are
+automatically killed, which means that in a such case
+`with-work-buffer' becomes equivalent to `with-temp-buffer'.")
+
+;; On Emacs 29 and newer `kill-all-local-variables' has a KILL-PERMANENT argument.
+(static-if (< emacs-major-version 29) nil
+  (compat-defvar work-buffer--list nil ;; <compat-tests:with-work-buffer>
+    "List of work buffers.")
+
+  (compat-defun work-buffer--get () ;; <compat-tests:with-work-buffer>
+    "Get a work buffer."
+    (let ((buffer (pop work-buffer--list)))
+      (if (buffer-live-p buffer)
+          buffer
+        (generate-new-buffer " *work*" t))))
+
+  (compat-defun work-buffer--release (buffer) ;; <compat-tests:with-work-buffer>
+    "Release work BUFFER."
+    (if (buffer-live-p buffer)
+        (with-current-buffer buffer
+          (let ((inhibit-read-only t))
+            (erase-buffer)
+            (delete-all-overlays))
+          (let (change-major-mode-hook)
+            (setq buffer-read-only nil)
+            (kill-all-local-variables t))
+          (push buffer work-buffer--list)))
+    (when (> (length work-buffer--list) work-buffer-limit)
+      (mapc #'kill-buffer (nthcdr work-buffer-limit work-buffer--list))
+      (setq work-buffer--list (ntake work-buffer-limit work-buffer--list)))))
+
+(compat-defmacro with-work-buffer (&rest body) ;; <compat-tests:with-work-buffer>
+  "Create a work buffer, and evaluate BODY there like `progn'.
+Like `with-temp-buffer', but reuse an already created temporary buffer
+when possible, instead of creating a new one on each call.  Avoid
+retaining state referring to a work buffer, and kill any indirect
+buffers you create that use a work buffer as a base."
+  (declare (indent 0) (debug t))
+  (static-if (< emacs-major-version 29)
+      `(with-temp-buffer ,@body)
+    (let ((work-buffer (make-symbol "work-buffer")))
+      `(let ((,work-buffer (work-buffer--get)))
+         (with-current-buffer ,work-buffer
+           (unwind-protect
+               (progn ,@body)
+             (work-buffer--release ,work-buffer)))))))
+
+;;;; Defined in button.el
+
+(compat-defun unbuttonize-region (start end) ;; <compat-tests:buttonize-region>
+  "Remove all the buttons between START and END.
+This removes both text-property and overlay based buttons."
+  (dolist (o (overlays-in start end))
+    (when (overlay-get o 'button)
+      (delete-overlay o)))
+  (with-silent-modifications
+    (remove-text-properties start end (button--properties nil nil nil))
+    (add-face-text-property start end 'button nil)))
+
+(provide 'compat-31)
+;;; compat-31.el ends here