aboutsummaryrefslogtreecommitdiffstats
path: root/elpa/compat-28.1.1.0/compat-26.el
diff options
context:
space:
mode:
Diffstat (limited to 'elpa/compat-28.1.1.0/compat-26.el')
-rw-r--r--elpa/compat-28.1.1.0/compat-26.el623
1 files changed, 623 insertions, 0 deletions
diff --git a/elpa/compat-28.1.1.0/compat-26.el b/elpa/compat-28.1.1.0/compat-26.el
new file mode 100644
index 0000000..07ab3a4
--- /dev/null
+++ b/elpa/compat-28.1.1.0/compat-26.el
@@ -0,0 +1,623 @@
+;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
+;; URL: https://git.sr.ht/~pkal/compat/
+;; Keywords: lisp
+
+;; 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:
+
+;; Find here the functionality added in Emacs 26.1, needed by older
+;; versions.
+;;
+;; Do NOT load this library manually. Instead require `compat'.
+
+;;; Code:
+
+(eval-when-compile (require 'compat-macs))
+(declare-function compat-func-arity "compat" (func))
+
+;;;; Defined in eval.c
+
+(compat-defun func-arity (func)
+ "Return minimum and maximum number of args allowed for FUNC.
+FUNC must be a function of some kind.
+The returned value is a cons cell (MIN . MAX). MIN is the minimum number
+of args. MAX is the maximum number, or the symbol ‘many’, for a
+function with ‘&rest’ args, or ‘unevalled’ for a special form."
+ :realname compat--func-arity
+ (cond
+ ((or (null func) (and (symbolp func) (not (fboundp func))))
+ (signal 'void-function func))
+ ((and (symbolp func) (not (null func)))
+ (compat--func-arity (symbol-function func)))
+ ((eq (car-safe func) 'macro)
+ (compat--func-arity (cdr func)))
+ ((subrp func)
+ (subr-arity func))
+ ((memq (car-safe func) '(closure lambda))
+ ;; See lambda_arity from eval.c
+ (when (eq (car func) 'closure)
+ (setq func (cdr func)))
+ (let ((syms-left (if (consp func)
+ (car func)
+ (signal 'invalid-function func)))
+ (min-args 0) (max-args 0) optional)
+ (catch 'many
+ (dolist (next syms-left)
+ (cond
+ ((not (symbolp next))
+ (signal 'invalid-function func))
+ ((eq next '&rest)
+ (throw 'many (cons min-args 'many)))
+ ((eq next '&optional)
+ (setq optional t))
+ (t (unless optional
+ (setq min-args (1+ min-args)))
+ (setq max-args (1+ max-args)))))
+ (cons min-args max-args))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (numberp (aref func 0)))
+ ;; See get_byte_code_arity from bytecode.c
+ (let ((at (aref func 0)))
+ (cons (logand at 127)
+ (if (= (logand at 128) 0)
+ (ash at -8)
+ 'many))))
+ ((and (byte-code-function-p func) (listp (aref func 0)))
+ ;; Based on `byte-compile-make-args-desc', this is required for
+ ;; old versions of Emacs that don't use a integer for the argument
+ ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
+ (let ((arglist (aref func 0)) (mandatory 0) nonrest)
+ (while (and arglist (not (memq (car arglist) '(&optional &rest))))
+ (setq mandatory (1+ mandatory))
+ (setq arglist (cdr arglist)))
+ (setq nonrest mandatory)
+ (when (eq (car arglist) '&optional)
+ (setq arglist (cdr arglist))
+ (while (and arglist (not (eq (car arglist) '&rest)))
+ (setq nonrest (1+ nonrest))
+ (setq arglist (cdr arglist))))
+ (cons mandatory (if arglist 'many nonrest))))
+ ((autoloadp func)
+ (autoload-do-load func)
+ (compat--func-arity func))
+ ((signal 'invalid-function func))))
+
+;;;; Defined in fns.c
+
+(compat-defun assoc (key alist &optional testfn)
+ "Handle the optional argument TESTFN.
+Equality is defined by the function TESTFN, defaulting to
+‘equal’. TESTFN is called with 2 arguments: a car of an alist
+element and KEY. With no optional argument, the function behaves
+just like `assoc'."
+ :prefix t
+ (if testfn
+ (catch 'found
+ (dolist (ent alist)
+ (when (funcall testfn (car ent) key)
+ (throw 'found ent))))
+ (assoc key alist)))
+
+(compat-defun mapcan (func sequence)
+ "Apply FUNC to each element of SEQUENCE.
+Concatenate the results by altering them (using `nconc').
+SEQUENCE may be a list, a vector, a boolean vector, or a string."
+ (apply #'nconc (mapcar func sequence)))
+
+;;* UNTESTED
+(compat-defun line-number-at-pos (&optional position absolute)
+ "Handle optional argument ABSOLUTE:
+
+If the buffer is narrowed, the return value by default counts the lines
+from the beginning of the accessible portion of the buffer. But if the
+second optional argument ABSOLUTE is non-nil, the value counts the lines
+from the absolute start of the buffer, disregarding the narrowing."
+ :prefix t
+ (if absolute
+ (save-restriction
+ (widen)
+ (line-number-at-pos position))
+ (line-number-at-pos position)))
+
+;;;; Defined in subr.el
+
+(declare-function compat--alist-get-full-elisp "compat-25"
+ (key alist &optional default remove testfn))
+(compat-defun alist-get (key alist &optional default remove testfn)
+ "Handle TESTFN manually."
+ :realname compat--alist-get-handle-testfn
+ :prefix t
+ (if testfn
+ (compat--alist-get-full-elisp key alist default remove testfn)
+ (alist-get key alist default remove)))
+
+(gv-define-expander compat-alist-get
+ (lambda (do key alist &optional default remove testfn)
+ (macroexp-let2 macroexp-copyable-p k key
+ (gv-letplace (getter setter) alist
+ (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
+ (compat-assoc ,k ,getter ,testfn)
+ (assq ,k ,getter))
+ (funcall do (if (null default) `(cdr ,p)
+ `(if ,p (cdr ,p) ,default))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ (let ((set-exp
+ `(if ,p (setcdr ,p ,v)
+ ,(funcall setter
+ `(cons (setq ,p (cons ,k ,v))
+ ,getter)))))
+ `(progn
+ ,(cond
+ ((null remove) set-exp)
+ ((or (eql v default)
+ (and (eq (car-safe v) 'quote)
+ (eq (car-safe default) 'quote)
+ (eql (cadr v) (cadr default))))
+ `(if ,p ,(funcall setter `(delq ,p ,getter))))
+ (t
+ `(cond
+ ((not (eql ,default ,v)) ,set-exp)
+ (,p ,(funcall setter
+ `(delq ,p ,getter))))))
+ ,v))))))))))
+
+(compat-defun string-trim-left (string &optional regexp)
+ "Trim STRING of leading string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ :realname compat--string-trim-left
+ :prefix t
+ (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
+ (substring string (match-end 0))
+ string))
+
+(compat-defun string-trim-right (string &optional regexp)
+ "Trim STRING of trailing string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ :realname compat--string-trim-right
+ :prefix t
+ (let ((i (string-match-p
+ (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
+ string)))
+ (if i (substring string 0 i) string)))
+
+(compat-defun string-trim (string &optional trim-left trim-right)
+ "Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
+
+TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
+ :prefix t
+ ;; `string-trim-left' and `string-trim-right' were moved from subr-x
+ ;; to subr in Emacs 27, so to avoid loading subr-x we use the
+ ;; compatibility function here:
+ (compat--string-trim-left
+ (compat--string-trim-right
+ string
+ trim-right)
+ trim-left))
+
+(compat-defun caaar (x)
+ "Return the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (car (car x))))
+
+(compat-defun caadr (x)
+ "Return the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (cdr x))))
+
+(compat-defun cadar (x)
+ "Return the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (car x))))
+
+(compat-defun caddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (cdr x))))
+
+(compat-defun cdaar (x)
+ "Return the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (car x))))
+
+(compat-defun cdadr (x)
+ "Return the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (cdr x))))
+
+(compat-defun cddar (x)
+ "Return the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (car x))))
+
+(compat-defun cdddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr x))))
+
+(compat-defun caaaar (x)
+ "Return the `car' of the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (car (car (car x)))))
+
+(compat-defun caaadr (x)
+ "Return the `car' of the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (car (cdr x)))))
+
+(compat-defun caadar (x)
+ "Return the `car' of the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (car (cdr (car x)))))
+
+(compat-defun caaddr (x)
+ "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (car (cdr (cdr x)))))
+
+(compat-defun cadaar (x)
+ "Return the `car' of the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (car (car x)))))
+
+(compat-defun cadadr (x)
+ "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (car (cdr x)))))
+
+(compat-defun caddar (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (car (cdr (cdr (car x)))))
+
+(compat-defun cadddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (car (cdr (cdr (cdr x)))))
+
+(compat-defun cdaaar (x)
+ "Return the `cdr' of the `car' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (car (car x)))))
+
+(compat-defun cdaadr (x)
+ "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (car (cdr x)))))
+
+(compat-defun cdadar (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (car (cdr (car x)))))
+
+(compat-defun cdaddr (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (car (cdr (cdr x)))))
+
+(compat-defun cddaar (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (car (car x)))))
+
+(compat-defun cddadr (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (car (cdr x)))))
+
+(compat-defun cdddar (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr (car x)))))
+
+(compat-defun cddddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (pure t))
+ (cdr (cdr (cdr (cdr x)))))
+
+(compat-defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by `gensym'.")
+
+(compat-defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX is a string, and defaults to \"g\"."
+ (let ((num (prog1 gensym-counter
+ (setq gensym-counter
+ (1+ gensym-counter)))))
+ (make-symbol (format "%s%d" (or prefix "g") num))))
+
+;;;; Defined in files.el
+
+(declare-function temporary-file-directory nil)
+
+;;* UNTESTED
+(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
+ "Create a temporary file as close as possible to `default-directory'.
+If PREFIX is a relative file name, and `default-directory' is a
+remote file name or located on a mounted file systems, the
+temporary file is created in the directory returned by the
+function `temporary-file-directory'. Otherwise, the function
+`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
+same meaning as in `make-temp-file'."
+ (let ((handler (find-file-name-handler
+ default-directory 'make-nearby-temp-file)))
+ (if (and handler (not (file-name-absolute-p default-directory)))
+ (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
+ (let ((temporary-file-directory (temporary-file-directory)))
+ (make-temp-file prefix dir-flag suffix)))))
+
+(compat-defvar mounted-file-systems
+ (eval-when-compile
+ (if (memq system-type '(windows-nt cygwin))
+ "^//[^/]+/"
+ (concat
+ "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
+ "File systems that ought to be mounted.")
+
+(compat-defun file-local-name (file)
+ "Return the local name component of FILE.
+This function removes from FILE the specification of the remote host
+and the method of accessing the host, leaving only the part that
+identifies FILE locally on the remote system.
+The returned file name can be used directly as argument of
+`process-file', `start-file-process', or `shell-command'."
+ :realname compat--file-local-name
+ (or (file-remote-p file 'localname) file))
+
+(compat-defun file-name-quoted-p (name &optional top)
+ "Whether NAME is quoted with prefix \"/:\".
+If NAME is a remote file name and TOP is nil, check the local part of NAME."
+ :realname compat--file-name-quoted-p
+ (let ((file-name-handler-alist (unless top file-name-handler-alist)))
+ (string-prefix-p "/:" (compat--file-local-name name))))
+
+(compat-defun file-name-quote (name &optional top)
+ "Add the quotation prefix \"/:\" to file NAME.
+If NAME is a remote file name and TOP is nil, the local part of
+NAME is quoted. If NAME is already a quoted file name, NAME is
+returned unchanged."
+ (let ((file-name-handler-alist (unless top file-name-handler-alist)))
+ (if (compat--file-name-quoted-p name top)
+ name
+ (concat (file-remote-p name) "/:" (compat--file-local-name name)))))
+
+;;* UNTESTED
+(compat-defun temporary-file-directory ()
+ "The directory for writing temporary files.
+In case of a remote `default-directory', this is a directory for
+temporary files on that remote host. If such a directory does
+not exist, or `default-directory' ought to be located on a
+mounted file system (see `mounted-file-systems'), the function
+returns `default-directory'.
+For a non-remote and non-mounted `default-directory', the value of
+the variable `temporary-file-directory' is returned."
+ (let ((handler (find-file-name-handler
+ default-directory 'temporary-file-directory)))
+ (if handler
+ (funcall handler 'temporary-file-directory)
+ (if (string-match mounted-file-systems default-directory)
+ default-directory
+ temporary-file-directory))))
+
+;;* UNTESTED
+(compat-defun file-attribute-type (attributes)
+ "The type field in ATTRIBUTES returned by `file-attributes'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-link-number (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attributes'."
+ (nth 1 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-user-id (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-group-id (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-access-time (attributes)
+ "The last access time in ATTRIBUTES returned by `file-attributes'.
+This a Lisp timestamp in the style of `current-time'."
+ (nth 4 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-modification-time (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of the last change to the file's contents, and
+is a Lisp timestamp in the style of `current-time'."
+ (nth 5 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-status-change-time (attributes)
+ "The status modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of last change to the file's attributes: owner
+and group, access mode bits, etc., and is a Lisp timestamp in the
+style of `current-time'."
+ (nth 6 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-size (attributes)
+ "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
+ (nth 7 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-modes (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attributes'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-inode-number (attributes)
+ "The inode number in ATTRIBUTES returned by `file-attributes'.
+It is a nonnegative integer."
+ (nth 10 attributes))
+
+;;* UNTESTED
+(compat-defun file-attribute-device-number (attributes)
+ "The file system device number in ATTRIBUTES returned by `file-attributes'.
+It is an integer."
+ (nth 11 attributes))
+
+(compat-defun file-attribute-collect (attributes &rest attr-names)
+ "Return a sublist of ATTRIBUTES returned by `file-attributes'.
+ATTR-NAMES are symbols with the selected attribute names.
+
+Valid attribute names are: type, link-number, user-id, group-id,
+access-time, modification-time, status-change-time, size, modes,
+inode-number and device-number."
+ (let ((idx '((type . 0)
+ (link-number . 1)
+ (user-id . 2)
+ (group-id . 3)
+ (access-time . 4)
+ (modification-time . 5)
+ (status-change-time . 6)
+ (size . 7)
+ (modes . 8)
+ (inode-number . 10)
+ (device-number . 11)))
+ result)
+ (while attr-names
+ (let ((attr (pop attr-names)))
+ (if (assq attr idx)
+ (push (nth (cdr (assq attr idx))
+ attributes)
+ result)
+ (error "Wrong attribute name '%S'" attr))))
+ (nreverse result)))
+
+;;;; Defined in subr-x.el
+
+(compat-defmacro if-let* (varlist then &rest else)
+ "Bind variables according to VARLIST and evaluate THEN or ELSE.
+This is like `if-let' but doesn't handle a VARLIST of the form
+\(SYMBOL SOMETHING) specially."
+ :realname compat--if-let*
+ :feature 'subr-x
+ (declare (indent 2)
+ (debug ((&rest [&or symbolp (symbolp form) (form)])
+ body)))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (if ,(caar list) ,then ,@else))))
+
+(compat-defmacro when-let* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally evaluate BODY.
+This is like `when-let' but doesn't handle a VARLIST of the form
+\(SYMBOL SOMETHING) specially."
+ ;; :feature 'subr-x
+ (declare (indent 1) (debug if-let*))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (when ,(caar list) ,@body))))
+
+(compat-defmacro and-let* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally evaluate BODY.
+Like `when-let*', except if BODY is empty and all the bindings
+are non-nil, then the result is non-nil."
+ :feature 'subr-x
+ (declare (indent 1) (debug if-let*))
+ (let ((empty (make-symbol "s"))
+ (last t) list)
+ (dolist (var varlist)
+ (push `(,(if (cdr var) (car var) empty)
+ (and ,last ,(or (cadr var) (car var))))
+ list)
+ (when (or (cdr var) (consp (car var)))
+ (setq last (caar list))))
+ `(let* ,(nreverse list)
+ (if ,(caar list) ,(macroexp-progn (or body '(t)))))))
+
+;;;; Defined in image.el
+
+;;* UNTESTED
+(compat-defun image-property (image property)
+ "Return the value of PROPERTY in IMAGE.
+Properties can be set with
+
+ (setf (image-property IMAGE PROPERTY) VALUE)
+
+If VALUE is nil, PROPERTY is removed from IMAGE."
+ (plist-get (cdr image) property))
+
+;;* UNTESTED
+(unless (get 'image-property 'gv-expander)
+ (gv-define-setter image-property (image property value)
+ (let ((image* (make-symbol "image"))
+ (property* (make-symbol "property"))
+ (value* (make-symbol "value")))
+ `(let ((,image* ,image)
+ (,property* ,property)
+ (,value* ,value))
+ (if
+ (null ,value*)
+ (while
+ (cdr ,image*)
+ (if
+ (eq
+ (cadr ,image*)
+ ,property*)
+ (setcdr ,image*
+ (cdddr ,image*))
+ (setq ,image*
+ (cddr ,image*))))
+ (setcdr ,image*
+ (plist-put
+ (cdr ,image*)
+ ,property* ,value*)))))))
+
+(provide 'compat-26)
+;;; compat-26.el ends here