diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml index f0ae185..17e9df5 100644 --- a/.github/workflows/makefile.yml +++ b/.github/workflows/makefile.yml @@ -36,6 +36,9 @@ jobs: - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs-version }} + - name: Provide seq.el on Emacs 24 + if: ${{ startsWith(matrix.emacs-version, '24.') }} + run: mv .github/workflows/seq-24.el seq.el - name: Run interpreted tests run: make test - name: Compile diff --git a/.github/workflows/seq-24.el b/.github/workflows/seq-24.el new file mode 100644 index 0000000..78dfe4b --- /dev/null +++ b/.github/workflows/seq-24.el @@ -0,0 +1,496 @@ +;;; seq.el --- seq.el implementation for Emacs 24.x -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2020 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Keywords: sequences + +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Sequence-manipulation functions that complement basic functions +;; provided by subr.el. +;; +;; All functions are prefixed with "seq-". +;; +;; All provided functions work on lists, strings and vectors. +;; +;; Functions taking a predicate or iterating over a sequence using a +;; function as argument take the function as their first argument and +;; the sequence as their second argument. All other functions take +;; the sequence as their first argument. + +;;; Code: + +(defmacro seq-doseq (spec &rest body) + "Loop over a sequence. +Similar to `dolist' but can be applied to lists, strings, and vectors. + +Evaluate BODY with VAR bound to each element of SEQ, in turn. + +\(fn (VAR SEQ) BODY...)" + (declare (indent 1) (debug ((symbolp form &optional form) body))) + (let ((length (make-symbol "length")) + (seq (make-symbol "seq")) + (index (make-symbol "index"))) + `(let* ((,seq ,(cadr spec)) + (,length (if (listp ,seq) nil (seq-length ,seq))) + (,index (if ,length 0 ,seq))) + (while (if ,length + (< ,index ,length) + (consp ,index)) + (let ((,(car spec) (if ,length + (prog1 (seq-elt ,seq ,index) + (setq ,index (+ ,index 1))) + (pop ,index)))) + ,@body))))) + +;; Implementation of `seq-let' compatible with Emacs<25.1. +(defmacro seq-let (args sequence &rest body) + "Bind the variables in ARGS to the elements of SEQUENCE then evaluate BODY. + +ARGS can also include the `&rest' marker followed by a variable +name to be bound to the rest of SEQUENCE." + (declare (indent 2) (debug t)) + (let ((seq-var (make-symbol "seq"))) + `(let* ((,seq-var ,sequence) + ,@(seq--make-bindings args seq-var)) + ,@body))) + +(defun seq-drop (sequence n) + "Return a subsequence of SEQUENCE without its first N elements. +The result is a sequence of the same type as SEQUENCE. + +If N is a negative integer or zero, SEQUENCE is returned." + (if (<= n 0) + sequence + (if (listp sequence) + (seq--drop-list sequence n) + (let ((length (seq-length sequence))) + (seq-subseq sequence (min n length) length))))) + +(defun seq-take (sequence n) + "Return a subsequence of SEQUENCE with its first N elements. +The result is a sequence of the same type as SEQUENCE. + +If N is a negative integer or zero, an empty sequence is +returned." + (if (listp sequence) + (seq--take-list sequence n) + (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))) + +(defun seq-drop-while (predicate sequence) + "Return a sequence from the first element for which (PREDICATE element) is nil in SEQUENCE. +The result is a sequence of the same type as SEQUENCE." + (if (listp sequence) + (seq--drop-while-list predicate sequence) + (seq-drop sequence (seq--count-successive predicate sequence)))) + +(defun seq-take-while (predicate sequence) + "Return the successive elements for which (PREDICATE element) is non-nil in SEQUENCE. +The result is a sequence of the same type as SEQUENCE." + (if (listp sequence) + (seq--take-while-list predicate sequence) + (seq-take sequence (seq--count-successive predicate sequence)))) + +(defun seq-filter (predicate sequence) + "Return a list of all the elements for which (PREDICATE element) is non-nil in SEQUENCE." + (let ((exclude (make-symbol "exclude"))) + (delq exclude (seq-map (lambda (elt) + (if (funcall predicate elt) + elt + exclude)) + sequence)))) + +(defun seq-map-indexed (function sequence) + "Return the result of applying FUNCTION to each element of SEQUENCE. +Unlike `seq-map', FUNCTION takes two arguments: the element of +the sequence, and its index within the sequence." + (let ((index 0)) + (seq-map (lambda (elt) + (prog1 + (funcall function elt index) + (setq index (1+ index)))) + sequence))) + +(defun seq-remove (predicate sequence) + "Return a list of all the elements for which (PREDICATE element) is nil in SEQUENCE." + (seq-filter (lambda (elt) (not (funcall predicate elt))) + sequence)) + +(defun seq-reduce (function sequence initial-value) + "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. + +Return the result of calling FUNCTION with INITIAL-VALUE and the +first element of SEQUENCE, then calling FUNCTION with that result and +the second element of SEQUENCE, then with that result and the third +element of SEQUENCE, etc. + +If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." + (if (seq-empty-p sequence) + initial-value + (let ((acc initial-value)) + (seq-doseq (elt sequence) + (setq acc (funcall function acc elt))) + acc))) + +(defun seq-some (predicate sequence) + "Return the first value for which if (PREDICATE element) is non-nil for in SEQUENCE." + (catch 'seq--break + (seq-doseq (elt sequence) + (let ((result (funcall predicate elt))) + (when result + (throw 'seq--break result)))) + nil)) + +(defun seq-find (predicate sequence &optional default) + "Return the first element for which (PREDICATE element) is non-nil in SEQUENCE. +If no element is found, return DEFAULT. + +Note that `seq-find' has an ambiguity if the found element is +identical to DEFAULT, as it cannot be known if an element was +found or not." + (catch 'seq--break + (seq-doseq (elt sequence) + (when (funcall predicate elt) + (throw 'seq--break elt))) + default)) + +(defun seq-every-p (predicate sequence) + "Return non-nil if (PREDICATE element) is non-nil for all elements of the sequence SEQUENCE." + (catch 'seq--break + (seq-doseq (elt sequence) + (or (funcall predicate elt) + (throw 'seq--break nil))) + t)) + +(defun seq-count (predicate sequence) + "Return the number of elements for which (PREDICATE element) is non-nil in SEQUENCE." + (let ((count 0)) + (seq-doseq (elt sequence) + (when (funcall predicate elt) + (setq count (+ 1 count)))) + count)) + +(defun seq-empty-p (sequence) + "Return non-nil if the sequence SEQUENCE is empty, nil otherwise." + (if (listp sequence) + (null sequence) + (= 0 (seq-length sequence)))) + +(defun seq-sort (predicate sequence) + "Return a sorted sequence comparing using PREDICATE the elements of SEQUENCE. +The result is a sequence of the same type as SEQUENCE." + (if (listp sequence) + (sort (seq-copy sequence) predicate) + (let ((result (seq-sort predicate (append sequence nil)))) + (seq-into result (type-of sequence))))) + +(defun seq-sort-by (function pred sequence) + "Sort SEQUENCE using PRED as a comparison function. +Elements of SEQUENCE are transformed by FUNCTION before being +sorted. FUNCTION must be a function of one argument." + (seq-sort (lambda (a b) + (funcall pred + (funcall function a) + (funcall function b))) + sequence)) + +(defun seq-contains (sequence elt &optional testfn) + "Return the first element in SEQUENCE that equals to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-some (lambda (e) + (funcall (or testfn #'equal) elt e)) + sequence)) + +(defun seq-set-equal-p (sequence1 sequence2 &optional testfn) + "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) + (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) + +(defun seq-position (sequence elt &optional testfn) + "Return the index of the first element in SEQUENCE that is equal to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (let ((index 0)) + (catch 'seq--break + (seq-doseq (e sequence) + (when (funcall (or testfn #'equal) e elt) + (throw 'seq--break index)) + (setq index (1+ index))) + nil))) + +(defun seq-uniq (sequence &optional testfn) + "Return a list of the elements of SEQUENCE with duplicates removed. +TESTFN is used to compare elements, or `equal' if TESTFN is nil." + (let ((result '())) + (seq-doseq (elt sequence) + (unless (seq-contains result elt testfn) + (setq result (cons elt result)))) + (nreverse result))) + +(defun seq-subseq (sequence start &optional end) + "Return the subsequence of SEQUENCE from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end)) + ((listp sequence) + (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) + (and end (< end 0) (setq end (+ end (setq len (seq-length sequence))))) + (if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence)))))) + (when (> start 0) + (setq sequence (nthcdr (1- start) sequence)) + (or sequence (error "%s" errtext)) + (setq sequence (cdr sequence))) + (if end + (let ((res nil)) + (while (and (>= (setq end (1- end)) start) sequence) + (push (pop sequence) res)) + (or (= (1+ end) start) (error "%s" errtext)) + (nreverse res)) + (seq-copy sequence)))) + (t (error "Unsupported sequence: %s" sequence)))) + +(defun seq-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the sequences SEQS. +TYPE must be one of following symbols: vector, string or list. + +\n(fn TYPE SEQUENCE...)" + (pcase type + (`vector (apply #'vconcat seqs)) + (`string (apply #'concat seqs)) + (`list (apply #'append (append seqs '(nil)))) + (_ (error "Not a sequence type name: %S" type)))) + +(defun seq-mapcat (function sequence &optional type) + "Concatenate the result of applying FUNCTION to each element of SEQUENCE. +The result is a sequence of type TYPE, or a list if TYPE is nil." + (apply #'seq-concatenate (or type 'list) + (seq-map function sequence))) + +(defun seq-mapn (function sequence &rest seqs) + "Like `seq-map' but FUNCTION is mapped over all SEQS. +The arity of FUNCTION must match the number of SEQS, and the +mapping stops on the shortest sequence. +Return a list of the results. + +\(fn FUNCTION SEQS...)" + (let ((result nil) + (seqs (seq-map (lambda (s) + (seq-into s 'list)) + (cons sequence seqs)))) + (while (not (memq nil seqs)) + (push (apply function (seq-map #'car seqs)) result) + (setq seqs (seq-map #'cdr seqs))) + (nreverse result))) + +(defun seq-partition (sequence n) + "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N. +The last sequence may contain less than N elements. If N is a +negative integer or 0, nil is returned." + (unless (< n 1) + (let ((result '())) + (while (not (seq-empty-p sequence)) + (push (seq-take sequence n) result) + (setq sequence (seq-drop sequence n))) + (nreverse result)))) + +(defun seq-intersection (seq1 seq2 &optional testfn) + "Return a list of the elements that appear in both SEQ1 and SEQ2. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-reduce (lambda (acc elt) + (if (seq-contains seq2 elt testfn) + (cons elt acc) + acc)) + (seq-reverse seq1) + '())) + +(defun seq-difference (seq1 seq2 &optional testfn) + "Return a list of the elements that appear in SEQ1 but not in SEQ2. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-reduce (lambda (acc elt) + (if (not (seq-contains seq2 elt testfn)) + (cons elt acc) + acc)) + (seq-reverse seq1) + '())) + +(defun seq-group-by (function sequence) + "Apply FUNCTION to each element of SEQUENCE. +Separate the elements of SEQUENCE into an alist using the results as +keys. Keys are compared using `equal'." + (seq-reduce + (lambda (acc elt) + (let* ((key (funcall function elt)) + (cell (assoc key acc))) + (if cell + (setcdr cell (push elt (cdr cell))) + (push (list key elt) acc)) + acc)) + (seq-reverse sequence) + nil)) + +(defalias 'seq-reverse + (if (ignore-errors (reverse [1 2])) + #'reverse + (lambda (sequence) + "Return the reversed copy of list, vector, or string SEQUENCE. +See also the function `nreverse', which is used more often." + (let ((result '())) + (seq-map (lambda (elt) (push elt result)) + sequence) + (if (listp sequence) + result + (seq-into result (type-of sequence))))))) + +(defun seq-into (sequence type) + "Convert the sequence SEQUENCE into a sequence of type TYPE. +TYPE can be one of the following symbols: vector, string or list." + (pcase type + (`vector (seq--into-vector sequence)) + (`string (seq--into-string sequence)) + (`list (seq--into-list sequence)) + (_ (error "Not a sequence type name: %S" type)))) + +(defun seq-min (sequence) + "Return the smallest element of SEQUENCE. +SEQUENCE must be a sequence of numbers or markers." + (apply #'min (seq-into sequence 'list))) + +(defun seq-max (sequence) + "Return the largest element of SEQUENCE. +SEQUENCE must be a sequence of numbers or markers." + (apply #'max (seq-into sequence 'list))) + +(defun seq-random-elt (sequence) + "Return a random element from SEQUENCE. +Signal an error if SEQUENCE is empty." + (if (seq-empty-p sequence) + (error "Sequence cannot be empty") + (seq-elt sequence (random (seq-length sequence))))) + +(defun seq--drop-list (list n) + "Return a list from LIST without its first N elements. +This is an optimization for lists in `seq-drop'." + (nthcdr n list)) + +(defun seq--take-list (list n) + "Return a list from LIST made of its first N elements. +This is an optimization for lists in `seq-take'." + (let ((result '())) + (while (and list (> n 0)) + (setq n (1- n)) + (push (pop list) result)) + (nreverse result))) + +(defun seq--drop-while-list (predicate list) + "Return a list from the first element for which (PREDICATE element) is nil in LIST. +This is an optimization for lists in `seq-drop-while'." + (while (and list (funcall predicate (car list))) + (setq list (cdr list))) + list) + +(defun seq--take-while-list (predicate list) + "Return the successive elements for which (PREDICATE element) is non-nil in LIST. +This is an optimization for lists in `seq-take-while'." + (let ((result '())) + (while (and list (funcall predicate (car list))) + (push (pop list) result)) + (nreverse result))) + +(defun seq--count-successive (predicate sequence) + "Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE." + (let ((n 0) + (len (seq-length sequence))) + (while (and (< n len) + (funcall predicate (seq-elt sequence n))) + (setq n (+ 1 n))) + n)) + +;; Helper function for the Backward-compatible version of `seq-let' +;; for Emacs<25.1. +(defun seq--make-bindings (args sequence &optional bindings) + "Return a list of bindings of the variables in ARGS to the elements of a sequence. +if BINDINGS is non-nil, append new bindings to it, and return +BINDINGS." + (let ((index 0) + (rest-marker nil)) + (seq-doseq (name args) + (unless rest-marker + (pcase name + ((pred seqp) + (setq bindings (seq--make-bindings (seq--elt-safe args index) + `(seq--elt-safe ,sequence ,index) + bindings))) + (`&rest + (progn (push `(,(seq--elt-safe args (1+ index)) + (seq-drop ,sequence ,index)) + bindings) + (setq rest-marker t))) + (_ + (push `(,name (seq--elt-safe ,sequence ,index)) bindings)))) + (setq index (1+ index))) + bindings)) + +(defun seq--elt-safe (sequence n) + "Return element of SEQUENCE at the index N. +If no element is found, return nil." + (when (or (listp sequence) + (and (sequencep sequence) + (> (seq-length sequence) n))) + (seq-elt sequence n))) + +(defun seq--activate-font-lock-keywords () + "Activate font-lock keywords for some symbols defined in seq." + (font-lock-add-keywords 'emacs-lisp-mode + '("\\" "\\"))) + +(defalias 'seq-copy #'copy-sequence) +(defalias 'seq-elt #'elt) +(defalias 'seq-length #'length) +(defalias 'seq-do #'mapc) +(defalias 'seq-each #'seq-do) +(defalias 'seq-map #'mapcar) +(defalias 'seqp #'sequencep) + +(defun seq--into-list (sequence) + "Concatenate the elements of SEQUENCE into a list." + (if (listp sequence) + sequence + (append sequence nil))) + +(defun seq--into-vector (sequence) + "Concatenate the elements of SEQUENCE into a vector." + (if (vectorp sequence) + sequence + (vconcat sequence))) + +(defun seq--into-string (sequence) + "Concatenate the elements of SEQUENCE into a string." + (if (stringp sequence) + sequence + (concat sequence))) + +(unless (fboundp 'elisp--font-lock-flush-elisp-buffers) + ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others) + ;; we automatically highlight macros. + (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords)) + +(provide 'seq) +;;; seq.el ends here diff --git a/NEWS.org b/NEWS.org index eaaf803..4876ac6 100644 --- a/NEWS.org +++ b/NEWS.org @@ -1,5 +1,17 @@ #+title: compat.el - Changelog +* Development + +- compat-27: Drop obsolete ~compat-call dired-get-marked-files~. + +* Release of "Compat" Version 29.1.3.3 + +- compat-27: Add ~with-suppressed-warnings~. +- compat-29: Add ~cl-with-gensyms~ and ~cl-once-only~. +- compat-29: Load ~seq~, which is preloaded on Emacs 29. + +(Release <2023-02-08 Wed>) + * Release of "Compat" Version 29.1.3.2 - compat-26: Add ~make-temp-file~ with optional argument TEXT. diff --git a/compat-26.el b/compat-26.el index fcb05f8..367b45e 100644 --- a/compat-26.el +++ b/compat-26.el @@ -113,8 +113,8 @@ If you just want to check `major-mode', use `derived-mode-p'." (compat--assoc key alist testfn)))) (if x (cdr x) default))) -(compat-guard t - (gv-define-expander compat--alist-get ;; +(compat-guard t ;; + (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 diff --git a/compat-27.el b/compat-27.el index 2be27a6..19db3a6 100644 --- a/compat-27.el +++ b/compat-27.el @@ -349,8 +349,8 @@ There is no need to explicitly add `help-char' to CHARS; ;;;; Defined in simple.el -(compat-guard (not (fboundp 'decoded-time-second)) - (cl-defstruct (decoded-time ;; +(compat-guard (not (fboundp 'decoded-time-second)) ;; + (cl-defstruct (decoded-time (:constructor nil) (:copier nil) (:type list)) @@ -393,6 +393,13 @@ the minibuffer was activated, and execute the forms." (with-selected-window window ,@body))) +;;;; Defined in byte-run.el + +(compat-defmacro with-suppressed-warnings (_warnings &rest body) ;; + "Like `progn', but prevents compiler WARNINGS in BODY. +NOTE: The compatibility version behaves like `with-no-warnings'." + `(with-no-warnings ,@body)) + ;;;; Defined in image.el (compat-defun image--set-property (image property value) ;; @@ -410,9 +417,10 @@ the minibuffer was activated, and execute the forms." ;; HACK: image--set-property was broken with an off-by-one error on Emacs 26. ;; The bug was fixed in a4ad7bed187493c1c230f223b52c71f5c34f7c89. Therefore we ;; override the gv expander until Emacs 27.1. -(compat-guard (or (= emacs-major-version 26) (not (get 'image-property 'gv-expander))) +(compat-guard ;; + (or (= emacs-major-version 26) (not (get 'image-property 'gv-expander))) :feature image - (gv-define-setter image-property (value image prop) ;; + (gv-define-setter image-property (value image prop) `(,(if (< emacs-major-version 26) 'image--set-property 'compat--image--set-property) ,image ,prop ,value))) @@ -564,19 +572,6 @@ The return value is a string (or nil in case we can’t find it)." (or (lm-header "package-version") (lm-header "version"))))))))) -;;;; Defined in dired.el - -(compat-defun dired-get-marked-files - (&optional localp arg filter distinguish-one-marked error) - "Obsolete function." - :obsolete "The compatibility function has been made obsolete." - :feature dired - :extended t - (let ((result (dired-get-marked-files localp arg filter distinguish-one-marked))) - (if (and (null result) error) - (user-error (if (stringp error) error "No files specified")) - result))) - ;;;; Defined in time-date.el (compat-defun make-decoded-time ;; @@ -613,8 +608,8 @@ January 1st being 1." ;;;; Defined in text-property-search.el (declare-function make-prop-match nil) -(compat-guard (not (fboundp 'make-prop-match)) - (cl-defstruct (prop-match) beginning end value)) ;; +(compat-guard (not (fboundp 'make-prop-match)) ;; + (cl-defstruct (prop-match) beginning end value)) (compat-defun text-property-search-forward ;; (property &optional value predicate not-current) diff --git a/compat-29.el b/compat-29.el index bc508fb..a0fd48a 100644 --- a/compat-29.el +++ b/compat-29.el @@ -25,6 +25,10 @@ ;; TODO Update to 29.1 as soon as the Emacs emacs-29 branch version bumped (compat-declare-version "29.0") +;;;; Preloaded in loadup.el + +(compat-guard (require 'seq)) ;; + ;;;; Defined in xdisp.c (compat-defun get-display-property (position prop &optional object properties) ;; @@ -121,8 +125,8 @@ Unibyte strings are converted to multibyte for comparison." ;;;; Defined in gv.el -(compat-guard t - (gv-define-expander compat--plist-get ;; +(compat-guard t ;; + (gv-define-expander compat--plist-get (lambda (do plist prop &optional predicate) (macroexp-let2 macroexp-copyable-p key prop (gv-letplace (getter setter) plist @@ -1340,6 +1344,53 @@ Also see `buttonize'." (setq sentences (1- sentences))) sentences)))) +;;;; Defined in cl-macs.el + +(compat-defmacro cl-with-gensyms (names &rest body) ;; + "Bind each of NAMES to an uninterned symbol and evaluate BODY." + ;; No :feature since macro is autoloaded + (declare (debug (sexp body)) (indent 1)) + `(let ,(cl-loop for name in names collect + `(,name (gensym (symbol-name ',name)))) + ,@body)) + +(compat-defmacro cl-once-only (names &rest body) ;; + "Generate code to evaluate each of NAMES just once in BODY. + +This macro helps with writing other macros. Each of names is +either (NAME FORM) or NAME, which latter means (NAME NAME). +During macroexpansion, each NAME is bound to an uninterned +symbol. The expansion evaluates each FORM and binds it to the +corresponding uninterned symbol. + +For example, consider this macro: + + (defmacro my-cons (x) + (cl-once-only (x) + \\=`(cons ,x ,x))) + +The call (my-cons (pop y)) will expand to something like this: + + (let ((g1 (pop y))) + (cons g1 g1)) + +The use of `cl-once-only' ensures that the pop is performed only +once, as intended. + +See also `macroexp-let2'." + ;; No :feature since macro is autoloaded + (declare (debug (sexp body)) (indent 1)) + (setq names (mapcar #'ensure-list names)) + (let ((our-gensyms (cl-loop for _ in names collect (gensym)))) + `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym))) + `(let ,(list + ,@(cl-loop for name in names for gensym in our-gensyms + for to-eval = (or (cadr name) (car name)) + collect ``(,,gensym ,,to-eval))) + ,(let ,(cl-loop for name in names for gensym in our-gensyms + collect `(,(car name) ,gensym)) + ,@body))))) + ;;;; Defined in ert-x.el (compat-defmacro ert-with-temp-file (name &rest body) ;; diff --git a/compat-tests.el b/compat-tests.el index 7cd67d0..ce818c1 100644 --- a/compat-tests.el +++ b/compat-tests.el @@ -2568,6 +2568,14 @@ (should-equal '(if a (progn b)) (macroexpand-1 '(when a b))) (should-equal '(if a (progn (unless b c))) (macroexpand-1 '(when a (unless b c))))) +;; NOTE: `with-suppressed-warnings' does not work inside of `ert-deftest'?! +(defun compat-tests--with-suppressed-warnings () + (with-suppressed-warnings ((interactive-only goto-line) + (obsolete encode-time-value)) + (encode-time-value 1 2 3 4 0) + (goto-line 10))) +(ert-deftest with-suppressed-warnings () #'compat-tests--with-suppressed-warnings) + (ert-deftest time-equal-p () (should (time-equal-p nil nil)) @@ -2899,5 +2907,25 @@ (should (directory-name-p dir)) (should (file-directory-p dir)))) +(defmacro compat-tests--with-gensyms () + (cl-with-gensyms (x y) + `(let ((,x 1) (,y 2)) (+ ,x ,y)))) + +(ert-deftest cl-with-gensyms () + (should-equal 3 (compat-tests--with-gensyms))) + +(defmacro compat-tests--once-only (x) + (cl-once-only (x) + `(cons ,x ,x))) + +(ert-deftest cl-once-only () + (let ((x 0)) + (should-equal (cons 1 1) (compat-tests--once-only (cl-incf x))) + (should-equal 1 x))) + +(ert-deftest seq () + (should-equal 3 (seq-length '(a b c))) + (should-equal 3 (seq-length [a b c]))) + (provide 'compat-tests) ;;; compat-tests.el ends here diff --git a/compat.el b/compat.el index 36963a5..56bed48 100644 --- a/compat.el +++ b/compat.el @@ -4,9 +4,9 @@ ;; Author: Philip Kaludercic , Daniel Mendler ;; Maintainer: Daniel Mendler , Compat Development <~pkal/compat-devel@lists.sr.ht> -;; Version: 29.1.3.2 +;; Version: 29.1.3.3 ;; URL: https://github.com/emacs-compat/compat -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "24.4") (seq "2.3")) ;; Keywords: lisp ;; This program is free software; you can redistribute it and/or modify diff --git a/compat.texi b/compat.texi index 7c18051..4a84f29 100644 --- a/compat.texi +++ b/compat.texi @@ -31,7 +31,7 @@ modify this GNU manual.” @finalout @titlepage @title "Compat" Manual -@subtitle For version 29.1.3.2 +@subtitle For version 29.1.3.3 @author Philip Kaludercic, Daniel Mendler @page @vskip 0pt plus 1filll @@ -46,7 +46,7 @@ modify this GNU manual.” This manual documents the usage of the "Compat" Emacs lisp library, the forward-compatibility library for Emacs Lisp, corresponding to -version 29.1.3.2. +version 29.1.3.3. @insertcopying @end ifnottex @@ -106,7 +106,7 @@ The intended use-case for this library is for package developers to add as a dependency in the header: @example -;; Package-Requires: ((emacs "24.4") (compat "29.1.3.2")) +;; Package-Requires: ((emacs "24.4") (compat "29.1.3.3")) @end example There is no need to depend on @code{emacs} 24.4 specifically. One can @@ -126,10 +126,11 @@ the noerror flag should be specified. (require 'compat nil 'noerror) @end example -This will load all necessary Compat definitions. Note that if Compat -is installed on a recent version of Emacs, all of the definitions are -disabled at compile time, such that no negative performance impact is -incurred. +This will load all necessary Compat definitions. Compat also loads +the @code{seq} library which is preloaded by default on Emacs 29. +Note that if Compat is installed on a recent version of Emacs, all of +the definitions are disabled at compile time, such that no negative +performance impact is incurred. Note that Compat provides replacement functions with extended functionality for functions that are already defined (@code{sort}, @@ -238,10 +239,10 @@ convention or behavior can be accessed via the @code{compat-function} and @code{compat-call} macros. In this manual we call such definitions ``Extended Definitions''. An example is the function @code{plist-get}. Note that extended functions are subject to closer -scrutiny, since their usage is not completely painless thanks to -@code{compat-call}. If a particular extended function does not see -much usage or the extension yields only marginal benefits, we may not -provide it as part of Compat. +scrutiny, since their usage via @code{compat-call} is not completely +painless. If a particular extended function does not see much usage +or the extension yields only marginal benefits, we may not provide it +as part of Compat. @item Bug fixes are usually not ported back as part of Compat. Sometimes @@ -256,34 +257,27 @@ definitions. The definition belongs to an Emacs core package, which is also distributed via ELPA. Compat does not have to provide backward compatibility for core packages since the updated package can be -installed directly from ELPA. Examples include xref, project, seq, map -and transient. +installed directly from ELPA. Examples include the libraries xref, +project, seq, map and transient. @item New functionality depends on an entire new, non-trivial core library, -which is infeasible to duplicate within Compat while also providing -the necessary backwards compatibility. +which is infeasible to duplicate within Compat. If a backport of such +a library is required, the preferred approach is to either release the +library separately on GNU ELPA as a core package or as a separately +maintained GNU ELPA package. An example is the iso8601 library. @item -New functionality was implemented in the C core, and depends on +New functionality was implemented in the C core, or depends on external libraries that cannot be reasonably duplicated in the scope -of a compatibility library. For example a missing libxml cannot be -emulated. +of a compatibility library. Sometimes new functions on the C level +rely on internal data structures, which we cannot access, rendering a +backport impossible. For example a missing libxml cannot be emulated. @item The semantics of Elisp changed on a deep level. For example the addition of Bigint support in Emacs 27.1 cannot be replicated on the level of Compat. - -@item -Backported functions would introduce performance bugs. Sometimes -functions provided by newer Emacs versions are implemented on the C -level, relying on internal data structures, which we cannot access. In -this case a backport may still be possible but would be significantly -slower than the newer functionality, such that downstream packages -would observe performance bugs. Examples are the -@code{string-pixel-width} function and the @code{json-parse-string} -function provided by libjansson. @end itemize @node Support @@ -585,6 +579,8 @@ The function @code{set-binary-mode}. @item The functions @code{bufferpos-to-filepos} and @code{filepos-to-bufferpos}. +@item +The @code{thunk} library. @end itemize @node Emacs 26.1 @@ -1089,6 +1085,10 @@ All changes related to @code{display-buffer}. The function @code{window-swap-states}. @item The function @code{string-version-lessp}. +@item +The @code{svg} library. +@item +The @code{xdg} library. @end itemize @node Emacs 27.1 @@ -1166,6 +1166,21 @@ returns @code{t} if so, @code{nil} otherwise. Small integers can be compared with @code{eq}. @end defun +@c copied from lispref/compile.texi +@defspec with-suppressed-warnings warnings body@dots{} +In execution, this is equivalent to @code{(progn @var{body}...)}, but +the compiler does not issue warnings for the specified conditions in +@var{body}. @var{warnings} is an association list of warning symbols +and function/variable symbols they apply to. For instance, if you +wish to call an obsolete function called @code{foo}, but want to +suppress the compilation warning, say: + +@lisp +(with-suppressed-warnings ((obsolete foo)) + (foo ...)) +@end lisp +@end defspec + @c copied from lispref/lists.texi @defun proper-list-p object This function returns the length of @var{object} if it is a proper list, @@ -1628,18 +1643,16 @@ The function @code{decoded-time-set-defaults}. @item The function @code{time-convert}. @item -All @code{iso8601-*} functions. -@item The macro @code{benchmark-progn}. @item -The macro @code{with-suppressed-warnings}. -@item Support for @code{condition-case} to handle t. @item The function @code{file-system-info}. @item The function @code{group-name}. @item +The function @code{face-extend-p} and @code{set-face-extend}. +@item Additional @code{format-spec} modifiers. @item Support for additional body forms for @@ -1647,6 +1660,12 @@ Support for additional body forms for @item The macro @code{with-connection-local-variables} and related functionality. +@item +The @code{iso8601} library. +@item +The @code{exif} library. +@item +The @code{image-converter} library. @end itemize @node Emacs 28.1 @@ -2103,6 +2122,13 @@ If native compilation is not available, this function always returns @code{nil}. @end defun +@c copied from on lisp/window.el +@defmac with-window-non-dedicated window &rest body +Evaluate @var{body} with @var{window} temporarily made non-dedicated. +If @var{window} is nil, use the selected window. Return the value of +the last form in @var{body}. +@end defmac + @subsection Extended Definitions These functions must be called explicitly via @code{compat-call}, since their calling convention or behavior was extended in Emacs 28.1: @@ -2139,13 +2165,6 @@ This compatibility version handles the optional argument @var{all-frames}. @end defun -@c copied from on lisp/window.el -@defmac with-window-non-dedicated window &rest body -Evaluate @var{body} with @var{window} temporarily made non-dedicated. -If @var{window} is nil, use the selected window. Return the value of -the last form in @var{body}. -@end defmac - @subsection Missing Definitions Compat does not provide support for the following Lisp features implemented in 28.1: @@ -2211,7 +2230,7 @@ The function @code{max-mini-window-lines}. @item The function @code{lock-file} and @code{unlock-file}. @item -Any @code{multisession} functionality. +The @code{multisession} library. @end itemize @node Emacs 29.1 @@ -2940,6 +2959,81 @@ The same keyword arguments are supported as in @code{ert-with-temp-file} (which see), except for @code{:text}. @end defmac +@c copied from lispref/cl.texi +@defmac cl-with-gensyms names@dots{} body +This macro expands to code that executes @var{body} with each of the +variables in @var{names} bound to a fresh uninterned symbol, or +@dfn{gensym}, in Common Lisp parlance. For macros requiring more than +one gensym, use of @code{cl-with-gensyms} shortens the code and +renders one's intentions clearer. Compare: + +@example +(defmacro my-macro (foo) + (let ((bar (gensym "bar")) + (baz (gensym "baz")) + (quux (gensym "quux"))) + `(let ((,bar (+ @dots{}))) + @dots{}))) + +(defmacro my-macro (foo) + (cl-with-gensyms (bar baz quux) + `(let ((,bar (+ @dots{}))) + @dots{}))) +@end example +@end defmac + +@c copied from lispref/cl.texi +@defmac cl-once-only ((variable form)@dots{}) body +This macro is primarily to help the macro programmer ensure that forms +supplied by the user of the macro are evaluated just once by its +expansion even though the result of evaluating the form is to occur +more than once. Less often, this macro is used to ensure that forms +supplied by the macro programmer are evaluated just once. + +Each @var{variable} may be used to refer to the result of evaluating +@var{form} in @var{body}. @code{cl-once-only} binds each +@var{variable} to a fresh uninterned symbol during the evaluation of +@var{body}. Then, @code{cl-once-only} wraps the final expansion in +code to evaluate each @var{form} and bind the result to the +corresponding uninterned symbol. Thus, when the macro writer +substitutes the value for @var{variable} into the expansion they are +effectively referring to the result of evaluating @var{form}, rather +than @var{form} itself. Another way to put this is that each +@var{variable} is bound to an expression for the (singular) result of +evaluating @var{form}. + +The most common case is where @var{variable} is one of the arguments +to the macro being written, so @code{(variable variable)} may be +abbreviated to just @code{variable}. + +For example, consider this macro: + +@example +(defmacro my-list (x y &rest forms) + (let ((x-result (gensym)) + (y-result (gensym))) + `(let ((,x-result ,x) + (,y-result ,y)) + (list ,x-result ,y-result ,x-result ,y-result + (progn ,@@forms)))) +@end example + +In a call like @w{@code{(my-list (pop foo) @dots{})}} the intermediate +binding to @code{x-result} ensures that the @code{pop} is not done +twice. But as a result the code is rather complex: the reader must +keep track of how @code{x-result} really just means the first +parameter of the call to the macro, and the required use of multiple +gensyms to avoid variable capture by @code{(progn ,@@forms)} obscures +things further. @code{cl-once-only} takes care of these details: + +@example +(defmacro my-list (x y &rest forms) + (cl-once-only (x y) + `(list ,x ,y ,x ,y + (progn ,@@forms)))) +@end example +@end defmac + @subsection Extended Definitions These functions must be called explicitly via @code{compat-call}, since their calling convention or behavior was extended in Emacs 29.1: @@ -3067,9 +3161,9 @@ implemented in 29.1: @item The function @code{imagep}. @item -The function @code{function-documentation}. +The function @code{image-at-point-p}. @item -The command @code{string-edit} and @code{read-string-from-buffer}. +The function @code{function-documentation}. @item The macro @code{with-undo-amalgamate}. @item @@ -3077,17 +3171,27 @@ The function @code{string-glyph-split}. @item The function @code{string-limit}. @item -The function @code{string-pixel-width}. -@item -The function @code{buffer-text-pixel-size}. +The function @code{string-pixel-width} and @code{buffer-text-pixel-size}. @item The function @code{pixel-fill-region}. @item -The function @code{textsec-suspicious-p}. -@item The function @code{minibuffer-lazy-highlight-setup}. @item The function @code{pp-emacs-lisp-code}. +@item +The functions @code{xdg-state-home}, @code{xdg-current-desktop} and @code{xdg-session-type}. +@item +The macro @code{setopt}. +@item +The @code{oclosure} library. +@item +The @code{textsec} library. +@item +The @code{range} library. +@item +The @code{string-edit} library. +@item +The @code{vtable} library. @end itemize @node Development