daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update of packages

Browse Source
This commit is contained in:
Daniel Weschke
2023-11-04 19:26:41 +01:00
parent e162a12b58
commit 3b54a3236d
726 changed files with 297673 additions and 34585 deletions
Download Patch File Download Diff File Expand all files Collapse all files

251
lisp/compat/compat-25.el
View File

@@ -1,11 +1,6 @@
;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*-
;;; compat-25.el --- Functionality added in Emacs 25.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
;; Copyright (C) 2021-2023 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
@@ -22,23 +17,17 @@
;;; Commentary:
;; Find here the functionality added in Emacs 25.1, needed by older
;; versions.
;;
;; Only load this library if you need to use one of the following
;; functions:
;;
;; - `compat-sort'
;; Functionality added in Emacs 25.1, needed by older Emacs versions.
;;; Code:
(require 'compat-macs "compat-macs.el")
(eval-when-compile (load "compat-macs.el" nil t t))
(compat-declare-version "25.1")
(compat-version "25.1")
;;;; Defined in alloc.c
(compat-defun bool-vector (&rest objects)
(compat-defun bool-vector (&rest objects) ;; <compat-tests:bool-vector>
"Return a new bool-vector with specified arguments as elements.
Allows any number of arguments, including zero.
usage: (bool-vector &rest OBJECTS)"
@@ -53,53 +42,77 @@ usage: (bool-vector &rest OBJECTS)"
;;;; Defined in fns.c
(compat-defun sort (seq predicate)
"Extend `sort' to sort SEQ as a vector."
:prefix t
(compat-defun sort (seq predicate) ;; <compat-tests:sort>
"Handle vector SEQ."
:extended t
(cond
((listp seq)
(sort seq predicate))
((vectorp seq)
(let ((cseq (sort (append seq nil) predicate)))
(dotimes (i (length cseq))
(setf (aref seq i) (nth i cseq)))
(apply #'vector cseq)))
(let* ((list (sort (append seq nil) predicate))
(p list) (i 0))
(while p
(aset seq i (car p))
(setq i (1+ i) p (cdr p)))
(apply #'vector list)))
((signal 'wrong-type-argument 'list-or-vector-p))))
;;;; Defined in editfns.c
(compat-defun format-message (string &rest objects)
"Format a string out of a format-string and arguments.
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
This implementation is equivalent to `format'."
(apply #'format string objects))
;;;; Defined in minibuf.c
;; TODO advise read-buffer to handle 4th argument
(compat-defalias format-message format) ;; <compat-tests:format-message>
;;;; Defined in fileio.c
(compat-defun directory-name-p (name)
(compat-defun directory-name-p (name) ;; <compat-tests:directory-name-p>
"Return non-nil if NAME ends with a directory separator character."
:realname compat--directory-name-p
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
(aref name (1- (length name)))))
;;;; Defined in doc.c
(compat-defvar text-quoting-style nil ;; <compat-tests:text-quoting-style>
"Style to use for single quotes in help and messages.
The value of this variable determines substitution of grave accents
and apostrophes in help output (but not for display of Info
manuals) and in functions like `message' and `format-message', but not
in `format'.
The value should be one of these symbols:
`curve': quote with curved single quotes ‘like this’.
`straight': quote with straight apostrophes \\='like this\\='.
`grave': quote with grave accent and apostrophe \\=`like this\\=';
i.e., do not alter the original quote marks.
nil: like `curve' if curved single quotes are displayable,
and like `grave' otherwise. This is the default.
You should never read the value of this variable directly from a Lisp
program. Use the function `text-quoting-style' instead, as that will
compute the correct value for the current terminal in the nil case.")
;;;; Defined in simple.el
;; `save-excursion' behaved like `save-mark-and-excursion' before 25.1.
(compat-defalias save-mark-and-excursion save-excursion) ;; <compat-tests:save-mark-and-excursion>
(declare-function region-bounds nil) ;; Defined in compat-26.el
(compat-defun region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p>
"Return non-nil if the region contains several pieces.
An example is a rectangular region handled as a list of
separate contiguous regions for each line."
(let ((bounds (region-bounds))) (and (cdr bounds) bounds)))
;;;; Defined in subr.el
(compat-defun string-greaterp (string1 string2)
(compat-defun string-greaterp (string1 string2) ;; <compat-tests:string-greaterp>
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead."
(string-lessp string2 string1))
;;* UNTESTED
(compat-defmacro with-file-modes (modes &rest body)
(compat-defmacro with-file-modes (modes &rest body) ;; <compat-tests:with-file-modes>
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
(declare (indent 1) (debug t))
@@ -111,28 +124,7 @@ MODES is as for `set-default-file-modes'."
,@body)
(set-default-file-modes ,umask)))))
(compat-defun alist-get (key alist &optional default remove testfn)
"Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
If KEY is not found in ALIST, return DEFAULT.
Equality with KEY is tested by TESTFN, defaulting to `eq'."
:realname compat--alist-get-full-elisp
(ignore remove)
(let (entry)
(cond
((or (null testfn) (eq testfn 'eq))
(setq entry (assq key alist)))
((eq testfn 'equal)
(setq entry (assoc key alist)))
((catch 'found
(dolist (ent alist)
(when (and (consp ent) (funcall testfn (car ent) key))
(throw 'found (setq entry ent))))
default)))
(if entry (cdr entry) default)))
;;;; Defined in subr-x.el
(compat-defmacro if-let (spec then &rest else)
(compat-defmacro if-let (spec then &rest else) ;; <compat-tests:if-let>
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
@@ -148,29 +140,40 @@ SYMBOL is checked for nil.
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
:realname compat--if-let
:feature 'subr-x
(declare (indent 2)
(debug ([&or (symbolp form)
(&rest [&or symbolp (symbolp form) (form)])]
body)))
(when (and (<= (length spec) 2)
(not (listp (car spec))))
(when (and (<= (length spec) 2) (not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
`(compat--if-let* ,spec ,then ,(macroexp-progn else)))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var spec)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(if (cdr var) (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 (spec &rest body)
(compat-defmacro when-let (spec &rest body) ;; <compat-tests:when-let>
"Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
If all are non-nil, return the value of the last form in BODY.
The variable list SPEC is the same as in `if-let'."
:feature 'subr-x
(declare (indent 1) (debug if-let))
`(compat--if-let ,spec ,(macroexp-progn body)))
(list 'if-let spec (macroexp-progn body)))
(compat-defmacro thread-first (&rest forms)
;;;; Defined in subr-x.el
(compat-defun hash-table-empty-p (hash-table) ;; <compat-tests:hash-table-empty-p>
"Check whether HASH-TABLE is empty (has 0 elements)."
(zerop (hash-table-count hash-table)))
(compat-defmacro thread-first (&rest forms) ;; <compat-tests:thread-first>
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
@@ -183,7 +186,6 @@ Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
(let ((body (car forms)))
@@ -195,7 +197,7 @@ threading."
(cdr form))))
body))
(compat-defmacro thread-last (&rest forms)
(compat-defmacro thread-last (&rest forms) ;; <compat-tests:thread-last>
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
@@ -208,7 +210,6 @@ Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1) (debug thread-first))
(let ((body (car forms)))
(dolist (form (cdr forms))
@@ -219,10 +220,31 @@ threading."
;;;; Defined in macroexp.el
(declare-function macrop nil (object))
(compat-defun macroexpand-1 (form &optional environment)
(compat-defun macroexp-parse-body (body) ;; <compat-tests:macroexp-parse-body>
"Parse a function BODY into (DECLARATIONS . EXPS)."
(let ((decls ()))
(while (and (cdr body)
(let ((e (car body)))
(or (stringp e)
(memq (car-safe e)
'(:documentation declare interactive cl-declare)))))
(push (pop body) decls))
(cons (nreverse decls) body)))
(compat-defun macroexp-quote (v) ;; <compat-tests:macroexp-quote>
"Return an expression E such that `(eval E)' is V.
E is either V or (quote V) depending on whether V evaluates to
itself or not."
(if (and (not (consp v))
(or (keywordp v)
(not (symbolp v))
(memq v '(nil t))))
v
(list 'quote v)))
(compat-defun macroexpand-1 (form &optional environment) ;; <compat-tests:macroexpand-1>
"Perform (at most) one step of macro expansion."
:feature 'macroexp
(cond
((consp form)
(let* ((head (car form))
@@ -245,78 +267,5 @@ threading."
form))))))))
(t form)))
;;;; Defined in byte-run.el
;;* UNTESTED
(compat-defun function-put (func prop value)
"Set FUNCTION's property PROP to VALUE.
The namespace for PROP is shared with symbols.
So far, FUNCTION can only be a symbol, not a lambda expression."
:version "24.4"
(put func prop value))
;;;; Defined in files.el
;;* UNTESTED
(compat-defun directory-files-recursively
(dir regexp &optional include-directories predicate follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
:realname compat--directory-files-recursively
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(condition-case nil
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
(compat--inhibit-prefixed (provide 'compat-25))
(provide 'compat-25)
;;; compat-25.el ends here