compat-25.el (9763B)
1 ;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 18 ;;; Commentary: 19 20 ;; Functionality added in Emacs 25.1, needed by older Emacs versions. 21 22 ;;; Code: 23 24 (eval-when-compile (load "compat-macs.el" nil t t)) 25 26 (compat-version "25.1") 27 28 ;;;; Defined in alloc.c 29 30 (compat-defun bool-vector (&rest objects) ;; <compat-tests:bool-vector> 31 "Return a new bool-vector with specified arguments as elements. 32 Allows any number of arguments, including zero. 33 usage: (bool-vector &rest OBJECTS)" 34 (let ((vec (make-bool-vector (length objects) nil)) 35 (i 0)) 36 (while objects 37 (when (car objects) 38 (aset vec i t)) 39 (setq objects (cdr objects) 40 i (1+ i))) 41 vec)) 42 43 ;;;; Defined in fns.c 44 45 (compat-defun sort (seq predicate) ;; <compat-tests:sort> 46 "Handle vector SEQ." 47 :extended t 48 (cond 49 ((listp seq) 50 (sort seq predicate)) 51 ((vectorp seq) 52 (let* ((list (sort (append seq nil) predicate)) 53 (p list) (i 0)) 54 (while p 55 (aset seq i (car p)) 56 (setq i (1+ i) p (cdr p))) 57 (apply #'vector list))) 58 (t (signal 'wrong-type-argument (list 'list-or-vector-p seq))))) 59 60 ;;;; Defined in editfns.c 61 62 (compat-defalias format-message format) ;; <compat-tests:format-message> 63 64 ;;;; Defined in fileio.c 65 66 (compat-defun directory-name-p (name) ;; <compat-tests:directory-name-p> 67 "Return non-nil if NAME ends with a directory separator character." 68 (eq (eval-when-compile 69 (if (memq system-type '(cygwin windows-nt ms-dos)) 70 ?\\ ?/)) 71 (aref name (1- (length name))))) 72 73 ;;;; Defined in doc.c 74 75 (compat-defvar text-quoting-style nil ;; <compat-tests:text-quoting-style> 76 "Style to use for single quotes in help and messages. 77 78 The value of this variable determines substitution of grave accents 79 and apostrophes in help output (but not for display of Info 80 manuals) and in functions like `message' and `format-message', but not 81 in `format'. 82 83 The value should be one of these symbols: 84 `curve': quote with curved single quotes ‘like this’. 85 `straight': quote with straight apostrophes \\='like this\\='. 86 `grave': quote with grave accent and apostrophe \\=`like this\\='; 87 i.e., do not alter the original quote marks. 88 nil: like `curve' if curved single quotes are displayable, 89 and like `grave' otherwise. This is the default. 90 91 You should never read the value of this variable directly from a Lisp 92 program. Use the function `text-quoting-style' instead, as that will 93 compute the correct value for the current terminal in the nil case.") 94 95 ;;;; Defined in simple.el 96 97 ;; `save-excursion' behaved like `save-mark-and-excursion' before 25.1. 98 (compat-defalias save-mark-and-excursion save-excursion) ;; <compat-tests:save-mark-and-excursion> 99 100 (declare-function region-bounds nil) ;; Defined in compat-26.el 101 (compat-defun region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p> 102 "Return non-nil if the region contains several pieces. 103 An example is a rectangular region handled as a list of 104 separate contiguous regions for each line." 105 (let ((bounds (region-bounds))) (and (cdr bounds) bounds))) 106 107 ;;;; Defined in subr.el 108 109 (compat-defun string-greaterp (string1 string2) ;; <compat-tests:string-greaterp> 110 "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. 111 Case is significant. 112 Symbols are also allowed; their print names are used instead." 113 (string-lessp string2 string1)) 114 115 (compat-defmacro with-file-modes (modes &rest body) ;; <compat-tests:with-file-modes> 116 "Execute BODY with default file permissions temporarily set to MODES. 117 MODES is as for `set-default-file-modes'." 118 (declare (indent 1) (debug t)) 119 (let ((umask (make-symbol "umask"))) 120 `(let ((,umask (default-file-modes))) 121 (unwind-protect 122 (progn 123 (set-default-file-modes ,modes) 124 ,@body) 125 (set-default-file-modes ,umask))))) 126 127 (compat-defmacro if-let (spec then &rest else) ;; <compat-tests:if-let> 128 "Bind variables according to SPEC and evaluate THEN or ELSE. 129 Evaluate each binding in turn, as in `let*', stopping if a 130 binding value is nil. If all are non-nil return the value of 131 THEN, otherwise the last form in ELSE. 132 133 Each element of SPEC is a list (SYMBOL VALUEFORM) that binds 134 SYMBOL to the value of VALUEFORM. An element can additionally be 135 of the form (VALUEFORM), which is evaluated and checked for nil; 136 i.e. SYMBOL can be omitted if only the test result is of 137 interest. It can also be of the form SYMBOL, then the binding of 138 SYMBOL is checked for nil. 139 140 As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) 141 like \((SYMBOL SOMETHING)). This exists for backward compatibility 142 with an old syntax that accepted only one binding." 143 (declare (indent 2) 144 (debug ([&or (symbolp form) 145 (&rest [&or symbolp (symbolp form) (form)])] 146 body))) 147 (when (and (<= (length spec) 2) (not (listp (car spec)))) 148 ;; Adjust the single binding case 149 (setq spec (list spec))) 150 (let ((empty (make-symbol "s")) 151 (last t) list) 152 (dolist (var spec) 153 (push `(,(if (cdr var) (car var) empty) 154 (and ,last ,(if (cdr var) (cadr var) (car var)))) 155 list) 156 (when (or (cdr var) (consp (car var))) 157 (setq last (caar list)))) 158 `(let* ,(nreverse list) 159 (if ,(caar list) ,then ,@else)))) 160 161 (compat-defmacro when-let (spec &rest body) ;; <compat-tests:when-let> 162 "Bind variables according to SPEC and conditionally evaluate BODY. 163 Evaluate each binding in turn, stopping if a binding value is nil. 164 If all are non-nil, return the value of the last form in BODY. 165 166 The variable list SPEC is the same as in `if-let'." 167 (declare (indent 1) (debug if-let)) 168 (list 'if-let spec (macroexp-progn body))) 169 170 ;;;; Defined in subr-x.el 171 172 (compat-defun hash-table-empty-p (hash-table) ;; <compat-tests:hash-table-empty-p> 173 "Check whether HASH-TABLE is empty (has 0 elements)." 174 (zerop (hash-table-count hash-table))) 175 176 (compat-defmacro thread-first (&rest forms) ;; <compat-tests:thread-first> 177 "Thread FORMS elements as the first argument of their successor. 178 Example: 179 (thread-first 180 5 181 (+ 20) 182 (/ 25) 183 - 184 (+ 40)) 185 Is equivalent to: 186 (+ (- (/ (+ 5 20) 25)) 40) 187 Note how the single `-' got converted into a list before 188 threading." 189 (declare (indent 1) 190 (debug (form &rest [&or symbolp (sexp &rest form)]))) 191 (let ((body (car forms))) 192 (dolist (form (cdr forms)) 193 (when (symbolp form) 194 (setq form (list form))) 195 (setq body (append (list (car form)) 196 (list body) 197 (cdr form)))) 198 body)) 199 200 (compat-defmacro thread-last (&rest forms) ;; <compat-tests:thread-last> 201 "Thread FORMS elements as the last argument of their successor. 202 Example: 203 (thread-last 204 5 205 (+ 20) 206 (/ 25) 207 - 208 (+ 40)) 209 Is equivalent to: 210 (+ 40 (- (/ 25 (+ 20 5)))) 211 Note how the single `-' got converted into a list before 212 threading." 213 (declare (indent 1) (debug thread-first)) 214 (let ((body (car forms))) 215 (dolist (form (cdr forms)) 216 (when (symbolp form) 217 (setq form (list form))) 218 (setq body (append form (list body)))) 219 body)) 220 221 ;;;; Defined in macroexp.el 222 223 (compat-defun macroexp-parse-body (body) ;; <compat-tests:macroexp-parse-body> 224 "Parse a function BODY into (DECLARATIONS . EXPS)." 225 (let ((decls ())) 226 (while (and (cdr body) 227 (let ((e (car body))) 228 (or (stringp e) 229 (memq (car-safe e) 230 '(:documentation declare interactive cl-declare))))) 231 (push (pop body) decls)) 232 (cons (nreverse decls) body))) 233 234 (compat-defun macroexp-quote (v) ;; <compat-tests:macroexp-quote> 235 "Return an expression E such that `(eval E)' is V. 236 237 E is either V or (quote V) depending on whether V evaluates to 238 itself or not." 239 (if (and (not (consp v)) 240 (or (keywordp v) 241 (not (symbolp v)) 242 (memq v '(nil t)))) 243 v 244 (list 'quote v))) 245 246 (compat-defun macroexpand-1 (form &optional environment) ;; <compat-tests:macroexpand-1> 247 "Perform (at most) one step of macro expansion." 248 (cond 249 ((consp form) 250 (let* ((head (car form)) 251 (env-expander (assq head environment))) 252 (if env-expander 253 (if (cdr env-expander) 254 (apply (cdr env-expander) (cdr form)) 255 form) 256 (if (not (and (symbolp head) (fboundp head))) 257 form 258 (let ((def (autoload-do-load (symbol-function head) head 'macro))) 259 (cond 260 ;; Follow alias, but only for macros, otherwise we may end up 261 ;; skipping an important compiler-macro (e.g. cl--block-wrapper). 262 ((and (symbolp def) (macrop def)) (cons def (cdr form))) 263 ((not (consp def)) form) 264 (t 265 (if (eq 'macro (car def)) 266 (apply (cdr def) (cdr form)) 267 form)))))))) 268 (t form))) 269 270 (provide 'compat-25) 271 ;;; compat-25.el ends here