* lisp/emacs-lisp/checkdoc.el (checkdoc-get-keywords):

[gnu-emacs] / lisp / emacs-lisp / seq.el

diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index ad4c3536b448da4d49e1de66be218ab70471ee1c..0aa0f09596920ed2f5b58cf53c421f9581944136 100644 (file)
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -4,7 +4,8 @@
 
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 ;; Keywords: sequences
 
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 ;; Keywords: sequences

-;; Version: 1.2
+;; Version: 1.7
+;; Package: seq

 
 ;; Maintainer: emacs-devel@gnu.org
 
 
 ;; Maintainer: emacs-devel@gnu.org
 


@@ -32,8 +33,8 @@
 ;;
 ;; All provided functions work on lists, strings and vectors.
 ;;
 ;;
 ;; All provided functions work on lists, strings and vectors.
 ;;

-;; Functions taking a predicate or a function iterating over the
-;; sequence as argument take the function as their first argument and
+;; 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.
 ;;
 ;; the sequence as their second argument.  All other functions take
 ;; the sequence as their first argument.
 ;;


@@ -43,31 +44,59 @@
 
 (defmacro seq-doseq (spec &rest body)
   "Loop over a sequence.
 
 (defmacro seq-doseq (spec &rest body)
   "Loop over a sequence.

-Similar to `dolist' but can be applied lists, strings and vectors.
+Similar to `dolist' but can be applied to lists, strings, and vectors.

 
 Evaluate BODY with VAR bound to each element of SEQ, in turn.
 
 Evaluate BODY with VAR bound to each element of SEQ, in turn.

-Then evaluate RESULT to get return value, default nil.

 
 

-\(fn (VAR SEQ [RESULT]) BODY...)"
+\(fn (VAR SEQ) BODY...)"

   (declare (indent 1) (debug ((symbolp form &optional form) body)))
   (declare (indent 1) (debug ((symbolp form &optional form) body)))

-  (let ((is-list (make-symbol "is-list"))
+  (let ((length (make-symbol "length"))

         (seq (make-symbol "seq"))
         (index (make-symbol "index")))
     `(let* ((,seq ,(cadr spec))
         (seq (make-symbol "seq"))
         (index (make-symbol "index")))
     `(let* ((,seq ,(cadr spec))

-            (,is-list (listp ,seq))
-            (,index (if ,is-list ,seq 0)))
-       (while (if ,is-list
-                  (consp ,index)
-                (< ,index (seq-length ,seq)))
-         (let ((,(car spec) (if ,is-list
-                                (car ,index)
-                              (seq-elt ,seq ,index))))
-           ,@body
-           (setq ,index (if ,is-list
-                            (cdr ,index)
-                          (+ ,index 1)))))
-       ,@(if (cddr spec)
-             `((setq ,(car spec) nil) ,@(cddr 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)))))
+
+(if (fboundp 'pcase-defmacro)
+    ;; Implementation of `seq-let' based on a `pcase'
+    ;; pattern. Requires Emacs>=25.1.
+    (progn
+      (pcase-defmacro seq (&rest args)
+        "pcase pattern matching sequence elements.
+Matches if the object is a sequence (list, string or vector), and
+binds each element of ARGS to the corresponding element of the
+sequence."
+        `(and (pred seq-p)
+              ,@(seq--make-pcase-bindings args)))
+
+      (defmacro seq-let (args seq &rest body)
+        "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQ."
+        (declare (indent 2) (debug t))
+        `(pcase-let ((,(seq--make-pcase-patterns args) ,seq))
+           ,@body)))
+
+  ;; Implementation of `seq-let' compatible with Emacs<25.1.
+  (defmacro seq-let (args seq &rest body)
+    "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQ."
+    (declare (indent 2) (debug t))
+    (let ((seq-var (make-symbol "seq")))
+      `(let* ((,seq-var ,seq)
+              ,@(seq--make-bindings args seq-var))
+         ,@body))))

 
 (defun seq-drop (seq n)
   "Return a subsequence of SEQ without its first N elements.
 
 (defun seq-drop (seq n)
   "Return a subsequence of SEQ without its first N elements.


@@ -171,7 +200,7 @@ The result is a sequence of the same type as SEQ."
   (if (listp seq)
       (sort (seq-copy seq) pred)
     (let ((result (seq-sort pred (append seq nil))))
   (if (listp seq)
       (sort (seq-copy seq) pred)
     (let ((result (seq-sort pred (append seq nil))))

-      (seq--into result (type-of seq)))))
+      (seq-into result (type-of seq)))))

 
 (defun seq-contains-p (seq elt &optional testfn)
   "Return the first element in SEQ that equals to ELT.
 
 (defun seq-contains-p (seq elt &optional testfn)
   "Return the first element in SEQ that equals to ELT.


@@ -220,7 +249,7 @@ TYPE must be one of following symbols: vector, string or list.
     (`vector (apply #'vconcat seqs))
     (`string (apply #'concat seqs))
     (`list (apply #'append (append seqs '(nil))))
     (`vector (apply #'vconcat seqs))
     (`string (apply #'concat seqs))
     (`list (apply #'append (append seqs '(nil))))

-    (t (error "Not a sequence type name: %s" type))))
+    (t (error "Not a sequence type name: %S" type))))

 
 (defun seq-mapcat (function seq &optional type)
   "Concatenate the result of applying FUNCTION to each element of SEQ.
 
 (defun seq-mapcat (function seq &optional type)
   "Concatenate the result of applying FUNCTION to each element of SEQ.


@@ -239,6 +268,26 @@ negative integer or 0, nil is returned."
         (setq seq (seq-drop seq n)))
       (nreverse result))))
 
         (setq seq (seq-drop seq 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-p seq2 elt testfn)
+                    (cons elt acc)
+                  acc))
+              (seq-reverse seq1)
+              '()))
+
+(defun seq-difference (seq1 seq2 &optional testfn)
+  "Return a list of th 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-p seq2 elt testfn))
+                    (cons elt acc)
+                  acc))
+              (seq-reverse seq1)
+              '()))
+

 (defun seq-group-by (function seq)
   "Apply FUNCTION to each element of SEQ.
 Separate the elements of SEQ into an alist using the results as
 (defun seq-group-by (function seq)
   "Apply FUNCTION to each element of SEQ.
 Separate the elements of SEQ into an alist using the results as


@@ -265,15 +314,16 @@ See also the function `nreverse', which is used more often."
                  seq)
         (if (listp seq)
             result
                  seq)
         (if (listp seq)
             result

-          (seq--into result (type-of seq)))))))
+          (seq-into result (type-of seq)))))))

 
 

-(defun seq--into (seq type)
-  "Convert the sequence SEQ into a sequence of type TYPE."
+(defun seq-into (seq type)
+  "Convert the sequence SEQ into a sequence of type TYPE.
+TYPE can be one of the following symbols: vector, string or list."

   (pcase type
     (`vector (vconcat seq))
     (`string (concat seq))
     (`list (append seq nil))
   (pcase type
     (`vector (vconcat seq))
     (`string (concat seq))
     (`list (append seq nil))

-    (t (error "Not a sequence type name: %s" type))))
+    (t (error "Not a sequence type name: %S" type))))

 
 (defun seq--drop-list (list n)
   "Return a list from LIST without its first N elements.
 
 (defun seq--drop-list (list n)
   "Return a list from LIST without its first N elements.


@@ -316,12 +366,83 @@ This is an optimization for lists in `seq-take-while'."
       (setq n (+ 1 n)))
     n))
 
       (setq n (+ 1 n)))
     n))
 

+(defun seq--make-pcase-bindings (args)
+  "Return a list of bindings of the variables in ARGS to the elements of a sequence."
+  (let ((bindings '())
+        (index 0)
+        (rest-marker nil))
+    (seq-doseq (name args)
+      (unless rest-marker
+        (pcase name
+          (`&rest
+           (progn (push `(app (pcase--flip seq-drop ,index)
+                              ,(seq--elt-safe args (1+ index)))
+                        bindings)
+                  (setq rest-marker t)))
+          (t
+           (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+      (setq index (1+ index)))
+    bindings))
+
+(defun seq--make-pcase-patterns (args)
+  "Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
+  (cons 'seq
+        (seq-map (lambda (elt)
+                   (if (seq-p elt)
+                       (seq--make-pcase-patterns elt)
+                     elt))
+                 args)))
+
+;; Helper function for the Backward-compatible version of `seq-let'
+;; for Emacs<25.1.
+(defun seq--make-bindings (args seq &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 seq-p)
+           (setq bindings (seq--make-bindings (seq--elt-safe args index)
+                                              `(seq--elt-safe ,seq ,index)
+                                              bindings)))
+          (`&rest
+           (progn (push `(,(seq--elt-safe args (1+ index))
+                          (seq-drop ,seq ,index))
+                        bindings)
+                  (setq rest-marker t)))
+          (t
+           (push `(,name (seq--elt-safe ,seq ,index)) bindings))))
+      (setq index (1+ index)))
+    bindings))
+
+(defun seq--elt-safe (seq n)
+  "Return element of SEQ at the index N.
+If no element is found, return nil."
+  (when (or (listp seq)
+            (and (sequencep seq)
+                 (> (seq-length seq) n)))
+    (seq-elt seq n)))
+
+(defun seq--activate-font-lock-keywords ()
+  "Activate font-lock keywords for some symbols defined in seq."
+  (font-lock-add-keywords 'emacs-lisp-mode
+                          '("\\<seq-doseq\\>" "\\<seq-let\\>")))
+

 (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 '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 'seq-p #'sequencep)
+
+(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
 
 (provide 'seq)
 ;;; seq.el ends here