code.delx.au - gnu-emacs-elpa/blob - packages/seq/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-position (sequence elt &optional testfn)
 223   "Return the index of the first element in SEQUENCE that is equal to ELT.
 224 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 225   (let ((index 0))
 226     (catch 'seq--break
 227       (seq-doseq (e sequence)
 228         (when (funcall (or testfn #'equal) e elt)
 229           (throw 'seq--break index))
 230         (setq index (1+ index)))
 231       nil)))
 232
 233 (defun seq-uniq (sequence &optional testfn)
 234   "Return a list of the elements of SEQUENCE with duplicates removed.
 235 TESTFN is used to compare elements, or `equal' if TESTFN is nil."
 236   (let ((result '()))
 237     (seq-doseq (elt sequence)
 238       (unless (seq-contains result elt testfn)
 239         (setq result (cons elt result))))
 240     (nreverse result)))
 241
 242 (defun seq-subseq (sequence start &optional end)
 243   "Return the subsequence of SEQUENCE from START to END.
 244 If END is omitted, it defaults to the length of the sequence.
 245 If START or END is negative, it counts from the end."
 246   (cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end))
 247         ((listp sequence)
 248          (let (len (errtext (format "Bad bounding indices: %s, %s" start end)))
 249            (and end (< end 0) (setq end (+ end (setq len (seq-length sequence)))))
 250            (if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence))))))
 251            (when (> start 0)
 252              (setq sequence (nthcdr (1- start) sequence))
 253              (or sequence (error "%s" errtext))
 254              (setq sequence (cdr sequence)))
 255            (if end
 256                (let ((res nil))
 257                  (while (and (>= (setq end (1- end)) start) sequence)
 258                    (push (pop sequence) res))
 259                  (or (= (1+ end) start) (error "%s" errtext))
 260                  (nreverse res))
 261              (seq-copy sequence))))
 262         (t (error "Unsupported sequence: %s" sequence))))
 263
 264 (defun seq-concatenate (type &rest seqs)
 265   "Concatenate, into a sequence of type TYPE, the sequences SEQS.
 266 TYPE must be one of following symbols: vector, string or list.
 267
 268 \n(fn TYPE SEQUENCE...)"
 269   (pcase type
 270     (`vector (apply #'vconcat seqs))
 271     (`string (apply #'concat seqs))
 272     (`list (apply #'append (append seqs '(nil))))
 273     (_ (error "Not a sequence type name: %S" type))))
 274
 275 (defun seq-mapcat (function sequence &optional type)
 276   "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
 277 The result is a sequence of type TYPE, or a list if TYPE is nil."
 278   (apply #'seq-concatenate (or type 'list)
 279          (seq-map function sequence)))
 280
 281 (defun seq-mapn (function sequence &rest seqs)
 282   "Like `seq-map' but FUNCTION is mapped over all SEQS.
 283 The arity of FUNCTION must match the number of SEQS, and the
 284 mapping stops on the shortest sequence.
 285 Return a list of the results.
 286
 287 \(fn FUNCTION SEQS...)"
 288   (let ((result nil)
 289         (seqs (seq-map (lambda (s) (seq-into s 'list))
 290                        (cons sequence seqs))))
 291     (while (not (memq nil seqs))
 292       (push (apply function (seq-map #'car seqs)) result)
 293       (setq seqs (seq-map #'cdr seqs)))
 294     (nreverse result)))
 295
 296 (defun seq-partition (sequence n)
 297   "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
 298 The last sequence may contain less than N elements.  If N is a
 299 negative integer or 0, nil is returned."
 300   (unless (< n 1)
 301     (let ((result '()))
 302       (while (not (seq-empty-p sequence))
 303         (push (seq-take sequence n) result)
 304         (setq sequence (seq-drop sequence n)))
 305       (nreverse result))))
 306
 307 (defun seq-intersection (seq1 seq2 &optional testfn)
 308   "Return a list of the elements that appear in both SEQ1 and SEQ2.
 309 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 310   (seq-reduce (lambda (acc elt)
 311                 (if (seq-contains seq2 elt testfn)
 312                     (cons elt acc)
 313                   acc))
 314               (seq-reverse seq1)
 315               '()))
 316
 317 (defun seq-difference (seq1 seq2 &optional testfn)
 318   "Return a list of the elements that appear in SEQ1 but not in SEQ2.
 319 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 320   (seq-reduce (lambda (acc elt)
 321                 (if (not (seq-contains seq2 elt testfn))
 322                     (cons elt acc)
 323                   acc))
 324               (seq-reverse seq1)
 325               '()))
 326
 327 (defun seq-group-by (function sequence)
 328   "Apply FUNCTION to each element of SEQUENCE.
 329 Separate the elements of SEQUENCE into an alist using the results as
 330 keys.  Keys are compared using `equal'."
 331   (seq-reduce
 332    (lambda (acc elt)
 333      (let* ((key (funcall function elt))
 334             (cell (assoc key acc)))
 335        (if cell
 336            (setcdr cell (push elt (cdr cell)))
 337          (push (list key elt) acc))
 338        acc))
 339    (seq-reverse sequence)
 340    nil))
 341
 342 (defalias 'seq-reverse
 343   (if (ignore-errors (reverse [1 2]))
 344       #'reverse
 345     (lambda (sequence)
 346       "Return the reversed copy of list, vector, or string SEQUENCE.
 347 See also the function `nreverse', which is used more often."
 348       (let ((result '()))
 349         (seq-map (lambda (elt) (push elt result))
 350                  sequence)
 351         (if (listp sequence)
 352             result
 353           (seq-into result (type-of sequence)))))))
 354
 355 (defun seq-into (sequence type)
 356   "Convert the sequence SEQUENCE into a sequence of type TYPE.
 357 TYPE can be one of the following symbols: vector, string or list."
 358   (pcase type
 359     (`vector (vconcat sequence))
 360     (`string (concat sequence))
 361     (`list (append sequence nil))
 362     (_ (error "Not a sequence type name: %S" type))))
 363
 364 (defun seq-min (sequence)
 365   "Return the smallest element of SEQUENCE.
 366 SEQUENCE must be a sequence of numbers or markers."
 367   (apply #'min (seq-into sequence 'list)))
 368
 369 (defun seq-max (sequence)
 370     "Return the largest element of SEQUENCE.
 371 SEQUENCE must be a sequence of numbers or markers."
 372   (apply #'max (seq-into sequence 'list)))
 373
 374 (defun seq--drop-list (list n)
 375   "Return a list from LIST without its first N elements.
 376 This is an optimization for lists in `seq-drop'."
 377   (nthcdr n list))
 378
 379 (defun seq--take-list (list n)
 380   "Return a list from LIST made of its first N elements.
 381 This is an optimization for lists in `seq-take'."
 382   (let ((result '()))
 383     (while (and list (> n 0))
 384       (setq n (1- n))
 385       (push (pop list) result))
 386     (nreverse result)))
 387
 388 (defun seq--drop-while-list (predicate list)
 389   "Return a list from the first element for which (PREDICATE element) is nil in LIST.
 390 This is an optimization for lists in `seq-drop-while'."
 391   (while (and list (funcall predicate (car list)))
 392     (setq list (cdr list)))
 393   list)
 394
 395 (defun seq--take-while-list (predicate list)
 396   "Return the successive elements for which (PREDICATE element) is non-nil in LIST.
 397 This is an optimization for lists in `seq-take-while'."
 398   (let ((result '()))
 399     (while (and list (funcall predicate (car list)))
 400       (push (pop list) result))
 401     (nreverse result)))
 402
 403 (defun seq--count-successive (predicate sequence)
 404   "Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE."
 405   (let ((n 0)
 406         (len (seq-length sequence)))
 407     (while (and (< n len)
 408                 (funcall predicate (seq-elt sequence n)))
 409       (setq n (+ 1 n)))
 410     n))
 411
 412 ;; Helper function for the Backward-compatible version of `seq-let'
 413 ;; for Emacs<25.1.
 414 (defun seq--make-bindings (args sequence &optional bindings)
 415   "Return a list of bindings of the variables in ARGS to the elements of a sequence.
 416 if BINDINGS is non-nil, append new bindings to it, and return
 417 BINDINGS."
 418   (let ((index 0)
 419         (rest-marker nil))
 420     (seq-doseq (name args)
 421       (unless rest-marker
 422         (pcase name
 423           ((pred seq-p)
 424            (setq bindings (seq--make-bindings (seq--elt-safe args index)
 425                                               `(seq--elt-safe ,sequence ,index)
 426                                               bindings)))
 427           (`&rest
 428            (progn (push `(,(seq--elt-safe args (1+ index))
 429                           (seq-drop ,sequence ,index))
 430                         bindings)
 431                   (setq rest-marker t)))
 432           (_
 433            (push `(,name (seq--elt-safe ,sequence ,index)) bindings))))
 434       (setq index (1+ index)))
 435     bindings))
 436
 437 (defun seq--elt-safe (sequence n)
 438   "Return element of SEQUENCE at the index N.
 439 If no element is found, return nil."
 440   (when (or (listp sequence)
 441             (and (sequencep sequence)
 442                  (> (seq-length sequence) n)))
 443     (seq-elt sequence n)))
 444
 445 (defun seq--activate-font-lock-keywords ()
 446   "Activate font-lock keywords for some symbols defined in seq."
 447   (font-lock-add-keywords 'emacs-lisp-mode
 448                           '("\\<seq-doseq\\>" "\\<seq-let\\>")))
 449
 450 (defalias 'seq-copy #'copy-sequence)
 451 (defalias 'seq-elt #'elt)
 452 (defalias 'seq-length #'length)
 453 (defalias 'seq-do #'mapc)
 454 (defalias 'seq-each #'seq-do)
 455 (defalias 'seq-map #'mapcar)
 456 (defalias 'seq-p #'sequencep)
 457
 458 (unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
 459   ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
 460   ;; we automatically highlight macros.
 461   (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
 462
 463 (provide 'seq-24)
 464 ;;; seq-24.el ends here