From d67ca6739c3ed0c4ac36d3ee5a4eb158d791f668 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 7 Mar 2022 09:59:43 -0500 Subject: * lisp/emacs-lisp/seq.el (seq-concatenate): Accept non-`sequencep` sequences --- lisp/emacs-lisp/seq.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index abfe51d32b5..5ea9fae2e9b 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -299,6 +299,7 @@ sorted. FUNCTION must be a function of one argument." TYPE must be one of following symbols: vector, string or list. \n(fn TYPE SEQUENCE...)" + (setq sequences (mapcar #'seq-into-sequence sequences)) (pcase type ('vector (apply #'vconcat sequences)) ('string (apply #'concat sequences)) -- cgit v1.2.3 From 81bcad03e93854087ab239f4e8b7c062fb069ca5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Mar 2022 09:54:41 -0400 Subject: (seq-contains-p): Refine the non-nil returned value * lisp/emacs-lisp/seq.el (seq-contains-p): Like `cl-some` return the value returned by the test function rather than t. --- lisp/emacs-lisp/seq.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 5ea9fae2e9b..1bcb844d8e9 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -418,8 +418,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." Equality is defined by TESTFN if non-nil or by `equal' if nil." (catch 'seq--break (seq-doseq (e sequence) - (when (funcall (or testfn #'equal) e elt) - (throw 'seq--break t))) + (let ((r (funcall (or testfn #'equal) e elt))) + (when r + (throw 'seq--break r)))) nil)) (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) -- cgit v1.2.3 From 6cb688684065ca74b14263fcc22036cededa2bbe Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 1 Apr 2022 10:02:32 -0400 Subject: cl-generic: Rework obsolescence checks for defmethod * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Silence obsolescence warnings in the included methods. (cl-defmethod): Reuse standard obsolescence checks. * lisp/emacs-lisp/seq.el (seq-contains): Remove redundant `with-suppressed-warnings`. --- lisp/emacs-lisp/cl-generic.el | 18 ++++++++---------- lisp/emacs-lisp/seq.el | 15 +++++++-------- 2 files changed, 15 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 32a5fe5e54b..1e820adaff6 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -308,8 +308,10 @@ DEFAULT-BODY, if present, is used as the body of a default method. `(help-add-fundoc-usage ,doc ',args) (help-add-fundoc-usage doc args))) :autoload-end - ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) - (nreverse methods))) + ,(when methods + `(with-suppressed-warnings ((obsolete ,name)) + ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) + (nreverse methods))))) ,@(mapcar (lambda (declaration) (let ((f (cdr (assq (car declaration) defun-declarations-alist)))) @@ -552,8 +554,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined cl--generic-edebug-make-name nil] lambda-doc ; documentation string def-body))) ; part to be debugged - (let ((qualifiers nil) - (orig-name name)) + (let ((qualifiers nil)) (while (cl-generic--method-qualifier-p args) (push args qualifiers) (setq args (pop body))) @@ -563,18 +564,15 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (setq name (gv-setter (cadr name)))) (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body))) `(progn - ,(and (get name 'byte-obsolete-info) - (let* ((obsolete (get name 'byte-obsolete-info))) - (macroexp-warn-and-return - (macroexp--obsolete-warning name obsolete "generic function") - nil (list 'obsolete name) nil orig-name))) ;; You could argue that `defmethod' modifies rather than defines the ;; function, so warnings like "not known to be defined" are fair game. ;; But in practice, it's common to use `cl-defmethod' ;; without a previous `cl-defgeneric'. ;; The ",'" is a no-op that pacifies check-declare. (,'declare-function ,name "") - (cl-generic-define-method ',name ',(nreverse qualifiers) ',args + ;; We use #' to quote `name' so as to trigger an + ;; obsolescence warning when applicable. + (cl-generic-define-method #',name ',(nreverse qualifiers) ',args ',call-con ,fun))))) (defun cl--generic-member-method (specializers qualifiers methods) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 1bcb844d8e9..133d3c9e118 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -403,15 +403,14 @@ found or not." (setq count (+ 1 count)))) count)) -(with-suppressed-warnings ((obsolete seq-contains)) - (cl-defgeneric seq-contains (sequence elt &optional testfn) - "Return the first element in SEQUENCE that is equal to ELT. +(cl-defgeneric seq-contains (sequence elt &optional testfn) + "Return the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." - (declare (obsolete seq-contains-p "27.1")) - (seq-some (lambda (e) - (when (funcall (or testfn #'equal) elt e) - e)) - sequence))) + (declare (obsolete seq-contains-p "27.1")) + (seq-some (lambda (e) + (when (funcall (or testfn #'equal) elt e) + e)) + sequence)) (cl-defgeneric seq-contains-p (sequence elt &optional testfn) "Return non-nil if SEQUENCE contains an element equal to ELT. -- cgit v1.2.3 From 0c784a483f98d6bea4d955a99bbf5ea6faf80acf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 24 Jun 2022 11:15:19 +0200 Subject: Update seq.el comment * lisp/emacs-lisp/seq.el: Update comment. --- lisp/emacs-lisp/seq.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 133d3c9e118..947b64e8687 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -59,8 +59,8 @@ (eval-when-compile (require 'cl-generic)) ;; We used to use some sequence functions from cl-lib, but this -;; dependency was swapped around so that it will be easier to make -;; seq.el preloaded in the future. See also Bug#39761#26. +;; dependency was swapped around so that it's easier to make seq.el +;; preloaded. See also Bug#39761#26. (defmacro seq-doseq (spec &rest body) "Loop over a sequence. -- cgit v1.2.3 From b31680ef040d4a232619e8d070794a43d2cdca2c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 3 Jul 2022 12:55:00 +0200 Subject: Add new function `seq-split' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-split): New function. * lisp/emacs-lisp/shortdoc.el (sequence): Mention it. --- doc/lispref/sequences.texi | 14 ++++++++++++++ etc/NEWS | 4 ++++ lisp/emacs-lisp/seq.el | 15 +++++++++++++++ lisp/emacs-lisp/shortdoc.el | 2 ++ test/lisp/emacs-lisp/seq-tests.el | 21 +++++++++++++++++++++ 5 files changed, 56 insertions(+) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index c3f4cff3015..39230d0adc4 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -577,6 +577,20 @@ starting from the first one for which @var{predicate} returns @code{nil}. @end example @end defun +@defun seq-split sequence length + This function returns a list consisting of sub-sequences of +@var{sequence} of (at most) length @var{length}. (The final element +may be shorter than @var{length} if the length of @var{sequence} isn't +a multiple of @var{length}. + +@example +@group +(seq-split [0 1 2 3 4] 2) +@result{} ([0 1] [2 3] [4]) +@end group +@end example +@end defun + @defun seq-do function sequence This function applies @var{function} to each element of @var{sequence} in turn (presumably for side effects), and returns diff --git a/etc/NEWS b/etc/NEWS index af3240e5046..e1cdbd5077a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2250,6 +2250,10 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. * Lisp Changes in Emacs 29.1 ++++ +** New function 'seq-split'. +This returns a list of sub-sequences of the specified sequence. + +++ ** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. These function now take an optional comparison predicate argument. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 947b64e8687..36c17f4cd5e 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -632,5 +632,20 @@ Signal an error if SEQUENCE is empty." ;; we automatically highlight macros. (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords)) +(defun seq-split (sequence length) + "Split SEQUENCE into a list of sub-sequences of at most LENGTH. +All the sub-sequences will be of LENGTH, except the last one, +which may be shorter." + (when (< length 1) + (error "Sub-sequence length must be larger than zero")) + (let ((result nil) + (seq-length (length sequence)) + (start 0)) + (while (< start seq-length) + (push (seq-subseq sequence start + (setq start (min seq-length (+ start length)))) + result)) + (nreverse result))) + (provide 'seq) ;;; seq.el ends here diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index c82aa3365cd..f53e783111c 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -889,6 +889,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-subseq '(a b c d e) 2 4)) (seq-take :eval (seq-take '(a b c d e) 3)) + (seq-split + :eval (seq-split [0 1 2 3 5] 2)) (seq-take-while :eval (seq-take-while #'cl-evenp [2 4 9 6 5])) (seq-uniq diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 9e5d59163f9..d979604910e 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -511,5 +511,26 @@ Evaluate BODY for each created sequence. (should (equal (seq-difference '(1 nil) '(2 nil)) '(1))))) +(ert-deftest test-seq-split () + (let ((seq [0 1 2 3 4 5 6 7 8 9 10])) + (should (equal seq (car (seq-split seq 20)))) + (should (equal seq (car (seq-split seq 11)))) + (should (equal (seq-split seq 10) + '([0 1 2 3 4 5 6 7 8 9] [10]))) + (should (equal (seq-split seq 5) + '([0 1 2 3 4] [5 6 7 8 9] [10]))) + (should (equal (seq-split seq 1) + '([0] [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]))) + (should-error (seq-split seq 0)) + (should-error (seq-split seq -10))) + (let ((seq '(0 1 2 3 4 5 6 7 8 9))) + (should (equal (seq-split seq 5) + '((0 1 2 3 4) (5 6 7 8 9))))) + (let ((seq "0123456789")) + (should (equal (seq-split seq 2) + '("01" "23" "45" "67" "89"))) + (should (equal (seq-split seq 3) + '("012" "345" "678" "9"))))) + (provide 'seq-tests) ;;; seq-tests.el ends here -- cgit v1.2.3 From 5ad8f3e5709a3823371ea6aa039b5e7e50feca1f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 17 Jul 2022 19:05:03 +0200 Subject: Use `take` where clearly safe to do so (bug#56521) * lisp/emacs-lisp/seq.el (seq-take): * lisp/auth-source.el (auth-source-secrets-search) (auth-source-plstore-search): * lisp/gnus/message.el (message-insert-formatted-citation-line): * lisp/net/dbus.el (dbus-unregister-object): * lisp/replace.el (occur-context-lines): * test/src/print-tests.el (print-circular): Replace hand-written loop or `butlast` call with `take` for clarity, performance and validation. We have the equivalence (take N LIST) = (butlast LIST (- (length LIST) N)). --- lisp/auth-source.el | 4 ++-- lisp/emacs-lisp/seq.el | 12 +++++++----- lisp/gnus/message.el | 3 +-- lisp/net/dbus.el | 4 +--- lisp/replace.el | 5 ++--- test/src/print-tests.el | 2 +- 6 files changed, 14 insertions(+), 16 deletions(-) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 12da2c3d73d..a802ef856dc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1622,7 +1622,7 @@ authentication tokens: (not (string-match label item))) collect item))) ;; TODO: respect max in `secrets-search-items', not after the fact - (items (butlast items (- (length items) max))) + (items (take max items)) ;; convert the item name to a full plist (items (mapcar (lambda (item) (append @@ -2080,7 +2080,7 @@ entries for git.gnus.org: search-keys))) (items (plstore-find store search-spec)) (item-names (mapcar #'car items)) - (items (butlast items (- (length items) max))) + (items (take max items)) ;; convert the item to a full plist (items (mapcar (lambda (item) (let* ((plist (copy-tree (cdr item))) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 36c17f4cd5e..0d9483aecb6 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -587,11 +587,13 @@ Signal an error if SEQUENCE is empty." (cl-defmethod seq-take ((list list) n) "Optimized implementation of `seq-take' for lists." - (let ((result '())) - (while (and list (> n 0)) - (setq n (1- n)) - (push (pop list) result)) - (nreverse result))) + (if (eval-when-compile (fboundp 'take)) + (take n list) + (let ((result '())) + (while (and list (> n 0)) + (setq n (1- n)) + (push (pop list) result)) + (nreverse result)))) (cl-defmethod seq-drop-while (pred (list list)) "Optimized implementation of `seq-drop-while' for lists." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 7c2b24c6eee..00a27fb5f51 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4180,8 +4180,7 @@ See `message-citation-line-format'." (setq fname (car names) lname (string-join (cdr names) " "))) ((> count 3) - (setq fname (string-join (butlast names (- count 2)) - " ") + (setq fname (string-join (take 2 names) " ") lname (string-join (nthcdr 2 names) " ")))) (when (string-match "\\(.*\\),\\'" fname) (let ((newlname (match-string 1 fname))) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index d4d4ed54e90..6c978c5a5fe 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -941,9 +941,7 @@ association to the service from D-Bus." ;; Loop over the registered functions. (dolist (elt entry) - (when (equal - value - (butlast (cdr elt) (- (length (cdr elt)) (length value)))) + (when (equal value (take (length value) (cdr elt))) (setq ret t) ;; Compute new hash value. If it is empty, remove it from the ;; hash table. diff --git a/lisp/replace.el b/lisp/replace.el index 54ee64f64a5..f8cc784f7c6 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2437,9 +2437,8 @@ See also `multi-occur'." (if (>= (+ prev-line (length prev-after-lines)) (- curr-line (length before-lines))) (setq prev-after-lines - (butlast prev-after-lines - (- (length prev-after-lines) - (- curr-line prev-line (length before-lines) 1)))) + (take (- curr-line prev-line (length before-lines) 1) + prev-after-lines)) ;; Separate non-overlapping context lines with a dashed line. (setq separator "-------\n"))) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 6ff7e997837..f818b4d4715 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -514,7 +514,7 @@ otherwise, use a different charset." (should (< lead (length numbers))) (should (<= lead loopback-index)) (should (< loopback-index (length numbers))) - (let ((lead-part (butlast numbers (- (length numbers) lead))) + (let ((lead-part (take lead numbers)) (loop-part (nthcdr lead numbers))) ;; The lead part must match exactly. (should (equal lead-part (number-sequence 1 lead))) -- cgit v1.2.3 From 6f7941272b112f0412479ffc315352d7928e0fdf Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 18 Jul 2022 11:32:22 +0200 Subject: Speed up `seq-subseq` for lists (bug#56521) * lisp/emacs-lisp/seq.el (seq-subseq): Make faster by using `take` instead of a lisp loop, and more importantly by not front-loading the error text formatting. * test/lisp/emacs-lisp/seq-tests.el (seq-tests--list-subseq-ref) (test-seq-subseq): Test `seq-subseq` for lists more thoroughly. --- lisp/emacs-lisp/seq.el | 20 ++++++++++++-------- test/lisp/emacs-lisp/seq-tests.el | 29 ++++++++++++++++++++++++++++- 2 files changed, 40 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp/seq.el') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 0d9483aecb6..1b8d86563a1 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -168,21 +168,25 @@ if positive or too small if negative)." ((or (stringp sequence) (vectorp sequence)) (substring sequence start end)) ((listp sequence) (let (len - (errtext (format "Bad bounding indices: %s, %s" start end))) + (orig-start start) + (orig-end end)) (and end (< end 0) (setq end (+ end (setq len (length sequence))))) (if (< start 0) (setq start (+ start (or len (setq len (length sequence)))))) (unless (>= start 0) - (error "%s" errtext)) + (error "Start index out of bounds: %s" orig-start)) (when (> start 0) (setq sequence (nthcdr (1- start) sequence)) - (or sequence (error "%s" errtext)) + (unless sequence + (error "Start index out of bounds: %s" orig-start)) (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)) + (let ((n (- end start))) + (when (or (< n 0) + (if len + (> end len) + (and (> n 0) (null (nthcdr (1- n) sequence))))) + (error "End index out of bounds: %s" orig-end)) + (take n sequence)) (copy-sequence sequence)))) (t (error "Unsupported sequence: %s" sequence)))) diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index d979604910e..3b22e42df24 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -257,6 +257,19 @@ Evaluate BODY for each created sequence. (with-test-sequences (seq '()) (should (equal (seq-uniq seq) '())))) +(defun seq-tests--list-subseq-ref (list start &optional end) + "Reference implementation of `seq-subseq' for lists." + (let ((len (length list))) + (when (< start 0) + (setq start (+ start len))) + (unless end + (setq end len)) + (when (< end 0) + (setq end (+ end len))) + (if (<= 0 start end len) + (take (- end start) (nthcdr start list)) + (error "bad args")))) + (ert-deftest test-seq-subseq () (with-test-sequences (seq '(2 3 4 5)) (should (equal (seq-subseq seq 0 4) seq)) @@ -275,7 +288,21 @@ Evaluate BODY for each created sequence. (should-error (seq-subseq [] -1)) (should-error (seq-subseq "" -1)) (should-not (seq-subseq '() 0)) - (should-error (seq-subseq '() 0 -1))) + (should-error (seq-subseq '() 0 -1)) + + (dolist (list '(() (a b c d))) + (ert-info ((prin1-to-string list) :prefix "list: ") + (let ((len (length list))) + (dolist (start (number-sequence (- -2 len) (+ 2 len))) + (ert-info ((prin1-to-string start) :prefix "start: ") + (dolist (end (cons nil (number-sequence (- -2 len) (+ 2 len)))) + (ert-info ((prin1-to-string end) :prefix "end: ") + (condition-case res + (seq-tests--list-subseq-ref list start end) + (error + (should-error (seq-subseq list start end))) + (:success + (should (equal (seq-subseq list start end) res)))))))))))) (ert-deftest test-seq-concatenate () (with-test-sequences (seq '(2 4 6)) -- cgit v1.2.3