dotemacs

compat-25.el (7516B)

---

 ;;; compat-25.el --- Compatibility Layer for Emacs 25.1  -*- lexical-binding: t; -*-
 
 ;; 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
 ;; 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 25.1, needed by older
 ;; versions.
 
 ;;; Code:
 
 (eval-when-compile (load "compat-macs.el" nil t t))
 (compat-declare-version "25.1")
 
 ;;;; Defined in alloc.c
 
 (compat-defun bool-vector (&rest objects) ;; <OK>
   "Return a new bool-vector with specified arguments as elements.
 Allows any number of arguments, including zero.
 usage: (bool-vector &rest OBJECTS)"
   (let ((vec (make-bool-vector (length objects) nil))
         (i 0))
     (while objects
       (when (car objects)
         (aset vec i t))
       (setq objects (cdr objects)
             i (1+ i)))
     vec))
 
 ;;;; Defined in fns.c
 
 (compat-defun sort (seq predicate) ;; <OK>
   "Extend `sort' to sort SEQ as a vector."
   :explicit t
   (cond
    ((listp seq)
     (sort seq predicate))
    ((vectorp seq)
     (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-defalias format-message format) ;; <OK>
 
 ;;;; Defined in fileio.c
 
 (compat-defun directory-name-p (name) ;; <OK>
   "Return non-nil if NAME ends with a directory separator character."
   (eq (eval-when-compile
         (if (memq system-type '(cygwin windows-nt ms-dos))
             ?\\ ?/))
       (aref name (1- (length name)))))
 
 ;;;; Defined in subr.el
 
 (compat-defun string-greaterp (string1 string2) ;; <OK>
   "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))
 
 (compat-defmacro with-file-modes (modes &rest body) ;; <OK>
   "Execute BODY with default file permissions temporarily set to MODES.
 MODES is as for `set-default-file-modes'."
   (declare (indent 1) (debug t))
   (let ((umask (make-symbol "umask")))
     `(let ((,umask (default-file-modes)))
        (unwind-protect
            (progn
              (set-default-file-modes ,modes)
              ,@body)
          (set-default-file-modes ,umask)))))
 
 (compat-defun alist-get (key alist &optional default remove) ;; <OK>
   "Return the value associated with KEY in ALIST, using `assq'.
 If KEY is not found in ALIST, return DEFAULT.
 This is a generalized variable suitable for use with `setf'.
 When using it to set a value, optional argument REMOVE non-nil
 means to remove KEY from ALIST if the new value is `eql' to DEFAULT."
   (ignore remove)
   (let ((x (assq key alist)))
     (if x (cdr x) default)))
 
 (compat-defmacro if-let (spec then &rest else) ;; <OK>
   "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
 THEN, otherwise the last form in ELSE.
 
 Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
 SYMBOL to the value of VALUEFORM.  An element can additionally be
 of the form (VALUEFORM), which is evaluated and checked for nil;
 i.e. SYMBOL can be omitted if only the test result is of
 interest.  It can also be of the form SYMBOL, then the binding of
 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."
   (declare (indent 2)
            (debug ([&or (symbolp form)
                         (&rest [&or symbolp (symbolp form) (form)])]
                    body)))
   (when (and (<= (length spec) 2) (not (listp (car spec))))
     ;; Adjust the single binding case
     (setq spec (list spec)))
   (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) ;; <OK>
   "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'."
   (declare (indent 1) (debug if-let))
   (list 'if-let spec (macroexp-progn body)))
 
 ;;;; Defined in subr-x.el
 
 (compat-defmacro thread-first (&rest forms) ;; <OK>
   "Thread FORMS elements as the first argument of their successor.
 Example:
     (thread-first
       5
       (+ 20)
       (/ 25)
       -
       (+ 40))
 Is equivalent to:
     (+ (- (/ (+ 5 20) 25)) 40)
 Note how the single `-' got converted into a list before
 threading."
   (declare (indent 1)
            (debug (form &rest [&or symbolp (sexp &rest form)])))
   (let ((body (car forms)))
     (dolist (form (cdr forms))
       (when (symbolp form)
         (setq form (list form)))
       (setq body (append (list (car form))
                          (list body)
                          (cdr form))))
     body))
 
 (compat-defmacro thread-last (&rest forms) ;; <OK>
   "Thread FORMS elements as the last argument of their successor.
 Example:
     (thread-last
       5
       (+ 20)
       (/ 25)
       -
       (+ 40))
 Is equivalent to:
     (+ 40 (- (/ 25 (+ 20 5))))
 Note how the single `-' got converted into a list before
 threading."
   (declare (indent 1) (debug thread-first))
   (let ((body (car forms)))
     (dolist (form (cdr forms))
       (when (symbolp form)
         (setq form (list form)))
       (setq body (append form (list body))))
     body))
 
 ;;;; Defined in macroexp.el
 
 (compat-defun macroexpand-1 (form &optional environment) ;; <OK>
   "Perform (at most) one step of macro expansion."
   (cond
    ((consp form)
     (let* ((head (car form))
            (env-expander (assq head environment)))
       (if env-expander
           (if (cdr env-expander)
               (apply (cdr env-expander) (cdr form))
             form)
         (if (not (and (symbolp head) (fboundp head)))
             form
           (let ((def (autoload-do-load (symbol-function head) head 'macro)))
             (cond
              ;; Follow alias, but only for macros, otherwise we may end up
              ;; skipping an important compiler-macro (e.g. cl--block-wrapper).
              ((and (symbolp def) (macrop def)) (cons def (cdr form)))
              ((not (consp def)) form)
              (t
               (if (eq 'macro (car def))
                   (apply (cdr def) (cdr form))
                 form))))))))
    (t form)))
 
 ;;;; Defined in byte-run.el
 
 (compat-defalias function-put put) ;; <OK>
 
 (provide 'compat-25)
 ;;; compat-25.el ends here