elpa/seq-2.20/seq-24.el

   1 ;;; seq-24.el --- seq.el implementation for Emacs 24.x -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6 ;; Keywords: sequences
   7
   8 ;; Maintainer: emacs-devel@gnu.org
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Sequence-manipulation functions that complement basic functions
  28 ;; provided by subr.el.
  29 ;;
  30 ;; All functions are prefixed with "seq-".
  31 ;;
  32 ;; All provided functions work on lists, strings and vectors.
  33 ;;
  34 ;; Functions taking a predicate or iterating over a sequence using a
  35 ;; function as argument take the function as their first argument and
  36 ;; the sequence as their second argument.  All other functions take
  37 ;; the sequence as their first argument.
  38
  39 ;;; Code:
  40
  41 (defmacro seq-doseq (spec &rest body)
  42   "Loop over a sequence.
  43 Similar to `dolist' but can be applied to lists, strings, and vectors.
  44
  45 Evaluate BODY with VAR bound to each element of SEQ, in turn.
  46
  47 \(fn (VAR SEQ) BODY...)"
  48   (declare (indent 1) (debug ((symbolp form &optional form) body)))
  49   (let ((length (make-symbol "length"))
  50         (seq (make-symbol "seq"))
  51         (index (make-symbol "index")))
  52     `(let* ((,seq ,(cadr spec))
  53             (,length (if (listp ,seq) nil (seq-length ,seq)))
  54             (,index (if ,length 0 ,seq)))
  55        (while (if ,length
  56                   (< ,index ,length)
  57                 (consp ,index))
  58          (let ((,(car spec) (if ,length
  59                                 (prog1 (seq-elt ,seq ,index)
  60                                   (setq ,index (+ ,index 1)))
  61                               (pop ,index))))
  62            ,@body)))))
  63
  64 ;; Implementation of `seq-let' compatible with Emacs<25.1.
  65 (defmacro seq-let (args sequence &rest body)
  66   "Bind the variables in ARGS to the elements of SEQUENCE then evaluate BODY.
  67
  68 ARGS can also include the `&rest' marker followed by a variable
  69 name to be bound to the rest of SEQUENCE."
  70   (declare (indent 2) (debug t))
  71   (let ((seq-var (make-symbol "seq")))
  72     `(let* ((,seq-var ,sequence)
  73             ,@(seq--make-bindings args seq-var))
  74        ,@body)))
  75
  76 (defun seq-drop (sequence n)
  77   "Return a subsequence of SEQUENCE without its first N elements.
  78 The result is a sequence of the same type as SEQUENCE.
  79
  80 If N is a negative integer or zero, SEQUENCE is returned."
  81   (if (<= n 0)
  82       sequence
  83     (if (listp sequence)
  84         (seq--drop-list sequence n)
  85       (let ((length (seq-length sequence)))
  86         (seq-subseq sequence (min n length) length)))))
  87
  88 (defun seq-take (sequence n)
  89   "Return a subsequence of SEQUENCE with its first N elements.
  90 The result is a sequence of the same type as SEQUENCE.
  91
  92 If N is a negative integer or zero, an empty sequence is
  93 returned."
  94   (if (listp sequence)
  95       (seq--take-list sequence n)
  96     (seq-subseq sequence 0 (min (max n 0) (seq-length sequence)))))
  97
  98 (defun seq-drop-while (predicate sequence)
  99   "Return a sequence from the first element for which (PREDICATE element) is nil in SEQUENCE.
 100 The result is a sequence of the same type as SEQUENCE."
 101   (if (listp sequence)
 102       (seq--drop-while-list predicate sequence)
 103     (seq-drop sequence (seq--count-successive predicate sequence))))
 104
 105 (defun seq-take-while (predicate sequence)
 106   "Return the successive elements for which (PREDICATE element) is non-nil in SEQUENCE.
 107 The result is a sequence of the same type as SEQUENCE."
 108   (if (listp sequence)
 109       (seq--take-while-list predicate sequence)
 110     (seq-take sequence (seq--count-successive predicate sequence))))
 111
 112 (defun seq-filter (predicate sequence)
 113   "Return a list of all the elements for which (PREDICATE element) is non-nil in SEQUENCE."
 114   (let ((exclude (make-symbol "exclude")))
 115     (delq exclude (seq-map (lambda (elt)
 116                              (if (funcall predicate elt)
 117                                  elt
 118                                exclude))
 119                            sequence))))
 120
 121 (defun seq-map-indexed (function sequence)
 122   "Return the result of applying FUNCTION to each element of SEQUENCE.
 123 Unlike `seq-map', FUNCTION takes two arguments: the element of
 124 the sequence, and its index within the sequence."
 125   (let ((index 0))
 126     (seq-map (lambda (elt)
 127                (prog1
 128                    (funcall function elt index)
 129                  (setq index (1+ index))))
 130              sequence)))
 131
 132 (defun seq-remove (predicate sequence)
 133   "Return a list of all the elements for which (PREDICATE element) is nil in SEQUENCE."
 134   (seq-filter (lambda (elt) (not (funcall predicate elt)))
 135               sequence))
 136
 137 (defun seq-reduce (function sequence initial-value)
 138   "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
 139
 140 Return the result of calling FUNCTION with INITIAL-VALUE and the
 141 first element of SEQUENCE, then calling FUNCTION with that result and
 142 the second element of SEQUENCE, then with that result and the third
 143 element of SEQUENCE, etc.
 144
 145 If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
 146   (if (seq-empty-p sequence)
 147       initial-value
 148     (let ((acc initial-value))
 149       (seq-doseq (elt sequence)
 150         (setq acc (funcall function acc elt)))
 151       acc)))
 152
 153 (defun seq-some (predicate sequence)
 154   "Return the first value for which if (PREDICATE element) is non-nil for in SEQUENCE."
 155   (catch 'seq--break
 156     (seq-doseq (elt sequence)
 157       (let ((result (funcall predicate elt)))
 158         (when result
 159           (throw 'seq--break result))))
 160     nil))
 161
 162 (defun seq-find (predicate sequence &optional default)
 163   "Return the first element for which (PREDICATE element) is non-nil in SEQUENCE.
 164 If no element is found, return DEFAULT.
 165
 166 Note that `seq-find' has an ambiguity if the found element is
 167 identical to DEFAULT, as it cannot be known if an element was
 168 found or not."
 169   (catch 'seq--break
 170     (seq-doseq (elt sequence)
 171       (when (funcall predicate elt)
 172         (throw 'seq--break elt)))
 173     default))
 174
 175 (defun seq-every-p (predicate sequence)
 176   "Return non-nil if (PREDICATE element) is non-nil for all elements of the sequence SEQUENCE."
 177   (catch 'seq--break
 178     (seq-doseq (elt sequence)
 179       (or (funcall predicate elt)
 180           (throw 'seq--break nil)))
 181     t))
 182
 183 (defun seq-count (predicate sequence)
 184   "Return the number of elements for which (PREDICATE element) is non-nil in SEQUENCE."
 185   (let ((count 0))
 186     (seq-doseq (elt sequence)
 187       (when (funcall predicate elt)
 188         (setq count (+ 1 count))))
 189     count))
 190
 191 (defun seq-empty-p (sequence)
 192   "Return non-nil if the sequence SEQUENCE is empty, nil otherwise."
 193   (if (listp sequence)
 194       (null sequence)
 195     (= 0 (seq-length sequence))))
 196
 197 (defun seq-sort (predicate sequence)
 198   "Return a sorted sequence comparing using PREDICATE the elements of SEQUENCE.
 199 The result is a sequence of the same type as SEQUENCE."
 200   (if (listp sequence)
 201       (sort (seq-copy sequence) predicate)
 202     (let ((result (seq-sort predicate (append sequence nil))))
 203       (seq-into result (type-of sequence)))))
 204
 205 (defun seq-sort-by (function pred sequence)
 206   "Sort SEQUENCE using PRED as a comparison function.
 207 Elements of SEQUENCE are transformed by FUNCTION before being
 208 sorted.  FUNCTION must be a function of one argument."
 209   (seq-sort (lambda (a b)
 210               (funcall pred
 211                        (funcall function a)
 212                        (funcall function b)))
 213             sequence))
 214
 215 (defun seq-contains (sequence elt &optional testfn)
 216   "Return the first element in SEQUENCE that equals to ELT.
 217 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 218   (seq-some (lambda (e)
 219                 (funcall (or testfn #'equal) elt e))
 220               sequence))
 221
 222 (defun seq-set-equal-p (sequence1 sequence2 &optional testfn)
 223   "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order.
 224 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 225   (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1)
 226        (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2)))
 227
 228 (defun seq-position (sequence elt &optional testfn)
 229   "Return the index of the first element in SEQUENCE that is equal to ELT.
 230 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 231   (let ((index 0))
 232     (catch 'seq--break
 233       (seq-doseq (e sequence)
 234         (when (funcall (or testfn #'equal) e elt)
 235           (throw 'seq--break index))
 236         (setq index (1+ index)))
 237       nil)))
 238
 239 (defun seq-uniq (sequence &optional testfn)
 240   "Return a list of the elements of SEQUENCE with duplicates removed.
 241 TESTFN is used to compare elements, or `equal' if TESTFN is nil."
 242   (let ((result '()))
 243     (seq-doseq (elt sequence)
 244       (unless (seq-contains result elt testfn)
 245         (setq result (cons elt result))))
 246     (nreverse result)))
 247
 248 (defun seq-subseq (sequence start &optional end)
 249   "Return the subsequence of SEQUENCE from START to END.
 250 If END is omitted, it defaults to the length of the sequence.
 251 If START or END is negative, it counts from the end."
 252   (cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end))
 253         ((listp sequence)
 254          (let (len (errtext (format "Bad bounding indices: %s, %s" start end)))
 255            (and end (< end 0) (setq end (+ end (setq len (seq-length sequence)))))
 256            (if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence))))))
 257            (when (> start 0)
 258              (setq sequence (nthcdr (1- start) sequence))
 259              (or sequence (error "%s" errtext))
 260              (setq sequence (cdr sequence)))
 261            (if end
 262                (let ((res nil))
 263                  (while (and (>= (setq end (1- end)) start) sequence)
 264                    (push (pop sequence) res))
 265                  (or (= (1+ end) start) (error "%s" errtext))
 266                  (nreverse res))
 267              (seq-copy sequence))))
 268         (t (error "Unsupported sequence: %s" sequence))))
 269
 270 (defun seq-concatenate (type &rest seqs)
 271   "Concatenate, into a sequence of type TYPE, the sequences SEQS.
 272 TYPE must be one of following symbols: vector, string or list.
 273
 274 \n(fn TYPE SEQUENCE...)"
 275   (pcase type
 276     (`vector (apply #'vconcat seqs))
 277     (`string (apply #'concat seqs))
 278     (`list (apply #'append (append seqs '(nil))))
 279     (_ (error "Not a sequence type name: %S" type))))
 280
 281 (defun seq-mapcat (function sequence &optional type)
 282   "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
 283 The result is a sequence of type TYPE, or a list if TYPE is nil."
 284   (apply #'seq-concatenate (or type 'list)
 285          (seq-map function sequence)))
 286
 287 (defun seq-mapn (function sequence &rest seqs)
 288   "Like `seq-map' but FUNCTION is mapped over all SEQS.
 289 The arity of FUNCTION must match the number of SEQS, and the
 290 mapping stops on the shortest sequence.
 291 Return a list of the results.
 292
 293 \(fn FUNCTION SEQS...)"
 294   (let ((result nil)
 295         (seqs (seq-map (lambda (s)
 296                          (seq-into s 'list))
 297                        (cons sequence seqs))))
 298     (while (not (memq nil seqs))
 299       (push (apply function (seq-map #'car seqs)) result)
 300       (setq seqs (seq-map #'cdr seqs)))
 301     (nreverse result)))
 302
 303 (defun seq-partition (sequence n)
 304   "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
 305 The last sequence may contain less than N elements.  If N is a
 306 negative integer or 0, nil is returned."
 307   (unless (< n 1)
 308     (let ((result '()))
 309       (while (not (seq-empty-p sequence))
 310         (push (seq-take sequence n) result)
 311         (setq sequence (seq-drop sequence n)))
 312       (nreverse result))))
 313
 314 (defun seq-intersection (seq1 seq2 &optional testfn)
 315   "Return a list of the elements that appear in both SEQ1 and SEQ2.
 316 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 317   (seq-reduce (lambda (acc elt)
 318                 (if (seq-contains seq2 elt testfn)
 319                     (cons elt acc)
 320                   acc))
 321               (seq-reverse seq1)
 322               '()))
 323
 324 (defun seq-difference (seq1 seq2 &optional testfn)
 325   "Return a list of the elements that appear in SEQ1 but not in SEQ2.
 326 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 327   (seq-reduce (lambda (acc elt)
 328                 (if (not (seq-contains seq2 elt testfn))
 329                     (cons elt acc)
 330                   acc))
 331               (seq-reverse seq1)
 332               '()))
 333
 334 (defun seq-group-by (function sequence)
 335   "Apply FUNCTION to each element of SEQUENCE.
 336 Separate the elements of SEQUENCE into an alist using the results as
 337 keys.  Keys are compared using `equal'."
 338   (seq-reduce
 339    (lambda (acc elt)
 340      (let* ((key (funcall function elt))
 341             (cell (assoc key acc)))
 342        (if cell
 343            (setcdr cell (push elt (cdr cell)))
 344          (push (list key elt) acc))
 345        acc))
 346    (seq-reverse sequence)
 347    nil))
 348
 349 (defalias 'seq-reverse
 350   (if (ignore-errors (reverse [1 2]))
 351       #'reverse
 352     (lambda (sequence)
 353       "Return the reversed copy of list, vector, or string SEQUENCE.
 354 See also the function `nreverse', which is used more often."
 355       (let ((result '()))
 356         (seq-map (lambda (elt) (push elt result))
 357                  sequence)
 358         (if (listp sequence)
 359             result
 360           (seq-into result (type-of sequence)))))))
 361
 362 (defun seq-into (sequence type)
 363   "Convert the sequence SEQUENCE into a sequence of type TYPE.
 364 TYPE can be one of the following symbols: vector, string or list."
 365   (pcase type
 366     (`vector (seq--into-vector sequence))
 367     (`string (seq--into-string sequence))
 368     (`list (seq--into-list sequence))
 369     (_ (error "Not a sequence type name: %S" type))))
 370
 371 (defun seq-min (sequence)
 372   "Return the smallest element of SEQUENCE.
 373 SEQUENCE must be a sequence of numbers or markers."
 374   (apply #'min (seq-into sequence 'list)))
 375
 376 (defun seq-max (sequence)
 377     "Return the largest element of SEQUENCE.
 378 SEQUENCE must be a sequence of numbers or markers."
 379   (apply #'max (seq-into sequence 'list)))
 380
 381 (defun seq-random-elt (sequence)
 382   "Return a random element from SEQUENCE.
 383 Signal an error if SEQUENCE is empty."
 384   (if (seq-empty-p sequence)
 385       (error "Sequence cannot be empty")
 386     (seq-elt sequence (random (seq-length sequence)))))
 387
 388 (defun seq--drop-list (list n)
 389   "Return a list from LIST without its first N elements.
 390 This is an optimization for lists in `seq-drop'."
 391   (nthcdr n list))
 392
 393 (defun seq--take-list (list n)
 394   "Return a list from LIST made of its first N elements.
 395 This is an optimization for lists in `seq-take'."
 396   (let ((result '()))
 397     (while (and list (> n 0))
 398       (setq n (1- n))
 399       (push (pop list) result))
 400     (nreverse result)))
 401
 402 (defun seq--drop-while-list (predicate list)
 403   "Return a list from the first element for which (PREDICATE element) is nil in LIST.
 404 This is an optimization for lists in `seq-drop-while'."
 405   (while (and list (funcall predicate (car list)))
 406     (setq list (cdr list)))
 407   list)
 408
 409 (defun seq--take-while-list (predicate list)
 410   "Return the successive elements for which (PREDICATE element) is non-nil in LIST.
 411 This is an optimization for lists in `seq-take-while'."
 412   (let ((result '()))
 413     (while (and list (funcall predicate (car list)))
 414       (push (pop list) result))
 415     (nreverse result)))
 416
 417 (defun seq--count-successive (predicate sequence)
 418   "Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE."
 419   (let ((n 0)
 420         (len (seq-length sequence)))
 421     (while (and (< n len)
 422                 (funcall predicate (seq-elt sequence n)))
 423       (setq n (+ 1 n)))
 424     n))
 425
 426 ;; Helper function for the Backward-compatible version of `seq-let'
 427 ;; for Emacs<25.1.
 428 (defun seq--make-bindings (args sequence &optional bindings)
 429   "Return a list of bindings of the variables in ARGS to the elements of a sequence.
 430 if BINDINGS is non-nil, append new bindings to it, and return
 431 BINDINGS."
 432   (let ((index 0)
 433         (rest-marker nil))
 434     (seq-doseq (name args)
 435       (unless rest-marker
 436         (pcase name
 437           ((pred seqp)
 438            (setq bindings (seq--make-bindings (seq--elt-safe args index)
 439                                               `(seq--elt-safe ,sequence ,index)
 440                                               bindings)))
 441           (`&rest
 442            (progn (push `(,(seq--elt-safe args (1+ index))
 443                           (seq-drop ,sequence ,index))
 444                         bindings)
 445                   (setq rest-marker t)))
 446           (_
 447            (push `(,name (seq--elt-safe ,sequence ,index)) bindings))))
 448       (setq index (1+ index)))
 449     bindings))
 450
 451 (defun seq--elt-safe (sequence n)
 452   "Return element of SEQUENCE at the index N.
 453 If no element is found, return nil."
 454   (when (or (listp sequence)
 455             (and (sequencep sequence)
 456                  (> (seq-length sequence) n)))
 457     (seq-elt sequence n)))
 458
 459 (defun seq--activate-font-lock-keywords ()
 460   "Activate font-lock keywords for some symbols defined in seq."
 461   (font-lock-add-keywords 'emacs-lisp-mode
 462                           '("\\<seq-doseq\\>" "\\<seq-let\\>")))
 463
 464 (defalias 'seq-copy #'copy-sequence)
 465 (defalias 'seq-elt #'elt)
 466 (defalias 'seq-length #'length)
 467 (defalias 'seq-do #'mapc)
 468 (defalias 'seq-each #'seq-do)
 469 (defalias 'seq-map #'mapcar)
 470 (defalias 'seqp #'sequencep)
 471
 472 (defun seq--into-list (sequence)
 473   "Concatenate the elements of SEQUENCE into a list."
 474   (if (listp sequence)
 475       sequence
 476     (append sequence nil)))
 477
 478 (defun seq--into-vector (sequence)
 479   "Concatenate the elements of SEQUENCE into a vector."
 480   (if (vectorp sequence)
 481       sequence
 482     (vconcat sequence)))
 483
 484 (defun seq--into-string (sequence)
 485   "Concatenate the elements of SEQUENCE into a string."
 486   (if (stringp sequence)
 487       sequence
 488     (concat sequence)))
 489
 490 (unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
 491   ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
 492   ;; we automatically highlight macros.
 493   (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
 494
 495 (provide 'seq-24)
 496 ;;; seq-24.el ends here