From: Andreas Gerler Date: Thu, 23 Nov 2023 18:49:51 +0000 (+0100) Subject: update smartparens and dash X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=36fa108b877f0d550fabf80c907e8839855c07aa;p=emacsconfig.git update smartparens and dash Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index f2cb85bd..7bd74211 100644 --- a/bba.org +++ b/bba.org @@ -316,8 +316,8 @@ Some key bindings taken from [[https://ebzzry.github.io/emacs-pairs.html][emacs- #+BEGIN_SRC emacs-lisp (if (>= emacs-major-version 24) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/smartparens-20220623.1523") - (add-to-list 'load-path "~/.emacs.d/elpa/dash-20210826.1149") + (add-to-list 'load-path "~/.emacs.d/elpa/smartparens-20230529.1017") + (add-to-list 'load-path "~/.emacs.d/elpa/dash-20230714.723") (require 'smartparens) (smartparens-global-mode 1) (defmacro def-pairs (pairs) diff --git a/elpa/dash-20230502.1324/dash-autoloads.el b/elpa/dash-20230502.1324/dash-autoloads.el deleted file mode 100644 index 6783a8d0..00000000 --- a/elpa/dash-20230502.1324/dash-autoloads.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; dash-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "dash" "dash.el" (0 0 0 0)) -;;; Generated autoloads from dash.el - -(autoload 'dash-fontify-mode "dash" "\ -Toggle fontification of Dash special variables. - -This is a minor mode. If called interactively, toggle the -`Dash-Fontify mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `dash-fontify-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -Dash-Fontify mode is a buffer-local minor mode intended for Emacs -Lisp buffers. Enabling it causes the special variables bound in -anaphoric Dash macros to be fontified. These anaphoras include -`it', `it-index', `acc', and `other'. In older Emacs versions -which do not dynamically detect macros, Dash-Fontify mode -additionally fontifies Dash macro calls. - -See also `dash-fontify-mode-lighter' and -`global-dash-fontify-mode'. - -\(fn &optional ARG)" t nil) - -(put 'global-dash-fontify-mode 'globalized-minor-mode t) - -(defvar global-dash-fontify-mode nil "\ -Non-nil if Global Dash-Fontify mode is enabled. -See the `global-dash-fontify-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `global-dash-fontify-mode'.") - -(custom-autoload 'global-dash-fontify-mode "dash" nil) - -(autoload 'global-dash-fontify-mode "dash" "\ -Toggle Dash-Fontify mode in all buffers. -With prefix ARG, enable Global Dash-Fontify mode if ARG is positive; -otherwise, disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Dash-Fontify mode is enabled in all buffers where -`dash--turn-on-fontify-mode' would do it. - -See `dash-fontify-mode' for more information on Dash-Fontify mode. - -\(fn &optional ARG)" t nil) - -(autoload 'dash-register-info-lookup "dash" "\ -Register the Dash Info manual with `info-lookup-symbol'. -This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t nil) - -(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-")) - -;;;*** - -;;;### (autoloads nil nil ("dash-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; dash-autoloads.el ends here diff --git a/elpa/dash-20230502.1324/dash-pkg.el b/elpa/dash-20230502.1324/dash-pkg.el deleted file mode 100644 index dc5b0e80..00000000 --- a/elpa/dash-20230502.1324/dash-pkg.el +++ /dev/null @@ -1,14 +0,0 @@ -(define-package "dash" "20230502.1324" "A modern list library for Emacs" - '((emacs "24")) - :commit "96eaba028ac069ea0e5cc70de15b0229126a054a" :authors - '(("Magnar Sveen" . "magnars@gmail.com")) - :maintainers - '(("Magnar Sveen" . "magnars@gmail.com")) - :maintainer - '("Magnar Sveen" . "magnars@gmail.com") - :keywords - '("extensions" "lisp") - :url "https://github.com/magnars/dash.el") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/dash-20230502.1324/dash.el b/elpa/dash-20230502.1324/dash.el deleted file mode 100644 index f02a5345..00000000 --- a/elpa/dash-20230502.1324/dash.el +++ /dev/null @@ -1,4134 +0,0 @@ -;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2023 Free Software Foundation, Inc. - -;; Author: Magnar Sveen -;; Version: 2.19.1 -;; Package-Requires: ((emacs "24")) -;; Keywords: extensions, lisp -;; Homepage: https://github.com/magnars/dash.el - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: - -;; A modern list API for Emacs. -;; -;; See its overview at https://github.com/magnars/dash.el#functions. - -;;; Code: - -(eval-when-compile - ;; TODO: Emacs 24.3 first introduced `gv', so remove this and all - ;; calls to `defsetf' when support for earlier versions is dropped. - (unless (fboundp 'gv-define-setter) - (require 'cl)) - - ;; - 24.3 started complaining about unknown `declare' props. - ;; - 25 introduced `pure' and `side-effect-free'. - ;; - 30 introduced `important-return-value'. - (when (boundp 'defun-declarations-alist) - (dolist (prop '(important-return-value pure side-effect-free)) - (unless (assq prop defun-declarations-alist) - (push (list prop #'ignore) defun-declarations-alist))))) - -(defgroup dash () - "Customize group for Dash, a modern list library." - :group 'extensions - :group 'lisp - :prefix "dash-") - -(defmacro !cons (car cdr) - "Destructive: Set CDR to the cons of CAR and CDR." - (declare (debug (form symbolp))) - `(setq ,cdr (cons ,car ,cdr))) - -(defmacro !cdr (list) - "Destructive: Set LIST to the cdr of LIST." - (declare (debug (symbolp))) - `(setq ,list (cdr ,list))) - -(defmacro --each (list &rest body) - "Evaluate BODY for each element of LIST and return nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating BODY. -This is the anaphoric counterpart to `-each'." - (declare (debug (form body)) (indent 1)) - (let ((l (make-symbol "list")) - (i (make-symbol "i"))) - `(let ((,l ,list) - (,i 0)) - (while ,l - (let ((it (pop ,l)) (it-index ,i)) - (ignore it it-index) - ,@body) - (setq ,i (1+ ,i)))))) - -(defun -each (list fn) - "Call FN on each element of LIST. -Return nil; this function is intended for side effects. - -Its anaphoric counterpart is `--each'. - -For access to the current element's index in LIST, see -`-each-indexed'." - (declare (indent 1)) - (ignore (mapc fn list))) - -(defalias '--each-indexed '--each) - -(defun -each-indexed (list fn) - "Call FN on each index and element of LIST. -For each ITEM at INDEX in LIST, call (funcall FN INDEX ITEM). -Return nil; this function is intended for side effects. - -See also: `-map-indexed'." - (declare (indent 1)) - (--each list (funcall fn it-index it))) - -(defmacro --each-while (list pred &rest body) - "Evaluate BODY for each item in LIST, while PRED evaluates to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating PRED or BODY. Once -an element is reached for which PRED evaluates to nil, no further -BODY is evaluated. The return value is always nil. -This is the anaphoric counterpart to `-each-while'." - (declare (debug (form form body)) (indent 2)) - (let ((l (make-symbol "list")) - (i (make-symbol "i")) - (elt (make-symbol "elt"))) - `(let ((,l ,list) - (,i 0) - ,elt) - (while (when ,l - (setq ,elt (car-safe ,l)) - (let ((it ,elt) (it-index ,i)) - (ignore it it-index) - ,pred)) - (let ((it ,elt) (it-index ,i)) - (ignore it it-index) - ,@body) - (setq ,i (1+ ,i) ,l (cdr ,l)))))) - -(defun -each-while (list pred fn) - "Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil. -Once an ITEM is reached for which PRED returns nil, FN is no -longer called. Return nil; this function is intended for side -effects. - -Its anaphoric counterpart is `--each-while'." - (declare (indent 2)) - (--each-while list (funcall pred it) (funcall fn it))) - -(defmacro --each-r (list &rest body) - "Evaluate BODY for each element of LIST in reversed order. -Each element of LIST in turn, starting at its end, is bound to -`it' and its index within LIST to `it-index' before evaluating -BODY. The return value is always nil. -This is the anaphoric counterpart to `-each-r'." - (declare (debug (form body)) (indent 1)) - (let ((v (make-symbol "vector")) - (i (make-symbol "i"))) - ;; Implementation note: building a vector is considerably faster - ;; than building a reversed list (vector takes less memory, so - ;; there is less GC), plus `length' comes naturally. In-place - ;; `nreverse' would be faster still, but BODY would be able to see - ;; that, even if the modification was undone before we return. - `(let* ((,v (vconcat ,list)) - (,i (length ,v)) - it it-index) - (ignore it it-index) - (while (> ,i 0) - (setq ,i (1- ,i) it-index ,i it (aref ,v ,i)) - ,@body)))) - -(defun -each-r (list fn) - "Call FN on each element of LIST in reversed order. -Return nil; this function is intended for side effects. - -Its anaphoric counterpart is `--each-r'." - (--each-r list (funcall fn it))) - -(defmacro --each-r-while (list pred &rest body) - "Eval BODY for each item in reversed LIST, while PRED evals to non-nil. -Each element of LIST in turn, starting at its end, is bound to -`it' and its index within LIST to `it-index' before evaluating -PRED or BODY. Once an element is reached for which PRED -evaluates to nil, no further BODY is evaluated. The return value -is always nil. -This is the anaphoric counterpart to `-each-r-while'." - (declare (debug (form form body)) (indent 2)) - (let ((v (make-symbol "vector")) - (i (make-symbol "i")) - (elt (make-symbol "elt"))) - `(let* ((,v (vconcat ,list)) - (,i (length ,v)) - ,elt it it-index) - (ignore it it-index) - (while (when (> ,i 0) - (setq ,i (1- ,i) it-index ,i) - (setq ,elt (aref ,v ,i) it ,elt) - ,pred) - (setq it-index ,i it ,elt) - ,@body)))) - -(defun -each-r-while (list pred fn) - "Call FN on each ITEM in reversed LIST, while (PRED ITEM) is non-nil. -Once an ITEM is reached for which PRED returns nil, FN is no -longer called. Return nil; this function is intended for side -effects. - -Its anaphoric counterpart is `--each-r-while'." - (--each-r-while list (funcall pred it) (funcall fn it))) - -(defmacro --dotimes (num &rest body) - "Evaluate BODY NUM times, presumably for side effects. -BODY is evaluated with the local variable `it' temporarily bound -to successive integers running from 0, inclusive, to NUM, -exclusive. BODY is not evaluated if NUM is less than 1. -This is the anaphoric counterpart to `-dotimes'." - (declare (debug (form body)) (indent 1)) - (let ((n (make-symbol "num")) - (i (make-symbol "i"))) - `(let ((,n ,num) - (,i 0) - it) - (ignore it) - (while (< ,i ,n) - (setq it ,i ,i (1+ ,i)) - ,@body)))) - -(defun -dotimes (num fn) - "Call FN NUM times, presumably for side effects. -FN is called with a single argument on successive integers -running from 0, inclusive, to NUM, exclusive. FN is not called -if NUM is less than 1. - -This function's anaphoric counterpart is `--dotimes'." - (declare (indent 1)) - (--dotimes num (funcall fn it))) - -(defun -map (fn list) - "Apply FN to each item in LIST and return the list of results. - -This function's anaphoric counterpart is `--map'." - (declare (important-return-value t)) - (mapcar fn list)) - -(defmacro --map (form list) - "Eval FORM for each item in LIST and return the list of results. -Each element of LIST in turn is bound to `it' before evaluating -FORM. -This is the anaphoric counterpart to `-map'." - (declare (debug (def-form form))) - `(mapcar (lambda (it) (ignore it) ,form) ,list)) - -(defmacro --reduce-from (form init list) - "Accumulate a value by evaluating FORM across LIST. -This macro is like `--each' (which see), but it additionally -provides an accumulator variable `acc' which it successively -binds to the result of evaluating FORM for the current LIST -element before processing the next element. For the first -element, `acc' is initialized with the result of evaluating INIT. -The return value is the resulting value of `acc'. If LIST is -empty, FORM is not evaluated, and the return value is the result -of INIT. -This is the anaphoric counterpart to `-reduce-from'." - (declare (debug (form form form))) - `(let ((acc ,init)) - (--each ,list (setq acc ,form)) - acc)) - -(defun -reduce-from (fn init list) - "Reduce the function FN across LIST, starting with INIT. -Return the result of applying FN to INIT and the first element of -LIST, then applying FN to that result and the second element, -etc. If LIST is empty, return INIT without calling FN. - -This function's anaphoric counterpart is `--reduce-from'. - -For other folds, see also `-reduce' and `-reduce-r'." - (declare (important-return-value t)) - (--reduce-from (funcall fn acc it) init list)) - -(defmacro --reduce (form list) - "Accumulate a value by evaluating FORM across LIST. -This macro is like `--reduce-from' (which see), except the first -element of LIST is taken as INIT. Thus if LIST contains a single -item, it is returned without evaluating FORM. If LIST is empty, -FORM is evaluated with `it' and `acc' bound to nil. -This is the anaphoric counterpart to `-reduce'." - (declare (debug (form form))) - (let ((lv (make-symbol "list-value"))) - `(let ((,lv ,list)) - (if ,lv - (--reduce-from ,form (car ,lv) (cdr ,lv)) - ;; Explicit nil binding pacifies lexical "variable left uninitialized" - ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. - (let ((acc nil) (it nil)) - (ignore acc it) - ,form))))) - -(defun -reduce (fn list) - "Reduce the function FN across LIST. -Return the result of applying FN to the first two elements of -LIST, then applying FN to that result and the third element, etc. -If LIST contains a single element, return it without calling FN. -If LIST is empty, return the result of calling FN with no -arguments. - -This function's anaphoric counterpart is `--reduce'. - -For other folds, see also `-reduce-from' and `-reduce-r'." - (declare (important-return-value t)) - (if list - (-reduce-from fn (car list) (cdr list)) - (funcall fn))) - -(defmacro --reduce-r-from (form init list) - "Accumulate a value by evaluating FORM across LIST in reverse. -This macro is like `--reduce-from', except it starts from the end -of LIST. -This is the anaphoric counterpart to `-reduce-r-from'." - (declare (debug (form form form))) - `(let ((acc ,init)) - (--each-r ,list (setq acc ,form)) - acc)) - -(defun -reduce-r-from (fn init list) - "Reduce the function FN across LIST in reverse, starting with INIT. -Return the result of applying FN to the last element of LIST and -INIT, then applying FN to the second-to-last element and the -previous result of FN, etc. That is, the first argument of FN is -the current element, and its second argument the accumulated -value. If LIST is empty, return INIT without calling FN. - -This function is like `-reduce-from' but the operation associates -from the right rather than left. In other words, it starts from -the end of LIST and flips the arguments to FN. Conceptually, it -is like replacing the conses in LIST with applications of FN, and -its last link with INIT, and evaluating the resulting expression. - -This function's anaphoric counterpart is `--reduce-r-from'. - -For other folds, see also `-reduce-r' and `-reduce'." - (declare (important-return-value t)) - (--reduce-r-from (funcall fn it acc) init list)) - -(defmacro --reduce-r (form list) - "Accumulate a value by evaluating FORM across LIST in reverse order. -This macro is like `--reduce', except it starts from the end of -LIST. -This is the anaphoric counterpart to `-reduce-r'." - (declare (debug (form form))) - `(--reduce ,form (reverse ,list))) - -(defun -reduce-r (fn list) - "Reduce the function FN across LIST in reverse. -Return the result of applying FN to the last two elements of -LIST, then applying FN to the third-to-last element and the -previous result of FN, etc. That is, the first argument of FN is -the current element, and its second argument the accumulated -value. If LIST contains a single element, return it without -calling FN. If LIST is empty, return the result of calling FN -with no arguments. - -This function is like `-reduce' but the operation associates from -the right rather than left. In other words, it starts from the -end of LIST and flips the arguments to FN. Conceptually, it is -like replacing the conses in LIST with applications of FN, -ignoring its last link, and evaluating the resulting expression. - -This function's anaphoric counterpart is `--reduce-r'. - -For other folds, see also `-reduce-r-from' and `-reduce'." - (declare (important-return-value t)) - (if list - (--reduce-r (funcall fn it acc) list) - (funcall fn))) - -(defmacro --reductions-from (form init list) - "Return a list of FORM's intermediate reductions across LIST. -That is, a list of the intermediate values of the accumulator -when `--reduce-from' (which see) is called with the same -arguments. -This is the anaphoric counterpart to `-reductions-from'." - (declare (debug (form form form))) - `(nreverse - (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) - (list ,init) - ,list))) - -(defun -reductions-from (fn init list) - "Return a list of FN's intermediate reductions across LIST. -That is, a list of the intermediate values of the accumulator -when `-reduce-from' (which see) is called with the same -arguments. - -This function's anaphoric counterpart is `--reductions-from'. - -For other folds, see also `-reductions' and `-reductions-r'." - (declare (important-return-value t)) - (--reductions-from (funcall fn acc it) init list)) - -(defmacro --reductions (form list) - "Return a list of FORM's intermediate reductions across LIST. -That is, a list of the intermediate values of the accumulator -when `--reduce' (which see) is called with the same arguments. -This is the anaphoric counterpart to `-reductions'." - (declare (debug (form form))) - (let ((lv (make-symbol "list-value"))) - `(let ((,lv ,list)) - (if ,lv - (--reductions-from ,form (car ,lv) (cdr ,lv)) - ;; Explicit nil binding pacifies lexical "variable left uninitialized" - ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. - (let ((acc nil) (it nil)) - (ignore acc it) - (list ,form)))))) - -(defun -reductions (fn list) - "Return a list of FN's intermediate reductions across LIST. -That is, a list of the intermediate values of the accumulator -when `-reduce' (which see) is called with the same arguments. - -This function's anaphoric counterpart is `--reductions'. - -For other folds, see also `-reductions' and `-reductions-r'." - (declare (important-return-value t)) - (if list - (--reductions-from (funcall fn acc it) (car list) (cdr list)) - (list (funcall fn)))) - -(defmacro --reductions-r-from (form init list) - "Return a list of FORM's intermediate reductions across reversed LIST. -That is, a list of the intermediate values of the accumulator -when `--reduce-r-from' (which see) is called with the same -arguments. -This is the anaphoric counterpart to `-reductions-r-from'." - (declare (debug (form form form))) - `(--reduce-r-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) - (list ,init) - ,list)) - -(defun -reductions-r-from (fn init list) - "Return a list of FN's intermediate reductions across reversed LIST. -That is, a list of the intermediate values of the accumulator -when `-reduce-r-from' (which see) is called with the same -arguments. - -This function's anaphoric counterpart is `--reductions-r-from'. - -For other folds, see also `-reductions' and `-reductions-r'." - (declare (important-return-value t)) - (--reductions-r-from (funcall fn it acc) init list)) - -(defmacro --reductions-r (form list) - "Return a list of FORM's intermediate reductions across reversed LIST. -That is, a list of the intermediate values of the accumulator -when `--reduce-re' (which see) is called with the same arguments. -This is the anaphoric counterpart to `-reductions-r'." - (declare (debug (form list))) - (let ((lv (make-symbol "list-value"))) - `(let ((,lv (reverse ,list))) - (if ,lv - (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) - (list (car ,lv)) - (cdr ,lv)) - ;; Explicit nil binding pacifies lexical "variable left uninitialized" - ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. - (let ((acc nil) (it nil)) - (ignore acc it) - (list ,form)))))) - -(defun -reductions-r (fn list) - "Return a list of FN's intermediate reductions across reversed LIST. -That is, a list of the intermediate values of the accumulator -when `-reduce-r' (which see) is called with the same arguments. - -This function's anaphoric counterpart is `--reductions-r'. - -For other folds, see also `-reductions-r-from' and -`-reductions'." - (declare (important-return-value t)) - (if list - (--reductions-r (funcall fn it acc) list) - (list (funcall fn)))) - -(defmacro --filter (form list) - "Return a new list of the items in LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-filter'. -For the opposite operation, see also `--remove'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list (when ,form (push it ,r))) - (nreverse ,r)))) - -(defun -filter (pred list) - "Return a new list of the items in LIST for which PRED returns non-nil. - -Alias: `-select'. - -This function's anaphoric counterpart is `--filter'. - -For similar operations, see also `-keep' and `-remove'." - (declare (important-return-value t)) - (--filter (funcall pred it) list)) - -(defalias '-select '-filter) -(defalias '--select '--filter) - -(defmacro --remove (form list) - "Return a new list of the items in LIST for which FORM evals to nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-remove'. -For the opposite operation, see also `--filter'." - (declare (debug (form form))) - `(--filter (not ,form) ,list)) - -(defun -remove (pred list) - "Return a new list of the items in LIST for which PRED returns nil. - -Alias: `-reject'. - -This function's anaphoric counterpart is `--remove'. - -For similar operations, see also `-keep' and `-filter'." - (declare (important-return-value t)) - (--remove (funcall pred it) list)) - -(defalias '-reject '-remove) -(defalias '--reject '--remove) - -(defmacro --remove-first (form list) - "Remove the first item from LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. This is a -non-destructive operation, but only the front of LIST leading up -to the removed item is a copy; the rest is LIST's original tail. -If no item is removed, then the result is a complete copy. -This is the anaphoric counterpart to `-remove-first'." - (declare (debug (form form))) - (let ((front (make-symbol "front")) - (tail (make-symbol "tail"))) - `(let ((,tail ,list) ,front) - (--each-while ,tail (not ,form) - (push (pop ,tail) ,front)) - (if ,tail - (nconc (nreverse ,front) (cdr ,tail)) - (nreverse ,front))))) - -(defun -remove-first (pred list) - "Remove the first item from LIST for which PRED returns non-nil. -This is a non-destructive operation, but only the front of LIST -leading up to the removed item is a copy; the rest is LIST's -original tail. If no item is removed, then the result is a -complete copy. - -Alias: `-reject-first'. - -This function's anaphoric counterpart is `--remove-first'. - -See also `-map-first', `-remove-item', and `-remove-last'." - (declare (important-return-value t)) - (--remove-first (funcall pred it) list)) - -;; TODO: #'-quoting the macro upsets Emacs 24. -(defalias '-reject-first #'-remove-first) -(defalias '--reject-first '--remove-first) - -(defmacro --remove-last (form list) - "Remove the last item from LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' before evaluating -FORM. The result is a copy of LIST regardless of whether an -element is removed. -This is the anaphoric counterpart to `-remove-last'." - (declare (debug (form form))) - `(nreverse (--remove-first ,form (reverse ,list)))) - -(defun -remove-last (pred list) - "Remove the last item from LIST for which PRED returns non-nil. -The result is a copy of LIST regardless of whether an element is -removed. - -Alias: `-reject-last'. - -This function's anaphoric counterpart is `--remove-last'. - -See also `-map-last', `-remove-item', and `-remove-first'." - (declare (important-return-value t)) - (--remove-last (funcall pred it) list)) - -(defalias '-reject-last '-remove-last) -(defalias '--reject-last '--remove-last) - -(defalias '-remove-item #'remove - "Return a copy of LIST with all occurrences of ITEM removed. -The comparison is done with `equal'. -\n(fn ITEM LIST)") - -(defmacro --keep (form list) - "Eval FORM for each item in LIST and return the non-nil results. -Like `--filter', but returns the non-nil results of FORM instead -of the corresponding elements of LIST. Each element of LIST in -turn is bound to `it' and its index within LIST to `it-index' -before evaluating FORM. -This is the anaphoric counterpart to `-keep'." - (declare (debug (form form))) - (let ((r (make-symbol "result")) - (m (make-symbol "mapped"))) - `(let (,r) - (--each ,list (let ((,m ,form)) (when ,m (push ,m ,r)))) - (nreverse ,r)))) - -(defun -keep (fn list) - "Return a new list of the non-nil results of applying FN to each item in LIST. -Like `-filter', but returns the non-nil results of FN instead of -the corresponding elements of LIST. - -Its anaphoric counterpart is `--keep'." - (declare (important-return-value t)) - (--keep (funcall fn it) list)) - -(defun -non-nil (list) - "Return a copy of LIST with all nil items removed." - (declare (pure t) (side-effect-free t)) - (--filter it list)) - -(defmacro --map-indexed (form list) - "Eval FORM for each item in LIST and return the list of results. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. This is like -`--map', but additionally makes `it-index' available to FORM. - -This is the anaphoric counterpart to `-map-indexed'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list - (push ,form ,r)) - (nreverse ,r)))) - -(defun -map-indexed (fn list) - "Apply FN to each index and item in LIST and return the list of results. -This is like `-map', but FN takes two arguments: the index of the -current element within LIST, and the element itself. - -This function's anaphoric counterpart is `--map-indexed'. - -For a side-effecting variant, see also `-each-indexed'." - (declare (important-return-value t)) - (--map-indexed (funcall fn it-index it) list)) - -(defmacro --map-when (pred rep list) - "Anaphoric form of `-map-when'." - (declare (debug (form form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list (!cons (if ,pred ,rep it) ,r)) - (nreverse ,r)))) - -(defun -map-when (pred rep list) - "Use PRED to conditionally apply REP to each item in LIST. -Return a copy of LIST where the items for which PRED returns nil -are unchanged, and the rest are mapped through the REP function. - -Alias: `-replace-where' - -See also: `-update-at'" - (declare (important-return-value t)) - (--map-when (funcall pred it) (funcall rep it) list)) - -(defalias '-replace-where '-map-when) -(defalias '--replace-where '--map-when) - -(defun -map-first (pred rep list) - "Use PRED to determine the first item in LIST to call REP on. -Return a copy of LIST where the first item for which PRED returns -non-nil is replaced with the result of calling REP on that item. - -See also: `-map-when', `-replace-first'" - (declare (important-return-value t)) - (let (front) - (while (and list (not (funcall pred (car list)))) - (push (car list) front) - (!cdr list)) - (if list - (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list))) - (nreverse front)))) - -(defmacro --map-first (pred rep list) - "Anaphoric form of `-map-first'." - (declare (debug (def-form def-form form))) - `(-map-first (lambda (it) (ignore it) ,pred) - (lambda (it) (ignore it) ,rep) - ,list)) - -(defun -map-last (pred rep list) - "Use PRED to determine the last item in LIST to call REP on. -Return a copy of LIST where the last item for which PRED returns -non-nil is replaced with the result of calling REP on that item. - -See also: `-map-when', `-replace-last'" - (declare (important-return-value t)) - (nreverse (-map-first pred rep (reverse list)))) - -(defmacro --map-last (pred rep list) - "Anaphoric form of `-map-last'." - (declare (debug (def-form def-form form))) - `(-map-last (lambda (it) (ignore it) ,pred) - (lambda (it) (ignore it) ,rep) - ,list)) - -(defun -replace (old new list) - "Replace all OLD items in LIST with NEW. - -Elements are compared using `equal'. - -See also: `-replace-at'" - (declare (pure t) (side-effect-free t)) - (--map-when (equal it old) new list)) - -(defun -replace-first (old new list) - "Replace the first occurrence of OLD with NEW in LIST. - -Elements are compared using `equal'. - -See also: `-map-first'" - (declare (pure t) (side-effect-free t)) - (--map-first (equal old it) new list)) - -(defun -replace-last (old new list) - "Replace the last occurrence of OLD with NEW in LIST. - -Elements are compared using `equal'. - -See also: `-map-last'" - (declare (pure t) (side-effect-free t)) - (--map-last (equal old it) new list)) - -(defmacro --mapcat (form list) - "Anaphoric form of `-mapcat'." - (declare (debug (form form))) - `(apply #'append (--map ,form ,list))) - -(defun -mapcat (fn list) - "Return the concatenation of the result of mapping FN over LIST. -Thus function FN should return a list." - (declare (important-return-value t)) - (--mapcat (funcall fn it) list)) - -(defmacro --iterate (form init n) - "Anaphoric version of `-iterate'." - (declare (debug (form form form))) - (let ((res (make-symbol "result")) - (len (make-symbol "n"))) - `(let ((,len ,n)) - (when (> ,len 0) - (let* ((it ,init) - (,res (list it))) - (dotimes (_ (1- ,len)) - (push (setq it ,form) ,res)) - (nreverse ,res)))))) - -(defun -iterate (fun init n) - "Return a list of iterated applications of FUN to INIT. - -This means a list of the form: - - (INIT (FUN INIT) (FUN (FUN INIT)) ...) - -N is the length of the returned list." - (declare (important-return-value t)) - (--iterate (funcall fun it) init n)) - -(defun -flatten (l) - "Take a nested list L and return its contents as a single, flat list. - -Note that because nil represents a list of zero elements (an -empty list), any mention of nil in L will disappear after -flattening. If you need to preserve nils, consider `-flatten-n' -or map them to some unique symbol and then map them back. - -Conses of two atoms are considered \"terminals\", that is, they -aren't flattened further. - -See also: `-flatten-n'" - (declare (pure t) (side-effect-free t)) - (if (and (listp l) (listp (cdr l))) - (-mapcat '-flatten l) - (list l))) - -(defun -flatten-n (num list) - "Flatten NUM levels of a nested LIST. - -See also: `-flatten'" - (declare (pure t) (side-effect-free t)) - (dotimes (_ num) - (setq list (apply #'append (mapcar #'-list list)))) - list) - -(defalias '-concat #'append - "Concatenate all the arguments and make the result a list. -The result is a list whose elements are the elements of all the arguments. -Each argument may be a list, vector or string. - -All arguments except the last argument are copied. The last argument -is just used as the tail of the new list. - -\(fn &rest SEQUENCES)") - -(defalias '-copy #'copy-sequence - "Create a shallow copy of LIST. - -\(fn LIST)") - -(defmacro --splice (pred form list) - "Splice lists generated by FORM in place of items satisfying PRED in LIST. - -Evaluate PRED for each element of LIST in turn bound to `it'. -Whenever the result of PRED is nil, leave that `it' is-is. -Otherwise, evaluate FORM with the same `it' binding still in -place. The result should be a (possibly empty) list of items to -splice in place of `it' in LIST. - -This can be useful as an alternative to the `,@' construct in a -`\\=`' structure, in case you need to splice several lists at -marked positions (for example with keywords). - -This is the anaphoric counterpart to `-splice'." - (declare (debug (form form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list - (if ,pred - (--each ,form (push it ,r)) - (push it ,r))) - (nreverse ,r)))) - -(defun -splice (pred fun list) - "Splice lists generated by FUN in place of items satisfying PRED in LIST. - -Call PRED on each element of LIST. Whenever the result of PRED -is nil, leave that `it' as-is. Otherwise, call FUN on the same -`it' that satisfied PRED. The result should be a (possibly -empty) list of items to splice in place of `it' in LIST. - -This can be useful as an alternative to the `,@' construct in a -`\\=`' structure, in case you need to splice several lists at -marked positions (for example with keywords). - -This function's anaphoric counterpart is `--splice'. - -See also: `-splice-list', `-insert-at'." - (declare (important-return-value t)) - (--splice (funcall pred it) (funcall fun it) list)) - -(defun -splice-list (pred new-list list) - "Splice NEW-LIST in place of elements matching PRED in LIST. - -See also: `-splice', `-insert-at'" - (declare (important-return-value t)) - (-splice pred (lambda (_) new-list) list)) - -(defmacro --splice-list (pred new-list list) - "Anaphoric form of `-splice-list'." - (declare (debug (def-form form form))) - `(-splice-list (lambda (it) (ignore it) ,pred) ,new-list ,list)) - -(defun -cons* (&rest args) - "Make a new list from the elements of ARGS. -The last 2 elements of ARGS are used as the final cons of the -result, so if the final element of ARGS is not a list, the result -is a dotted list. With no ARGS, return nil." - (declare (pure t) (side-effect-free t)) - (let* ((len (length args)) - (tail (nthcdr (- len 2) args)) - (last (cdr tail))) - (if (null last) - (car args) - (setcdr tail (car last)) - args))) - -(defun -snoc (list elem &rest elements) - "Append ELEM to the end of the list. - -This is like `cons', but operates on the end of list. - -If any ELEMENTS are given, append them to the list as well." - (declare (pure t) (side-effect-free t)) - (-concat list (list elem) elements)) - -(defmacro --first (form list) - "Return the first item in LIST for which FORM evals to non-nil. -Return nil if no such element is found. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-first'." - (declare (debug (form form))) - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each-while ,list (or (not ,form) - (ignore (setq ,n it)))) - ,n))) - -(defun -first (pred list) - "Return the first item in LIST for which PRED returns non-nil. -Return nil if no such element is found. - -To get the first item in the list no questions asked, -use `-first-item'. - -Alias: `-find'. - -This function's anaphoric counterpart is `--first'." - (declare (important-return-value t)) - (--first (funcall pred it) list)) - -(defalias '-find #'-first) -(defalias '--find '--first) - -(defmacro --some (form list) - "Return non-nil if FORM evals to non-nil for at least one item in LIST. -If so, return the first such result of FORM. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-some'." - (declare (debug (form form))) - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each-while ,list (not (setq ,n ,form))) - ,n))) - -(defun -some (pred list) - "Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil. - -Alias: `-any'. - -This function's anaphoric counterpart is `--some'." - (declare (important-return-value t)) - (--some (funcall pred it) list)) - -(defalias '-any '-some) -(defalias '--any '--some) - -(defmacro --every (form list) - "Return non-nil if FORM evals to non-nil for all items in LIST. -If so, return the last such result of FORM. Otherwise, once an -item is reached for which FORM yields nil, return nil without -evaluating FORM for any further LIST elements. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. - -This macro is like `--every-p', but on success returns the last -non-nil result of FORM instead of just t. - -This is the anaphoric counterpart to `-every'." - (declare (debug (form form))) - (let ((a (make-symbol "all"))) - `(let ((,a t)) - (--each-while ,list (setq ,a ,form)) - ,a))) - -(defun -every (pred list) - "Return non-nil if PRED returns non-nil for all items in LIST. -If so, return the last such result of PRED. Otherwise, once an -item is reached for which PRED returns nil, return nil without -calling PRED on any further LIST elements. - -This function is like `-every-p', but on success returns the last -non-nil result of PRED instead of just t. - -This function's anaphoric counterpart is `--every'." - (declare (important-return-value t)) - (--every (funcall pred it) list)) - -(defmacro --last (form list) - "Anaphoric form of `-last'." - (declare (debug (form form))) - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each ,list - (when ,form (setq ,n it))) - ,n))) - -(defun -last (pred list) - "Return the last x in LIST where (PRED x) is non-nil, else nil." - (declare (important-return-value t)) - (--last (funcall pred it) list)) - -(defalias '-first-item #'car - "Return the first item of LIST, or nil on an empty list. - -See also: `-second-item', `-last-item', etc. - -\(fn LIST)") - -;; Ensure that calls to `-first-item' are compiled to a single opcode, -;; just like `car'. -(put '-first-item 'byte-opcode 'byte-car) -(put '-first-item 'byte-compile 'byte-compile-one-arg) -(put '-first-item 'pure t) -(put '-first-item 'side-effect-free t) - -(defalias '-second-item #'cadr - "Return the second item of LIST, or nil if LIST is too short. - -See also: `-first-item', `-third-item', etc. - -\(fn LIST)") - -(put '-second-item 'pure t) -(put '-second-item 'side-effect-free t) - -(defalias '-third-item - (if (fboundp 'caddr) - #'caddr - (lambda (list) (car (cddr list)))) - "Return the third item of LIST, or nil if LIST is too short. - -See also: `-second-item', `-fourth-item', etc. - -\(fn LIST)") - -(put '-third-item 'pure t) -(put '-third-item 'side-effect-free t) - -(defalias '-fourth-item - (if (fboundp 'cadddr) - #'cadddr - (lambda (list) (cadr (cddr list)))) - "Return the fourth item of LIST, or nil if LIST is too short. - -See also: `-third-item', `-fifth-item', etc. - -\(fn LIST)") - -(put '-fourth-item 'pure t) -(put '-fourth-item 'side-effect-free t) - -(defun -fifth-item (list) - "Return the fifth item of LIST, or nil if LIST is too short. - -See also: `-fourth-item', `-last-item', etc." - (declare (pure t) (side-effect-free t)) - (car (cddr (cddr list)))) - -(defun -last-item (list) - "Return the last item of LIST, or nil on an empty list. - -See also: `-first-item', etc." - (declare (pure t) (side-effect-free t)) - (car (last list))) - -;; Use `with-no-warnings' to suppress unbound `-last-item' or -;; undefined `gv--defsetter' warnings arising from both -;; `gv-define-setter' and `defsetf' in certain Emacs versions. -(with-no-warnings - (if (fboundp 'gv-define-setter) - (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val)) - (defsetf -last-item (x) (val) `(setcar (last ,x) ,val)))) - -(defun -butlast (list) - "Return a list of all items in list except for the last." - ;; no alias as we don't want magic optional argument - (declare (pure t) (side-effect-free t)) - (butlast list)) - -(defmacro --count (pred list) - "Anaphoric form of `-count'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let ((,r 0)) - (--each ,list (when ,pred (setq ,r (1+ ,r)))) - ,r))) - -(defun -count (pred list) - "Counts the number of items in LIST where (PRED item) is non-nil." - (declare (important-return-value t)) - (--count (funcall pred it) list)) - -(defun ---truthy? (obj) - "Return OBJ as a boolean value (t or nil)." - (declare (pure t) (side-effect-free error-free)) - (and obj t)) - -(defmacro --any? (form list) - "Anaphoric form of `-any?'." - (declare (debug (form form))) - `(and (--some ,form ,list) t)) - -(defun -any? (pred list) - "Return t if (PRED X) is non-nil for any X in LIST, else nil. - -Alias: `-any-p', `-some?', `-some-p'" - (declare (important-return-value t)) - (--any? (funcall pred it) list)) - -(defalias '-some? '-any?) -(defalias '--some? '--any?) -(defalias '-any-p '-any?) -(defalias '--any-p '--any?) -(defalias '-some-p '-any?) -(defalias '--some-p '--any?) - -(defmacro --all? (form list) - "Return t if FORM evals to non-nil for all items in LIST. -Otherwise, once an item is reached for which FORM yields nil, -return nil without evaluating FORM for any further LIST elements. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. - -The similar macro `--every' is more widely useful, since it -returns the last non-nil result of FORM instead of just t on -success. - -Alias: `--all-p', `--every-p', `--every?'. - -This is the anaphoric counterpart to `-all?'." - (declare (debug (form form))) - `(and (--every ,form ,list) t)) - -(defun -all? (pred list) - "Return t if (PRED X) is non-nil for all X in LIST, else nil. -In the latter case, stop after the first X for which (PRED X) is -nil, without calling PRED on any subsequent elements of LIST. - -The similar function `-every' is more widely useful, since it -returns the last non-nil result of PRED instead of just t on -success. - -Alias: `-all-p', `-every-p', `-every?'. - -This function's anaphoric counterpart is `--all?'." - (declare (important-return-value t)) - (--all? (funcall pred it) list)) - -(defalias '-every? '-all?) -(defalias '--every? '--all?) -(defalias '-all-p '-all?) -(defalias '--all-p '--all?) -(defalias '-every-p '-all?) -(defalias '--every-p '--all?) - -(defmacro --none? (form list) - "Anaphoric form of `-none?'." - (declare (debug (form form))) - `(--all? (not ,form) ,list)) - -(defun -none? (pred list) - "Return t if (PRED X) is nil for all X in LIST, else nil. - -Alias: `-none-p'" - (declare (important-return-value t)) - (--none? (funcall pred it) list)) - -(defalias '-none-p '-none?) -(defalias '--none-p '--none?) - -(defmacro --only-some? (form list) - "Anaphoric form of `-only-some?'." - (declare (debug (form form))) - (let ((y (make-symbol "yes")) - (n (make-symbol "no"))) - `(let (,y ,n) - (--each-while ,list (not (and ,y ,n)) - (if ,form (setq ,y t) (setq ,n t))) - (---truthy? (and ,y ,n))))) - -(defun -only-some? (pred list) - "Return t if different LIST items both satisfy and do not satisfy PRED. -That is, if PRED returns both nil for at least one item, and -non-nil for at least one other item in LIST. Return nil if all -items satisfy the predicate or none of them do. - -Alias: `-only-some-p'" - (declare (important-return-value t)) - (--only-some? (funcall pred it) list)) - -(defalias '-only-some-p '-only-some?) -(defalias '--only-some-p '--only-some?) - -(defun -slice (list from &optional to step) - "Return copy of LIST, starting from index FROM to index TO. - -FROM or TO may be negative. These values are then interpreted -modulo the length of the list. - -If STEP is a number, only each STEPth item in the resulting -section is returned. Defaults to 1." - (declare (pure t) (side-effect-free t)) - (let ((length (length list)) - (new-list nil)) - ;; to defaults to the end of the list - (setq to (or to length)) - (setq step (or step 1)) - ;; handle negative indices - (when (< from 0) - (setq from (mod from length))) - (when (< to 0) - (setq to (mod to length))) - - ;; iterate through the list, keeping the elements we want - (--each-while list (< it-index to) - (when (and (>= it-index from) - (= (mod (- from it-index) step) 0)) - (push it new-list))) - (nreverse new-list))) - -(defmacro --take-while (form list) - "Take successive items from LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. Return a new -list of the successive elements from the start of LIST for which -FORM evaluates to non-nil. -This is the anaphoric counterpart to `-take-while'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each-while ,list ,form (push it ,r)) - (nreverse ,r)))) - -(defun -take-while (pred list) - "Take successive items from LIST for which PRED returns non-nil. -PRED is a function of one argument. Return a new list of the -successive elements from the start of LIST for which PRED returns -non-nil. - -This function's anaphoric counterpart is `--take-while'. - -For another variant, see also `-drop-while'." - (declare (important-return-value t)) - (--take-while (funcall pred it) list)) - -(defmacro --drop-while (form list) - "Drop successive items from LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. Return the -tail (not a copy) of LIST starting from its first element for -which FORM evaluates to nil. -This is the anaphoric counterpart to `-drop-while'." - (declare (debug (form form))) - (let ((l (make-symbol "list"))) - `(let ((,l ,list)) - (--each-while ,l ,form (pop ,l)) - ,l))) - -(defun -drop-while (pred list) - "Drop successive items from LIST for which PRED returns non-nil. -PRED is a function of one argument. Return the tail (not a copy) -of LIST starting from its first element for which PRED returns -nil. - -This function's anaphoric counterpart is `--drop-while'. - -For another variant, see also `-take-while'." - (declare (important-return-value t)) - (--drop-while (funcall pred it) list)) - -(defun -take (n list) - "Return a copy of the first N items in LIST. -Return a copy of LIST if it contains N items or fewer. -Return nil if N is zero or less. - -See also: `-take-last'." - (declare (pure t) (side-effect-free t)) - (--take-while (< it-index n) list)) - -(defun -take-last (n list) - "Return a copy of the last N items of LIST in order. -Return a copy of LIST if it contains N items or fewer. -Return nil if N is zero or less. - -See also: `-take'." - (declare (pure t) (side-effect-free t)) - (copy-sequence (last list n))) - -(defalias '-drop #'nthcdr - "Return the tail (not a copy) of LIST without the first N items. -Return nil if LIST contains N items or fewer. -Return LIST if N is zero or less. - -For another variant, see also `-drop-last'. -\n(fn N LIST)") - -(defun -drop-last (n list) - "Return a copy of LIST without its last N items. -Return a copy of LIST if N is zero or less. -Return nil if LIST contains N items or fewer. - -See also: `-drop'." - (declare (pure t) (side-effect-free t)) - (nbutlast (copy-sequence list) n)) - -(defun -split-at (n list) - "Split LIST into two sublists after the Nth element. -The result is a list of two elements (TAKE DROP) where TAKE is a -new list of the first N elements of LIST, and DROP is the -remaining elements of LIST (not a copy). TAKE and DROP are like -the results of `-take' and `-drop', respectively, but the split -is done in a single list traversal." - (declare (pure t) (side-effect-free t)) - (let (result) - (--each-while list (< it-index n) - (push (pop list) result)) - (list (nreverse result) list))) - -(defun -rotate (n list) - "Rotate LIST N places to the right (left if N is negative). -The time complexity is O(n)." - (declare (pure t) (side-effect-free t)) - (cond ((null list) ()) - ((zerop n) (copy-sequence list)) - ((let* ((len (length list)) - (n-mod-len (mod n len)) - (new-tail-len (- len n-mod-len))) - (append (nthcdr new-tail-len list) (-take new-tail-len list)))))) - -(defun -insert-at (n x list) - "Return a list with X inserted into LIST at position N. - -See also: `-splice', `-splice-list'" - (declare (pure t) (side-effect-free t)) - (let ((split-list (-split-at n list))) - (nconc (car split-list) (cons x (cadr split-list))))) - -(defun -replace-at (n x list) - "Return a list with element at Nth position in LIST replaced with X. - -See also: `-replace'" - (declare (pure t) (side-effect-free t)) - (let ((split-list (-split-at n list))) - (nconc (car split-list) (cons x (cdr (cadr split-list)))))) - -(defun -update-at (n func list) - "Use FUNC to update the Nth element of LIST. -Return a copy of LIST where the Nth element is replaced with the -result of calling FUNC on it. - -See also: `-map-when'" - (declare (important-return-value t)) - (let ((split-list (-split-at n list))) - (nconc (car split-list) - (cons (funcall func (car (cadr split-list))) - (cdr (cadr split-list)))))) - -(defmacro --update-at (n form list) - "Anaphoric version of `-update-at'." - (declare (debug (form def-form form))) - `(-update-at ,n (lambda (it) (ignore it) ,form) ,list)) - -(defun -remove-at (n list) - "Return LIST with its element at index N removed. -That is, remove any element selected as (nth N LIST) from LIST -and return the result. - -This is a non-destructive operation: parts of LIST (but not -necessarily all of it) are copied as needed to avoid -destructively modifying it. - -See also: `-remove-at-indices', `-remove'." - (declare (pure t) (side-effect-free t)) - (if (zerop n) - (cdr list) - (--remove-first (= it-index n) list))) - -(defun -remove-at-indices (indices list) - "Return LIST with its elements at INDICES removed. -That is, for each index I in INDICES, remove any element selected -as (nth I LIST) from LIST. - -This is a non-destructive operation: parts of LIST (but not -necessarily all of it) are copied as needed to avoid -destructively modifying it. - -See also: `-remove-at', `-remove'." - (declare (pure t) (side-effect-free t)) - (setq indices (--drop-while (< it 0) (-sort #'< indices))) - (let ((i (pop indices)) res) - (--each-while list i - (pop list) - (if (/= it-index i) - (push it res) - (while (and indices (= (car indices) i)) - (pop indices)) - (setq i (pop indices)))) - (nconc (nreverse res) list))) - -(defmacro --split-with (pred list) - "Anaphoric form of `-split-with'." - (declare (debug (form form))) - (let ((l (make-symbol "list")) - (r (make-symbol "result")) - (c (make-symbol "continue"))) - `(let ((,l ,list) - (,r nil) - (,c t)) - (while (and ,l ,c) - (let ((it (car ,l))) - (if (not ,pred) - (setq ,c nil) - (!cons it ,r) - (!cdr ,l)))) - (list (nreverse ,r) ,l)))) - -(defun -split-with (pred list) - "Split LIST into a prefix satisfying PRED, and the rest. -The first sublist is the prefix of LIST with successive elements -satisfying PRED, and the second sublist is the remaining elements -that do not. The result is like performing - - ((-take-while PRED LIST) (-drop-while PRED LIST)) - -but in no more than a single pass through LIST." - (declare (important-return-value t)) - (--split-with (funcall pred it) list)) - -(defmacro -split-on (item list) - "Split the LIST each time ITEM is found. - -Unlike `-partition-by', the ITEM is discarded from the results. -Empty lists are also removed from the result. - -Comparison is done by `equal'. - -See also `-split-when'" - (declare (debug (def-form form))) - `(-split-when (lambda (it) (equal it ,item)) ,list)) - -(defmacro --split-when (form list) - "Anaphoric version of `-split-when'." - (declare (debug (def-form form))) - `(-split-when (lambda (it) (ignore it) ,form) ,list)) - -(defun -split-when (fn list) - "Split the LIST on each element where FN returns non-nil. - -Unlike `-partition-by', the \"matched\" element is discarded from -the results. Empty lists are also removed from the result. - -This function can be thought of as a generalization of -`split-string'." - (declare (important-return-value t)) - (let (r s) - (while list - (if (not (funcall fn (car list))) - (push (car list) s) - (when s (push (nreverse s) r)) - (setq s nil)) - (!cdr list)) - (when s (push (nreverse s) r)) - (nreverse r))) - -(defmacro --separate (form list) - "Anaphoric form of `-separate'." - (declare (debug (form form))) - (let ((y (make-symbol "yes")) - (n (make-symbol "no"))) - `(let (,y ,n) - (--each ,list (if ,form (!cons it ,y) (!cons it ,n))) - (list (nreverse ,y) (nreverse ,n))))) - -(defun -separate (pred list) - "Split LIST into two sublists based on whether items satisfy PRED. -The result is like performing - - ((-filter PRED LIST) (-remove PRED LIST)) - -but in a single pass through LIST." - (declare (important-return-value t)) - (--separate (funcall pred it) list)) - -(defun dash--partition-all-in-steps-reversed (n step list) - "Like `-partition-all-in-steps', but the result is reversed." - (when (< step 1) - (signal 'wrong-type-argument - `("Step size < 1 results in juicy infinite loops" ,step))) - (let (result) - (while list - (push (-take n list) result) - (setq list (nthcdr step list))) - result)) - -(defun -partition-all-in-steps (n step list) - "Partition LIST into sublists of length N that are STEP items apart. -Adjacent groups may overlap if N exceeds the STEP stride. -Trailing groups may contain less than N items." - (declare (pure t) (side-effect-free t)) - (nreverse (dash--partition-all-in-steps-reversed n step list))) - -(defun -partition-in-steps (n step list) - "Partition LIST into sublists of length N that are STEP items apart. -Like `-partition-all-in-steps', but if there are not enough items -to make the last group N-sized, those items are discarded." - (declare (pure t) (side-effect-free t)) - (let ((result (dash--partition-all-in-steps-reversed n step list))) - (while (and result (< (length (car result)) n)) - (pop result)) - (nreverse result))) - -(defun -partition-all (n list) - "Return a new list with the items in LIST grouped into N-sized sublists. -The last group may contain less than N items." - (declare (pure t) (side-effect-free t)) - (-partition-all-in-steps n n list)) - -(defun -partition (n list) - "Return a new list with the items in LIST grouped into N-sized sublists. -If there are not enough items to make the last group N-sized, -those items are discarded." - (declare (pure t) (side-effect-free t)) - (-partition-in-steps n n list)) - -(defmacro --partition-by (form list) - "Anaphoric form of `-partition-by'." - (declare (debug (form form))) - (let ((r (make-symbol "result")) - (s (make-symbol "sublist")) - (v (make-symbol "value")) - (n (make-symbol "new-value")) - (l (make-symbol "list"))) - `(let ((,l ,list)) - (when ,l - (let* ((,r nil) - (it (car ,l)) - (,s (list it)) - (,v ,form) - (,l (cdr ,l))) - (while ,l - (let* ((it (car ,l)) - (,n ,form)) - (unless (equal ,v ,n) - (!cons (nreverse ,s) ,r) - (setq ,s nil) - (setq ,v ,n)) - (!cons it ,s) - (!cdr ,l))) - (!cons (nreverse ,s) ,r) - (nreverse ,r)))))) - -(defun -partition-by (fn list) - "Apply FN to each item in LIST, splitting it each time FN returns a new value." - (declare (important-return-value t)) - (--partition-by (funcall fn it) list)) - -(defmacro --partition-by-header (form list) - "Anaphoric form of `-partition-by-header'." - (declare (debug (form form))) - (let ((r (make-symbol "result")) - (s (make-symbol "sublist")) - (h (make-symbol "header-value")) - (b (make-symbol "seen-body?")) - (n (make-symbol "new-value")) - (l (make-symbol "list"))) - `(let ((,l ,list)) - (when ,l - (let* ((,r nil) - (it (car ,l)) - (,s (list it)) - (,h ,form) - (,b nil) - (,l (cdr ,l))) - (while ,l - (let* ((it (car ,l)) - (,n ,form)) - (if (equal ,h ,n) - (when ,b - (!cons (nreverse ,s) ,r) - (setq ,s nil) - (setq ,b nil)) - (setq ,b t)) - (!cons it ,s) - (!cdr ,l))) - (!cons (nreverse ,s) ,r) - (nreverse ,r)))))) - -(defun -partition-by-header (fn list) - "Apply FN to the first item in LIST. That is the header -value. Apply FN to each item in LIST, splitting it each time FN -returns the header value, but only after seeing at least one -other value (the body)." - (declare (important-return-value t)) - (--partition-by-header (funcall fn it) list)) - -(defmacro --partition-after-pred (form list) - "Partition LIST after each element for which FORM evaluates to non-nil. -Each element of LIST in turn is bound to `it' before evaluating -FORM. - -This is the anaphoric counterpart to `-partition-after-pred'." - (let ((l (make-symbol "list")) - (r (make-symbol "result")) - (s (make-symbol "sublist"))) - `(let ((,l ,list) ,r ,s) - (when ,l - (--each ,l - (push it ,s) - (when ,form - (push (nreverse ,s) ,r) - (setq ,s ()))) - (when ,s - (push (nreverse ,s) ,r)) - (nreverse ,r))))) - -(defun -partition-after-pred (pred list) - "Partition LIST after each element for which PRED returns non-nil. - -This function's anaphoric counterpart is `--partition-after-pred'." - (declare (important-return-value t)) - (--partition-after-pred (funcall pred it) list)) - -(defun -partition-before-pred (pred list) - "Partition directly before each time PRED is true on an element of LIST." - (declare (important-return-value t)) - (nreverse (-map #'reverse - (-partition-after-pred pred (reverse list))))) - -(defun -partition-after-item (item list) - "Partition directly after each time ITEM appears in LIST." - (declare (pure t) (side-effect-free t)) - (-partition-after-pred (lambda (ele) (equal ele item)) - list)) - -(defun -partition-before-item (item list) - "Partition directly before each time ITEM appears in LIST." - (declare (pure t) (side-effect-free t)) - (-partition-before-pred (lambda (ele) (equal ele item)) - list)) - -(defmacro --group-by (form list) - "Anaphoric form of `-group-by'." - (declare (debug t)) - (let ((n (make-symbol "n")) - (k (make-symbol "k")) - (grp (make-symbol "grp"))) - `(nreverse - (-map - (lambda (,n) - (cons (car ,n) - (nreverse (cdr ,n)))) - (--reduce-from - (let* ((,k (,@form)) - (,grp (assoc ,k acc))) - (if ,grp - (setcdr ,grp (cons it (cdr ,grp))) - (push - (list ,k it) - acc)) - acc) - nil ,list))))) - -(defun -group-by (fn list) - "Separate LIST into an alist whose keys are FN applied to the -elements of LIST. Keys are compared by `equal'." - (declare (important-return-value t)) - (--group-by (funcall fn it) list)) - -(defun -interpose (sep list) - "Return a new list of all elements in LIST separated by SEP." - (declare (pure t) (side-effect-free t)) - (let (result) - (when list - (!cons (car list) result) - (!cdr list)) - (while list - (setq result (cons (car list) (cons sep result))) - (!cdr list)) - (nreverse result))) - -(defun -interleave (&rest lists) - "Return a new list of the first item in each list, then the second etc." - (declare (pure t) (side-effect-free t)) - (when lists - (let (result) - (while (-none? 'null lists) - (--each lists (!cons (car it) result)) - (setq lists (-map 'cdr lists))) - (nreverse result)))) - -(defmacro --zip-with (form list1 list2) - "Zip LIST1 and LIST2 into a new list according to FORM. -That is, evaluate FORM for each item pair from the two lists, and -return the list of results. The result is as long as the shorter -list. - -Each element of LIST1 and each element of LIST2 in turn are bound -pairwise to `it' and `other', respectively, and their index -within the list to `it-index', before evaluating FORM. - -This is the anaphoric counterpart to `-zip-with'." - (declare (debug (form form form))) - (let ((r (make-symbol "result")) - (l2 (make-symbol "list2"))) - `(let ((,l2 ,list2) ,r) - (--each-while ,list1 ,l2 - (let ((other (pop ,l2))) - (ignore other) - (push ,form ,r))) - (nreverse ,r)))) - -(defun -zip-with (fn list1 list2) - "Zip LIST1 and LIST2 into a new list using the function FN. -That is, apply FN pairwise taking as first argument the next -element of LIST1 and as second argument the next element of LIST2 -at the corresponding position. The result is as long as the -shorter list. - -This function's anaphoric counterpart is `--zip-with'. - -For other zips, see also `-zip-lists' and `-zip-fill'." - (declare (important-return-value t)) - (--zip-with (funcall fn it other) list1 list2)) - -(defun -zip-lists (&rest lists) - "Zip LISTS together. - -Group the head of each list, followed by the second element of -each list, and so on. The number of returned groupings is equal -to the length of the shortest input list, and the length of each -grouping is equal to the number of input LISTS. - -The return value is always a list of proper lists, in contrast to -`-zip' which returns a list of dotted pairs when only two input -LISTS are provided. - -See also: `-zip-pair'." - (declare (pure t) (side-effect-free t)) - (when lists - (let (results) - (while (--every it lists) - (push (mapcar #'car lists) results) - (setq lists (mapcar #'cdr lists))) - (nreverse results)))) - -(defun -zip-lists-fill (fill-value &rest lists) - "Zip LISTS together, padding shorter lists with FILL-VALUE. -This is like `-zip-lists' (which see), except it retains all -elements at positions beyond the end of the shortest list. The -number of returned groupings is equal to the length of the -longest input list, and the length of each grouping is equal to -the number of input LISTS." - (declare (pure t) (side-effect-free t)) - (when lists - (let (results) - (while (--some it lists) - (push (--map (if it (car it) fill-value) lists) results) - (setq lists (mapcar #'cdr lists))) - (nreverse results)))) - -(defun -unzip-lists (lists) - "Unzip LISTS. - -This works just like `-zip-lists' (which see), but takes a list -of lists instead of a variable number of arguments, such that - - (-unzip-lists (-zip-lists ARGS...)) - -is identity (given that the lists comprising ARGS are of the same -length)." - (declare (pure t) (side-effect-free t)) - (apply #'-zip-lists lists)) - -(defalias 'dash--length= - (if (fboundp 'length=) - #'length= - (lambda (list length) - (cond ((< length 0) nil) - ((zerop length) (null list)) - ((let ((last (nthcdr (1- length) list))) - (and last (null (cdr last)))))))) - "Return non-nil if LIST is of LENGTH. -This is a compatibility shim for `length=' in Emacs 28. -\n(fn LIST LENGTH)") - -(defun dash--zip-lists-or-pair (_form &rest lists) - "Return a form equivalent to applying `-zip' to LISTS. -This `compiler-macro' warns about discouraged `-zip' usage and -delegates to `-zip-lists' or `-zip-pair' depending on the number -of LISTS." - (if (not (dash--length= lists 2)) - (cons #'-zip-lists lists) - (let ((pair (cons #'-zip-pair lists)) - (msg "Use -zip-pair instead of -zip to get a list of pairs")) - (if (fboundp 'macroexp-warn-and-return) - (macroexp-warn-and-return msg pair) - (message msg) - pair)))) - -(defun -zip (&rest lists) - "Zip LISTS together. - -Group the head of each list, followed by the second element of -each list, and so on. The number of returned groupings is equal -to the length of the shortest input list, and the number of items -in each grouping is equal to the number of input LISTS. - -If only two LISTS are provided as arguments, return the groupings -as a list of dotted pairs. Otherwise, return the groupings as a -list of proper lists. - -Since the return value changes form depending on the number of -arguments, it is generally recommended to use `-zip-lists' -instead, or `-zip-pair' if a list of dotted pairs is desired. - -See also: `-unzip'." - (declare (compiler-macro dash--zip-lists-or-pair) - (pure t) (side-effect-free t)) - ;; For backward compatibility, return a list of dotted pairs if two - ;; arguments were provided. - (apply (if (dash--length= lists 2) #'-zip-pair #'-zip-lists) lists)) - -(defun -zip-pair (&rest lists) - "Zip LIST1 and LIST2 together. - -Make a pair with the head of each list, followed by a pair with -the second element of each list, and so on. The number of pairs -returned is equal to the length of the shorter input list. - -See also: `-zip-lists'." - (declare (advertised-calling-convention (list1 list2) "2.20.0") - (pure t) (side-effect-free t)) - (if (dash--length= lists 2) - (--zip-with (cons it other) (car lists) (cadr lists)) - (apply #'-zip-lists lists))) - -(defun -zip-fill (fill-value &rest lists) - "Zip LISTS together, padding shorter lists with FILL-VALUE. -This is like `-zip' (which see), except it retains all elements -at positions beyond the end of the shortest list. The number of -returned groupings is equal to the length of the longest input -list, and the length of each grouping is equal to the number of -input LISTS. - -Since the return value changes form depending on the number of -arguments, it is generally recommended to use `-zip-lists-fill' -instead, unless a list of dotted pairs is explicitly desired." - (declare (pure t) (side-effect-free t)) - (cond ((null lists) ()) - ((dash--length= lists 2) - (let ((list1 (car lists)) - (list2 (cadr lists)) - results) - (while (or list1 list2) - (push (cons (if list1 (pop list1) fill-value) - (if list2 (pop list2) fill-value)) - results)) - (nreverse results))) - ((apply #'-zip-lists-fill fill-value lists)))) - -(defun -unzip (lists) - "Unzip LISTS. - -This works just like `-zip' (which see), but takes a list of -lists instead of a variable number of arguments, such that - - (-unzip (-zip L1 L2 L3 ...)) - -is identity (given that the lists are of the same length, and -that `-zip' is not called with two arguments, because of the -caveat described in its docstring). - -Note in particular that calling `-unzip' on a list of two lists -will return a list of dotted pairs. - -Since the return value changes form depending on the number of -LISTS, it is generally recommended to use `-unzip-lists' instead." - (declare (pure t) (side-effect-free t)) - (apply #'-zip lists)) - -(defun -cycle (list) - "Return an infinite circular copy of LIST. -The returned list cycles through the elements of LIST and repeats -from the beginning." - (declare (pure t) (side-effect-free t)) - ;; Also works with sequences that aren't lists. - (let ((newlist (append list ()))) - (nconc newlist newlist))) - -(defun -pad (fill-value &rest lists) - "Pad each of LISTS with FILL-VALUE until they all have equal lengths. - -Ensure all LISTS are as long as the longest one by repeatedly -appending FILL-VALUE to the shorter lists, and return the -resulting LISTS." - (declare (pure t) (side-effect-free t)) - (let* ((lens (mapcar #'length lists)) - (maxlen (apply #'max 0 lens))) - (--map (append it (make-list (- maxlen (pop lens)) fill-value)) lists))) - -(defmacro --annotate (form list) - "Pair each item in LIST with the result of evaluating FORM. - -Return an alist of (RESULT . ITEM), where each ITEM is the -corresponding element of LIST, and RESULT is the value obtained -by evaluating FORM with ITEM bound to `it'. - -This is the anaphoric counterpart to `-annotate'." - (declare (debug (form form))) - `(--map (cons ,form it) ,list)) - -(defun -annotate (fn list) - "Pair each item in LIST with the result of passing it to FN. - -Return an alist of (RESULT . ITEM), where each ITEM is the -corresponding element of LIST, and RESULT is the value obtained -by calling FN on ITEM. - -This function's anaphoric counterpart is `--annotate'." - (declare (important-return-value t)) - (--annotate (funcall fn it) list)) - -(defun dash--table-carry (lists restore-lists &optional re) - "Helper for `-table' and `-table-flat'. - -If a list overflows, carry to the right and reset the list." - (while (not (or (car lists) - (equal lists '(nil)))) - (setcar lists (car restore-lists)) - (pop (cadr lists)) - (!cdr lists) - (!cdr restore-lists) - (when re - (push (nreverse (car re)) (cadr re)) - (setcar re nil) - (!cdr re)))) - -(defun -table (fn &rest lists) - "Compute outer product of LISTS using function FN. - -The function FN should have the same arity as the number of -supplied lists. - -The outer product is computed by applying fn to all possible -combinations created by taking one element from each list in -order. The dimension of the result is (length lists). - -See also: `-table-flat'" - (declare (important-return-value t)) - (let ((restore-lists (copy-sequence lists)) - (last-list (last lists)) - (re (make-list (length lists) nil))) - (while (car last-list) - (let ((item (apply fn (-map 'car lists)))) - (push item (car re)) - (setcar lists (cdar lists)) ;; silence byte compiler - (dash--table-carry lists restore-lists re))) - (nreverse (car (last re))))) - -(defun -table-flat (fn &rest lists) - "Compute flat outer product of LISTS using function FN. - -The function FN should have the same arity as the number of -supplied lists. - -The outer product is computed by applying fn to all possible -combinations created by taking one element from each list in -order. The results are flattened, ignoring the tensor structure -of the result. This is equivalent to calling: - - (-flatten-n (1- (length lists)) (apply \\='-table fn lists)) - -but the implementation here is much more efficient. - -See also: `-flatten-n', `-table'" - (declare (important-return-value t)) - (let ((restore-lists (copy-sequence lists)) - (last-list (last lists)) - re) - (while (car last-list) - (let ((item (apply fn (-map 'car lists)))) - (push item re) - (setcar lists (cdar lists)) ;; silence byte compiler - (dash--table-carry lists restore-lists))) - (nreverse re))) - -(defmacro --find-index (form list) - "Return the first index in LIST for which FORM evals to non-nil. -Return nil if no such index is found. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-find-index'." - (declare (debug (form form))) - `(--some (and ,form it-index) ,list)) - -(defun -find-index (pred list) - "Return the index of the first item satisfying PRED in LIST. -Return nil if no such item is found. - -PRED is called with one argument, the current list element, until -it returns non-nil, at which point the search terminates. - -This function's anaphoric counterpart is `--find-index'. - -See also: `-first', `-find-last-index'." - (declare (important-return-value t)) - (--find-index (funcall pred it) list)) - -(defun -elem-index (elem list) - "Return the first index of ELEM in LIST. -That is, the index within LIST of the first element that is -`equal' to ELEM. Return nil if there is no such element. - -See also: `-find-index'." - (declare (pure t) (side-effect-free t)) - (--find-index (equal elem it) list)) - -(defmacro --find-indices (form list) - "Return the list of indices in LIST for which FORM evals to non-nil. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-find-indices'." - (declare (debug (form form))) - `(--keep (and ,form it-index) ,list)) - -(defun -find-indices (pred list) - "Return the list of indices in LIST satisfying PRED. - -Each element of LIST in turn is passed to PRED. If the result is -non-nil, the index of that element in LIST is included in the -result. The returned indices are in ascending order, i.e., in -the same order as they appear in LIST. - -This function's anaphoric counterpart is `--find-indices'. - -See also: `-find-index', `-elem-indices'." - (declare (important-return-value t)) - (--find-indices (funcall pred it) list)) - -(defun -elem-indices (elem list) - "Return the list of indices at which ELEM appears in LIST. -That is, the indices of all elements of LIST `equal' to ELEM, in -the same ascending order as they appear in LIST." - (declare (pure t) (side-effect-free t)) - (--find-indices (equal elem it) list)) - -(defmacro --find-last-index (form list) - "Return the last index in LIST for which FORM evals to non-nil. -Return nil if no such index is found. -Each element of LIST in turn is bound to `it' and its index -within LIST to `it-index' before evaluating FORM. -This is the anaphoric counterpart to `-find-last-index'." - (declare (debug (form form))) - (let ((i (make-symbol "index"))) - `(let (,i) - (--each ,list - (when ,form (setq ,i it-index))) - ,i))) - -(defun -find-last-index (pred list) - "Return the index of the last item satisfying PRED in LIST. -Return nil if no such item is found. - -Predicate PRED is called with one argument each time, namely the -current list element. - -This function's anaphoric counterpart is `--find-last-index'. - -See also: `-last', `-find-index'." - (declare (important-return-value t)) - (--find-last-index (funcall pred it) list)) - -(defun -select-by-indices (indices list) - "Return a list whose elements are elements from LIST selected -as `(nth i list)` for all i from INDICES." - (declare (pure t) (side-effect-free t)) - (let (r) - (--each indices - (!cons (nth it list) r)) - (nreverse r))) - -(defun -select-columns (columns table) - "Select COLUMNS from TABLE. - -TABLE is a list of lists where each element represents one row. -It is assumed each row has the same length. - -Each row is transformed such that only the specified COLUMNS are -selected. - -See also: `-select-column', `-select-by-indices'" - (declare (pure t) (side-effect-free t)) - (--map (-select-by-indices columns it) table)) - -(defun -select-column (column table) - "Select COLUMN from TABLE. - -TABLE is a list of lists where each element represents one row. -It is assumed each row has the same length. - -The single selected column is returned as a list. - -See also: `-select-columns', `-select-by-indices'" - (declare (pure t) (side-effect-free t)) - (--mapcat (-select-by-indices (list column) it) table)) - -(defmacro -> (x &optional form &rest more) - "Thread the expr through the forms. Insert X as the second item -in the first form, making a list of it if it is not a list -already. If there are more forms, insert the first form as the -second item in second form, etc." - (declare (debug (form &rest [&or symbolp (sexp &rest form)]))) - (cond - ((null form) x) - ((null more) (if (listp form) - `(,(car form) ,x ,@(cdr form)) - (list form x))) - (:else `(-> (-> ,x ,form) ,@more)))) - -(defmacro ->> (x &optional form &rest more) - "Thread the expr through the forms. Insert X as the last item -in the first form, making a list of it if it is not a list -already. If there are more forms, insert the first form as the -last item in second form, etc." - (declare (debug ->)) - (cond - ((null form) x) - ((null more) (if (listp form) - `(,@form ,x) - (list form x))) - (:else `(->> (->> ,x ,form) ,@more)))) - -(defmacro --> (x &rest forms) - "Starting with the value of X, thread each expression through FORMS. - -Insert X at the position signified by the symbol `it' in the first -form. If there are more forms, insert the first form at the position -signified by `it' in in second form, etc." - (declare (debug (form body))) - `(-as-> ,x it ,@forms)) - -(defmacro -as-> (value variable &rest forms) - "Starting with VALUE, thread VARIABLE through FORMS. - -In the first form, bind VARIABLE to VALUE. In the second form, bind -VARIABLE to the result of the first form, and so forth." - (declare (debug (form symbolp body))) - (if (null forms) - `,value - `(let ((,variable ,value)) - (-as-> ,(if (symbolp (car forms)) - (list (car forms) variable) - (car forms)) - ,variable - ,@(cdr forms))))) - -(defmacro -some-> (x &optional form &rest more) - "When expr is non-nil, thread it through the first form (via `->'), -and when that result is non-nil, through the next form, etc." - (declare (debug ->) - (indent 1)) - (if (null form) x - (let ((result (make-symbol "result"))) - `(-some-> (-when-let (,result ,x) - (-> ,result ,form)) - ,@more)))) - -(defmacro -some->> (x &optional form &rest more) - "When expr is non-nil, thread it through the first form (via `->>'), -and when that result is non-nil, through the next form, etc." - (declare (debug ->) - (indent 1)) - (if (null form) x - (let ((result (make-symbol "result"))) - `(-some->> (-when-let (,result ,x) - (->> ,result ,form)) - ,@more)))) - -(defmacro -some--> (expr &rest forms) - "Thread EXPR through FORMS via `-->', while the result is non-nil. -When EXPR evaluates to non-nil, thread the result through the -first of FORMS, and when that result is non-nil, thread it -through the next form, etc." - (declare (debug (form &rest &or symbolp consp)) (indent 1)) - (if (null forms) expr - (let ((result (make-symbol "result"))) - `(-some--> (-when-let (,result ,expr) - (--> ,result ,(car forms))) - ,@(cdr forms))))) - -(defmacro -doto (init &rest forms) - "Evaluate INIT and pass it as argument to FORMS with `->'. -The RESULT of evaluating INIT is threaded through each of FORMS -individually using `->', which see. The return value is RESULT, -which FORMS may have modified by side effect." - (declare (debug (form &rest &or symbolp consp)) (indent 1)) - (let ((retval (make-symbol "result"))) - `(let ((,retval ,init)) - ,@(mapcar (lambda (form) `(-> ,retval ,form)) forms) - ,retval))) - -(defmacro --doto (init &rest forms) - "Anaphoric form of `-doto'. -This just evaluates INIT, binds the result to `it', evaluates -FORMS, and returns the final value of `it'. -Note: `it' need not be used in each form." - (declare (debug (form body)) (indent 1)) - `(let ((it ,init)) - ,@forms - it)) - -(defun -grade-up (comparator list) - "Grade elements of LIST using COMPARATOR relation. -This yields a permutation vector such that applying this -permutation to LIST sorts it in ascending order." - (declare (important-return-value t)) - (->> (--map-indexed (cons it it-index) list) - (-sort (lambda (it other) (funcall comparator (car it) (car other)))) - (mapcar #'cdr))) - -(defun -grade-down (comparator list) - "Grade elements of LIST using COMPARATOR relation. -This yields a permutation vector such that applying this -permutation to LIST sorts it in descending order." - (declare (important-return-value t)) - (->> (--map-indexed (cons it it-index) list) - (-sort (lambda (it other) (funcall comparator (car other) (car it)))) - (mapcar #'cdr))) - -(defvar dash--source-counter 0 - "Monotonic counter for generated symbols.") - -(defun dash--match-make-source-symbol () - "Generate a new dash-source symbol. - -All returned symbols are guaranteed to be unique." - (prog1 (make-symbol (format "--dash-source-%d--" dash--source-counter)) - (setq dash--source-counter (1+ dash--source-counter)))) - -(defun dash--match-ignore-place-p (symbol) - "Return non-nil if SYMBOL is a symbol and starts with _." - (and (symbolp symbol) - (eq (aref (symbol-name symbol) 0) ?_))) - -(defun dash--match-cons-skip-cdr (skip-cdr source) - "Helper function generating idiomatic shifting code." - (cond - ((= skip-cdr 0) - `(pop ,source)) - (t - `(prog1 ,(dash--match-cons-get-car skip-cdr source) - (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source)))))) - -(defun dash--match-cons-get-car (skip-cdr source) - "Helper function generating idiomatic code to get nth car." - (cond - ((= skip-cdr 0) - `(car ,source)) - ((= skip-cdr 1) - `(cadr ,source)) - (t - `(nth ,skip-cdr ,source)))) - -(defun dash--match-cons-get-cdr (skip-cdr source) - "Helper function generating idiomatic code to get nth cdr." - (cond - ((= skip-cdr 0) - source) - ((= skip-cdr 1) - `(cdr ,source)) - (t - `(nthcdr ,skip-cdr ,source)))) - -(defun dash--match-cons (match-form source) - "Setup a cons matching environment and call the real matcher." - (let ((s (dash--match-make-source-symbol)) - (n 0) - (m match-form)) - (while (and (consp m) - (dash--match-ignore-place-p (car m))) - (setq n (1+ n)) (!cdr m)) - (cond - ;; when we only have one pattern in the list, we don't have to - ;; create a temporary binding (--dash-source--) for the source - ;; and just use the input directly - ((and (consp m) - (not (cdr m))) - (dash--match (car m) (dash--match-cons-get-car n source))) - ;; handle other special types - ((> n 0) - (dash--match m (dash--match-cons-get-cdr n source))) - ;; this is the only entry-point for dash--match-cons-1, that's - ;; why we can't simply use the above branch, it would produce - ;; infinite recursion - (t - (cons (list s source) (dash--match-cons-1 match-form s)))))) - -(defun dash--get-expand-function (type) - "Get expand function name for TYPE." - (intern-soft (format "dash-expand:%s" type))) - -(defun dash--match-cons-1 (match-form source &optional props) - "Match MATCH-FORM against SOURCE. - -MATCH-FORM is a proper or improper list. Each element of -MATCH-FORM is either a symbol, which gets bound to the respective -value in source or another match form which gets destructured -recursively. - -If the cdr of last cons cell in the list is nil, matching stops -there. - -SOURCE is a proper or improper list." - (let ((skip-cdr (or (plist-get props :skip-cdr) 0))) - (cond - ((consp match-form) - (cond - ((cdr match-form) - (cond - ((and (symbolp (car match-form)) - (functionp (dash--get-expand-function (car match-form)))) - (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source))) - ((dash--match-ignore-place-p (car match-form)) - (dash--match-cons-1 (cdr match-form) source - (plist-put props :skip-cdr (1+ skip-cdr)))) - (t - (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source)) - (dash--match-cons-1 (cdr match-form) source))))) - (t ;; Last matching place, no need for shift - (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source))))) - ((eq match-form nil) - nil) - (t ;; Handle improper lists. Last matching place, no need for shift - (dash--match match-form (dash--match-cons-get-cdr skip-cdr source)))))) - -(defun dash--match-vector (match-form source) - "Setup a vector matching environment and call the real matcher." - (let ((s (dash--match-make-source-symbol))) - (cond - ;; don't bind `s' if we only have one sub-pattern - ((= (length match-form) 1) - (dash--match (aref match-form 0) `(aref ,source 0))) - ;; if the source is a symbol, we don't need to re-bind it - ((symbolp source) - (dash--match-vector-1 match-form source)) - ;; don't bind `s' if we only have one sub-pattern which is not ignored - ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form)) - (ignored-places-n (length (-remove 'null ignored-places)))) - (when (= ignored-places-n (1- (length match-form))) - (let ((n (-find-index 'null ignored-places))) - (dash--match (aref match-form n) `(aref ,source ,n)))))) - (t - (cons (list s source) (dash--match-vector-1 match-form s)))))) - -(defun dash--match-vector-1 (match-form source) - "Match MATCH-FORM against SOURCE. - -MATCH-FORM is a vector. Each element of MATCH-FORM is either a -symbol, which gets bound to the respective value in source or -another match form which gets destructured recursively. - -If second-from-last place in MATCH-FORM is the symbol &rest, the -next element of the MATCH-FORM is matched against the tail of -SOURCE, starting at index of the &rest symbol. This is -conceptually the same as the (head . tail) match for improper -lists, where dot plays the role of &rest. - -SOURCE is a vector. - -If the MATCH-FORM vector is shorter than SOURCE vector, only -the (length MATCH-FORM) places are bound, the rest of the SOURCE -is discarded." - (let ((i 0) - (l (length match-form)) - (re)) - (while (< i l) - (let ((m (aref match-form i))) - (push (cond - ((and (symbolp m) - (eq m '&rest)) - (prog1 (dash--match - (aref match-form (1+ i)) - `(substring ,source ,i)) - (setq i l))) - ((and (symbolp m) - ;; do not match symbols starting with _ - (not (eq (aref (symbol-name m) 0) ?_))) - (list (list m `(aref ,source ,i)))) - ((not (symbolp m)) - (dash--match m `(aref ,source ,i)))) - re) - (setq i (1+ i)))) - (-flatten-n 1 (nreverse re)))) - -(defun dash--match-kv-normalize-match-form (pattern) - "Normalize kv PATTERN. - -This method normalizes PATTERN to the format expected by -`dash--match-kv'. See `-let' for the specification." - (let ((normalized (list (car pattern))) - (skip nil) - (fill-placeholder (make-symbol "--dash-fill-placeholder--"))) - (-each (-zip-fill fill-placeholder (cdr pattern) (cddr pattern)) - (lambda (pair) - (let ((current (car pair)) - (next (cdr pair))) - (if skip - (setq skip nil) - (if (or (eq fill-placeholder next) - (not (or (and (symbolp next) - (not (keywordp next)) - (not (eq next t)) - (not (eq next nil))) - (and (consp next) - (not (eq (car next) 'quote))) - (vectorp next)))) - (progn - (cond - ((keywordp current) - (push current normalized) - (push (intern (substring (symbol-name current) 1)) normalized)) - ((stringp current) - (push current normalized) - (push (intern current) normalized)) - ((and (consp current) - (eq (car current) 'quote)) - (push current normalized) - (push (cadr current) normalized)) - (t (error "-let: found key `%s' in kv destructuring but its pattern `%s' is invalid and can not be derived from the key" current next))) - (setq skip nil)) - (push current normalized) - (push next normalized) - (setq skip t)))))) - (nreverse normalized))) - -(defun dash--match-kv (match-form source) - "Setup a kv matching environment and call the real matcher. - -kv can be any key-value store, such as plist, alist or hash-table." - (let ((s (dash--match-make-source-symbol))) - (cond - ;; don't bind `s' if we only have one sub-pattern (&type key val) - ((= (length match-form) 3) - (dash--match-kv-1 (cdr match-form) source (car match-form))) - ;; if the source is a symbol, we don't need to re-bind it - ((symbolp source) - (dash--match-kv-1 (cdr match-form) source (car match-form))) - (t - (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form))))))) - -(defun dash-expand:&hash (key source) - "Generate extracting KEY from SOURCE for &hash destructuring." - `(gethash ,key ,source)) - -(defun dash-expand:&plist (key source) - "Generate extracting KEY from SOURCE for &plist destructuring." - `(plist-get ,source ,key)) - -(defun dash-expand:&alist (key source) - "Generate extracting KEY from SOURCE for &alist destructuring." - `(cdr (assoc ,key ,source))) - -(defun dash-expand:&hash? (key source) - "Generate extracting KEY from SOURCE for &hash? destructuring. -Similar to &hash but check whether the map is not nil." - (let ((src (make-symbol "src"))) - `(let ((,src ,source)) - (when ,src (gethash ,key ,src))))) - -(defalias 'dash-expand:&keys 'dash-expand:&plist) - -(defun dash--match-kv-1 (match-form source type) - "Match MATCH-FORM against SOURCE of type TYPE. - -MATCH-FORM is a proper list of the form (key1 place1 ... keyN -placeN). Each placeK is either a symbol, which gets bound to the -value of keyK retrieved from the key-value store, or another -match form which gets destructured recursively. - -SOURCE is a key-value store of type TYPE, which can be a plist, -an alist or a hash table. - -TYPE is a token specifying the type of the key-value store. -Valid values are &plist, &alist and &hash." - (-flatten-n 1 (-map - (lambda (kv) - (let* ((k (car kv)) - (v (cadr kv)) - (getter - (funcall (dash--get-expand-function type) k source))) - (cond - ((symbolp v) - (list (list v getter))) - (t (dash--match v getter))))) - (-partition 2 match-form)))) - -(defun dash--match-symbol (match-form source) - "Bind a symbol. - -This works just like `let', there is no destructuring." - (list (list match-form source))) - -(defun dash--match (match-form source) - "Match MATCH-FORM against SOURCE. - -This function tests the MATCH-FORM and dispatches to specific -matchers based on the type of the expression. - -Key-value stores are disambiguated by placing a token &plist, -&alist or &hash as a first item in the MATCH-FORM." - (cond - ((and (symbolp match-form) - ;; Don't bind things like &keys as if they were vars (#395). - (not (functionp (dash--get-expand-function match-form)))) - (dash--match-symbol match-form source)) - ((consp match-form) - (cond - ;; Handle the "x &as" bindings first. - ((and (consp (cdr match-form)) - (symbolp (car match-form)) - (eq '&as (cadr match-form))) - (let ((s (car match-form))) - (cons (list s source) - (dash--match (cddr match-form) s)))) - ((functionp (dash--get-expand-function (car match-form))) - (dash--match-kv (dash--match-kv-normalize-match-form match-form) source)) - (t (dash--match-cons match-form source)))) - ((vectorp match-form) - ;; We support the &as binding in vectors too - (cond - ((and (> (length match-form) 2) - (symbolp (aref match-form 0)) - (eq '&as (aref match-form 1))) - (let ((s (aref match-form 0))) - (cons (list s source) - (dash--match (substring match-form 2) s)))) - (t (dash--match-vector match-form source)))))) - -(defun dash--normalize-let-varlist (varlist) - "Normalize VARLIST so that every binding is a list. - -`let' allows specifying a binding which is not a list but simply -the place which is then automatically bound to nil, such that all -three of the following are identical and evaluate to nil. - - (let (a) a) - (let ((a)) a) - (let ((a nil)) a) - -This function normalizes all of these to the last form." - (--map (if (consp it) it (list it nil)) varlist)) - -(defmacro -let* (varlist &rest body) - "Bind variables according to VARLIST then eval BODY. - -VARLIST is a list of lists of the form (PATTERN SOURCE). Each -PATTERN is matched against the SOURCE structurally. SOURCE is -only evaluated once for each PATTERN. - -Each SOURCE can refer to the symbols already bound by this -VARLIST. This is useful if you want to destructure SOURCE -recursively but also want to name the intermediate structures. - -See `-let' for the list of all possible patterns." - (declare (debug ((&rest [&or (sexp form) sexp]) body)) - (indent 1)) - (let* ((varlist (dash--normalize-let-varlist varlist)) - (bindings (--mapcat (dash--match (car it) (cadr it)) varlist))) - `(let* ,bindings - ,@body))) - -(defmacro -let (varlist &rest body) - "Bind variables according to VARLIST then eval BODY. - -VARLIST is a list of lists of the form (PATTERN SOURCE). Each -PATTERN is matched against the SOURCE \"structurally\". SOURCE -is only evaluated once for each PATTERN. Each PATTERN is matched -recursively, and can therefore contain sub-patterns which are -matched against corresponding sub-expressions of SOURCE. - -All the SOURCEs are evalled before any symbols are -bound (i.e. \"in parallel\"). - -If VARLIST only contains one (PATTERN SOURCE) element, you can -optionally specify it using a vector and discarding the -outer-most parens. Thus - - (-let ((PATTERN SOURCE)) ...) - -becomes - - (-let [PATTERN SOURCE] ...). - -`-let' uses a convention of not binding places (symbols) starting -with _ whenever it's possible. You can use this to skip over -entries you don't care about. However, this is not *always* -possible (as a result of implementation) and these symbols might -get bound to undefined values. - -Following is the overview of supported patterns. Remember that -patterns can be matched recursively, so every a, b, aK in the -following can be a matching construct and not necessarily a -symbol/variable. - -Symbol: - - a - bind the SOURCE to A. This is just like regular `let'. - -Conses and lists: - - (a) - bind `car' of cons/list to A - - (a . b) - bind car of cons to A and `cdr' to B - - (a b) - bind car of list to A and `cadr' to B - - (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3... - - (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST. - -Vectors: - - [a] - bind 0th element of a non-list sequence to A (works with - vectors, strings, bit arrays...) - - [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to - A1, 2nd to A2, ... - If the PATTERN is shorter than SOURCE, the values at - places not in PATTERN are ignored. - If the PATTERN is longer than SOURCE, an `error' is - thrown. - - [a1 a2 a3 ... &rest rest] - as above, but bind the rest of - the sequence to REST. This is - conceptually the same as improper list - matching (a1 a2 ... aN . rest) - -Key/value stores: - - (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE plist to aK. If the - value is not found, aK is nil. - Uses `plist-get' to fetch values. - - (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE alist to aK. If the - value is not found, aK is nil. - Uses `assoc' to fetch values. - - (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE hash table to aK. If the - value is not found, aK is nil. - Uses `gethash' to fetch values. - -Further, special keyword &keys supports \"inline\" matching of -plist-like key-value pairs, similarly to &keys keyword of -`cl-defun'. - - (a1 a2 ... aN &keys key1 b1 ... keyN bK) - -This binds N values from the list to a1 ... aN, then interprets -the cdr as a plist (see key/value matching above). - -A shorthand notation for kv-destructuring exists which allows the -patterns be optionally left out and derived from the key name in -the following fashion: - -- a key :foo is converted into `foo' pattern, -- a key \\='bar is converted into `bar' pattern, -- a key \"baz\" is converted into `baz' pattern. - -That is, the entire value under the key is bound to the derived -variable without any further destructuring. - -This is possible only when the form following the key is not a -valid pattern (i.e. not a symbol, a cons cell or a vector). -Otherwise the matching proceeds as usual and in case of an -invalid spec fails with an error. - -Thus the patterns are normalized as follows: - - ;; derive all the missing patterns - (&plist :foo \\='bar \"baz\") => (&plist :foo foo \\='bar bar \"baz\" baz) - - ;; we can specify some but not others - (&plist :foo \\='bar explicit-bar) => (&plist :foo foo \\='bar explicit-bar) - - ;; nothing happens, we store :foo in x - (&plist :foo x) => (&plist :foo x) - - ;; nothing happens, we match recursively - (&plist :foo (a b c)) => (&plist :foo (a b c)) - -You can name the source using the syntax SYMBOL &as PATTERN. -This syntax works with lists (proper or improper), vectors and -all types of maps. - - (list &as a b c) (list 1 2 3) - -binds A to 1, B to 2, C to 3 and LIST to (1 2 3). - -Similarly: - - (bounds &as beg . end) (cons 1 2) - -binds BEG to 1, END to 2 and BOUNDS to (1 . 2). - - (items &as first . rest) (list 1 2 3) - -binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3) - - [vect &as _ b c] [1 2 3] - -binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual). - - (plist &as &plist :b b) (list :a 1 :b 2 :c 3) - -binds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and &hash. - -This is especially useful when we want to capture the result of a -computation and destructure at the same time. Consider the -form (function-returning-complex-structure) returning a list of -two vectors with two items each. We want to capture this entire -result and pass it to another computation, but at the same time -we want to get the second item from each vector. We can achieve -it with pattern - - (result &as [_ a] [_ b]) (function-returning-complex-structure) - -Note: Clojure programmers may know this feature as the \":as -binding\". The difference is that we put the &as at the front -because we need to support improper list binding." - (declare (debug ([&or (&rest [&or (sexp form) sexp]) - (vector [&rest [sexp form]])] - body)) - (indent 1)) - (if (vectorp varlist) - `(let* ,(dash--match (aref varlist 0) (aref varlist 1)) - ,@body) - (let* ((varlist (dash--normalize-let-varlist varlist)) - (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist)) - (new-varlist (--zip-with (list (car it) (car other)) - varlist inputs))) - `(let ,inputs - (-let* ,new-varlist ,@body))))) - -(defmacro -lambda (match-form &rest body) - "Return a lambda which destructures its input as MATCH-FORM and executes BODY. - -Note that you have to enclose the MATCH-FORM in a pair of parens, -such that: - - (-lambda (x) body) - (-lambda (x y ...) body) - -has the usual semantics of `lambda'. Furthermore, these get -translated into normal `lambda', so there is no performance -penalty. - -See `-let' for a description of the destructuring mechanism." - (declare (doc-string 2) (indent defun) - (debug (&define sexp - [&optional stringp] - [&optional ("interactive" interactive)] - def-body))) - (cond - ((nlistp match-form) - (signal 'wrong-type-argument (list #'listp match-form))) - ;; No destructuring, so just return regular `lambda' for speed. - ((-all? #'symbolp match-form) - `(lambda ,match-form ,@body)) - ((let ((inputs (--map-indexed - (list it (make-symbol (format "input%d" it-index))) - match-form))) - ;; TODO: because inputs to the `lambda' are evaluated only once, - ;; `-let*' need not create the extra bindings to ensure that. - ;; We should find a way to optimize that. Not critical however. - `(lambda ,(mapcar #'cadr inputs) - (-let* ,inputs ,@body)))))) - -(defmacro -setq (&rest forms) - "Bind each MATCH-FORM to the value of its VAL. - -MATCH-FORM destructuring is done according to the rules of `-let'. - -This macro allows you to bind multiple variables by destructuring -the value, so for example: - - (-setq (a b) x - (&plist :c c) plist) - -expands roughly speaking to the following code - - (setq a (car x) - b (cadr x) - c (plist-get plist :c)) - -Care is taken to only evaluate each VAL once so that in case of -multiple assignments it does not cause unexpected side effects. - -\(fn [MATCH-FORM VAL]...)" - (declare (debug (&rest sexp form)) - (indent 1)) - (when (= (mod (length forms) 2) 1) - (signal 'wrong-number-of-arguments (list '-setq (1+ (length forms))))) - (let* ((forms-and-sources - ;; First get all the necessary mappings with all the - ;; intermediate bindings. - (-map (lambda (x) (dash--match (car x) (cadr x))) - (-partition 2 forms))) - ;; To preserve the logic of dynamic scoping we must ensure - ;; that we `setq' the variables outside of the `let*' form - ;; which holds the destructured intermediate values. For - ;; this we generate for each variable a placeholder which is - ;; bound to (lexically) the result of the destructuring. - ;; Then outside of the helper `let*' form we bind all the - ;; original variables to their respective placeholders. - ;; TODO: There is a lot of room for possible optimization, - ;; for start playing with `special-variable-p' to eliminate - ;; unnecessary re-binding. - (variables-to-placeholders - (-mapcat - (lambda (bindings) - (-map - (lambda (binding) - (let ((var (car binding))) - (list var (make-symbol (concat "--dash-binding-" (symbol-name var) "--"))))) - (--filter (not (string-prefix-p "--" (symbol-name (car it)))) bindings))) - forms-and-sources))) - `(let ,(-map 'cadr variables-to-placeholders) - (let* ,(-flatten-n 1 forms-and-sources) - (setq ,@(-flatten (-map 'reverse variables-to-placeholders)))) - (setq ,@(-flatten variables-to-placeholders))))) - -(defmacro -if-let* (vars-vals then &rest else) - "If all VALS evaluate to true, bind them to their corresponding -VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list -of (VAR VAL) pairs. - -Note: binding is done according to `-let*'. VALS are evaluated -sequentially, and evaluation stops after the first nil VAL is -encountered." - (declare (debug ((&rest (sexp form)) form body)) - (indent 2)) - (->> vars-vals - (--mapcat (dash--match (car it) (cadr it))) - (--reduce-r-from - (let ((var (car it)) - (val (cadr it))) - `(let ((,var ,val)) - (if ,var ,acc ,@else))) - then))) - -(defmacro -if-let (var-val then &rest else) - "If VAL evaluates to non-nil, bind it to VAR and do THEN, -otherwise do ELSE. - -Note: binding is done according to `-let'. - -\(fn (VAR VAL) THEN &rest ELSE)" - (declare (debug ((sexp form) form body)) - (indent 2)) - `(-if-let* (,var-val) ,then ,@else)) - -(defmacro --if-let (val then &rest else) - "If VAL evaluates to non-nil, bind it to symbol `it' and do THEN, -otherwise do ELSE." - (declare (debug (form form body)) - (indent 2)) - `(-if-let (it ,val) ,then ,@else)) - -(defmacro -when-let* (vars-vals &rest body) - "If all VALS evaluate to true, bind them to their corresponding -VARS and execute body. VARS-VALS should be a list of (VAR VAL) -pairs. - -Note: binding is done according to `-let*'. VALS are evaluated -sequentially, and evaluation stops after the first nil VAL is -encountered." - (declare (debug ((&rest (sexp form)) body)) - (indent 1)) - `(-if-let* ,vars-vals (progn ,@body))) - -(defmacro -when-let (var-val &rest body) - "If VAL evaluates to non-nil, bind it to VAR and execute body. - -Note: binding is done according to `-let'. - -\(fn (VAR VAL) &rest BODY)" - (declare (debug ((sexp form) body)) - (indent 1)) - `(-if-let ,var-val (progn ,@body))) - -(defmacro --when-let (val &rest body) - "If VAL evaluates to non-nil, bind it to symbol `it' and -execute body." - (declare (debug (form body)) - (indent 1)) - `(--if-let ,val (progn ,@body))) - -;; TODO: Get rid of this dynamic variable, passing it as an argument -;; instead? -(defvar -compare-fn nil - "Tests for equality use this function, or `equal' if this is nil. - -As a dynamic variable, this should be temporarily bound around -the relevant operation, rather than permanently modified. For -example: - - (let ((-compare-fn #\\='=)) - (-union \\='(1 2 3) \\='(2 3 4)))") - -(defun dash--member-fn () - "Return the flavor of `member' that goes best with `-compare-fn'." - (declare (side-effect-free error-free)) - (let ((cmp -compare-fn)) - (cond ((memq cmp '(nil equal)) #'member) - ((eq cmp #'eq) #'memq) - ((eq cmp #'eql) #'memql) - ((lambda (elt list) - (while (and list (not (funcall cmp elt (car list)))) - (pop list)) - list))))) - -(defun dash--assoc-fn () - "Return the flavor of `assoc' that goes best with `-compare-fn'." - (declare (side-effect-free error-free)) - (let ((cmp -compare-fn)) - (cond ((memq cmp '(nil equal)) #'assoc) - ((eq cmp #'eq) #'assq) - ;; Since Emacs 26, `assoc' accepts a custom `testfn'. - ;; Version testing would be simpler here, but feature - ;; testing gets more brownie points, I guess. - ((condition-case nil - (with-no-warnings (assoc nil () #'eql)) - (wrong-number-of-arguments t)) - (lambda (key alist) - (--first (and (consp it) (funcall cmp (car it) key)) alist))) - ((with-no-warnings - (lambda (key alist) - (assoc key alist cmp))))))) - -(defun dash--hash-test-fn () - "Return the hash table test function corresponding to `-compare-fn'. -Return nil if `-compare-fn' is not a known test function." - (declare (side-effect-free error-free)) - ;; In theory this could also recognize values that are custom - ;; `hash-table-test's, but too often the :test name is different - ;; from the equality function, so it doesn't seem worthwile. - (car (memq (or -compare-fn #'equal) '(equal eq eql)))) - -(defvar dash--short-list-length 32 - "Maximum list length considered short, for optimizations. -For example, the speedup afforded by hash table lookup may start -to outweigh its runtime and memory overhead for problem sizes -greater than this value. See also the discussion in PR #305.") - -(defun -distinct (list) - "Return a copy of LIST with all duplicate elements removed. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil. - -Alias: `-uniq'." - (declare (important-return-value t)) - (let (test len) - (cond ((null list) ()) - ;; Use a hash table if `-compare-fn' is a known hash table - ;; test function and the list is long enough. - ((and (setq test (dash--hash-test-fn)) - (> (setq len (length list)) dash--short-list-length)) - (let ((ht (make-hash-table :test test :size len))) - (--filter (unless (gethash it ht) (puthash it t ht)) list))) - ((let ((member (dash--member-fn)) uniq) - (--each list (unless (funcall member it uniq) (push it uniq))) - (nreverse uniq)))))) - -(defalias '-uniq #'-distinct) - -(defun dash--size+ (size1 size2) - "Return the sum of nonnegative fixnums SIZE1 and SIZE2. -Return `most-positive-fixnum' on overflow. This ensures the -result is a valid size, particularly for allocating hash tables, -even in the presence of bignum support." - (declare (side-effect-free t)) - (if (< size1 (- most-positive-fixnum size2)) - (+ size1 size2) - most-positive-fixnum)) - -(defun -union (list1 list2) - "Return a new list of distinct elements appearing in either LIST1 or LIST2. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil." - (declare (important-return-value t)) - (let ((lists (list list1 list2)) test len union) - (cond ((null (or list1 list2))) - ;; Use a hash table if `-compare-fn' is a known hash table - ;; test function and the lists are long enough. - ((and (setq test (dash--hash-test-fn)) - (> (setq len (dash--size+ (length list1) (length list2))) - dash--short-list-length)) - (let ((ht (make-hash-table :test test :size len))) - (dolist (l lists) - (--each l (unless (gethash it ht) - (puthash it t ht) - (push it union)))))) - ((let ((member (dash--member-fn))) - (dolist (l lists) - (--each l (unless (funcall member it union) (push it union))))))) - (nreverse union))) - -(defun -intersection (list1 list2) - "Return a new list of distinct elements appearing in both LIST1 and LIST2. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil." - (declare (important-return-value t)) - (let (test len) - (cond ((null (and list1 list2)) ()) - ;; Use a hash table if `-compare-fn' is a known hash table - ;; test function and either list is long enough. - ((and (setq test (dash--hash-test-fn)) - (> (setq len (length list2)) dash--short-list-length)) - (let ((ht (make-hash-table :test test :size len))) - (--each list2 (puthash it t ht)) - ;; Remove visited elements to avoid duplicates. - (--filter (when (gethash it ht) (remhash it ht) t) list1))) - ((let ((member (dash--member-fn)) intersection) - (--each list1 (and (funcall member it list2) - (not (funcall member it intersection)) - (push it intersection))) - (nreverse intersection)))))) - -(defun -difference (list1 list2) - "Return a new list with the distinct members of LIST1 that are not in LIST2. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil." - (declare (important-return-value t)) - (let (test len1 len2) - (cond ((null list1) ()) - ((null list2) (-distinct list1)) - ;; Use a hash table if `-compare-fn' is a known hash table - ;; test function and the subtrahend is long enough. - ((and (setq test (dash--hash-test-fn)) - (setq len1 (length list1)) - (setq len2 (length list2)) - (> (max len1 len2) dash--short-list-length)) - (let ((ht1 (make-hash-table :test test :size len1)) - (ht2 (make-hash-table :test test :size len2))) - (--each list2 (puthash it t ht2)) - ;; Avoid duplicates by tracking visited items in `ht1'. - (--filter (unless (or (gethash it ht2) (gethash it ht1)) - (puthash it t ht1)) - list1))) - ((let ((member (dash--member-fn)) difference) - (--each list1 - (unless (or (funcall member it list2) - (funcall member it difference)) - (push it difference))) - (nreverse difference)))))) - -(defun -powerset (list) - "Return the power set of LIST." - (declare (pure t) (side-effect-free t)) - (if (null list) (list ()) - (let ((last (-powerset (cdr list)))) - (nconc (mapcar (lambda (x) (cons (car list) x)) last) - last)))) - -(defun -frequencies (list) - "Count the occurrences of each distinct element of LIST. - -Return an alist of (ELEMENT . N), where each ELEMENT occurs N -times in LIST. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil. - -See also `-count' and `-group-by'." - (declare (important-return-value t)) - (let (test len freqs) - (cond ((null list)) - ((and (setq test (dash--hash-test-fn)) - (> (setq len (length list)) dash--short-list-length)) - (let ((ht (make-hash-table :test test :size len))) - ;; Share structure between hash table and returned list. - ;; This affords a single pass that preserves the input - ;; order, conses less garbage, and is faster than a - ;; second traversal (e.g., with `maphash'). - (--each list - (let ((freq (gethash it ht))) - (if freq - (setcdr freq (1+ (cdr freq))) - (push (puthash it (cons it 1) ht) freqs)))))) - ((let ((assoc (dash--assoc-fn))) - (--each list - (let ((freq (funcall assoc it freqs))) - (if freq - (setcdr freq (1+ (cdr freq))) - (push (cons it 1) freqs))))))) - (nreverse freqs))) - -(defun dash--numbers<= (nums) - "Return non-nil if NUMS is a list of non-decreasing numbers." - (declare (pure t) (side-effect-free t)) - (or (null nums) - (let ((prev (pop nums))) - (and (numberp prev) - (--every (and (numberp it) (<= prev (setq prev it))) nums))))) - -(defun dash--next-lex-perm (array n) - "Update ARRAY of N numbers with its next lexicographic permutation. -Return nil if there is no such successor. N should be nonzero. - -This implements the salient steps of Algorithm L (Lexicographic -permutation generation) as described in DE Knuth's The Art of -Computer Programming, Volume 4A / Combinatorial Algorithms, -Part I, Addison-Wesley, 2011, § 7.2.1.2, p. 319." - (setq n (1- n)) - (let* ((l n) - (j (1- n)) - (al (aref array n)) - (aj al)) - ;; L2. [Find j]. - ;; Decrement j until a[j] < a[j+1]. - (while (and (<= 0 j) - (<= aj (setq aj (aref array j)))) - (setq j (1- j))) - ;; Terminate algorithm if j not found. - (when (>= j 0) - ;; L3. [Increase a[j]]. - ;; Decrement l until a[j] < a[l]. - (while (>= aj al) - (setq l (1- l) al (aref array l))) - ;; Swap a[j] and a[l]. - (aset array j al) - (aset array l aj) - ;; L4. [Reverse a[j+1]...a[n]]. - (setq l n) - (while (< (setq j (1+ j)) l) - (setq aj (aref array j)) - (aset array j (aref array l)) - (aset array l aj) - (setq l (1- l))) - array))) - -(defun dash--lex-perms (vec &optional original) - "Return a list of permutations of VEC in lexicographic order. -Specifically, return only the successors of VEC in lexicographic -order. Each returned permutation is a list. VEC should comprise -one or more numbers, and may be destructively modified. - -If ORIGINAL is a vector, then VEC is interpreted as a set of -indices into ORIGINAL. In this case, the indices are permuted, -and the resulting index permutations are used to dereference -elements of ORIGINAL." - (let ((len (length vec)) perms) - (while vec - (push (if original - (--map (aref original it) vec) - (append vec ())) - perms) - (setq vec (dash--next-lex-perm vec len))) - (nreverse perms))) - -(defun dash--uniq-perms (list) - "Return a list of permutations of LIST. -LIST is treated as if all its elements are distinct." - (let* ((vec (vconcat list)) - (idxs (copy-sequence vec))) - ;; Just construct a vector of the list's indices and permute that. - (dotimes (i (length idxs)) - (aset idxs i i)) - (dash--lex-perms idxs vec))) - -(defun dash--multi-perms (list freqs) - "Return a list of permutations of the multiset LIST. -FREQS should be an alist describing the frequency of each element -in LIST, as returned by `-frequencies'." - (let (;; Distinct items in `list', aka the cars of `freqs'. - (uniq (make-vector (length freqs) nil)) - ;; Indices into `uniq'. - (idxs (make-vector (length list) nil)) - ;; Current index into `idxs'. - (i 0)) - (--each freqs - (aset uniq it-index (car it)) - ;; Populate `idxs' with as many copies of each `it-index' as - ;; there are corresponding duplicates. - (dotimes (_ (cdr it)) - (aset idxs i it-index) - (setq i (1+ i)))) - (dash--lex-perms idxs uniq))) - -(defun -permutations (list) - "Return the distinct permutations of LIST. - -Duplicate elements of LIST are determined by `equal', or by -`-compare-fn' if that is non-nil." - (declare (important-return-value t)) - (cond ((null list) (list ())) - ;; Optimization: a traversal of `list' is faster than the - ;; round trip via `dash--uniq-perms' or `dash--multi-perms'. - ((dash--numbers<= list) - (dash--lex-perms (vconcat list))) - ((let ((freqs (-frequencies list))) - ;; Is each element distinct? - (unless (--every (= (cdr it) 1) freqs) - (dash--multi-perms list freqs)))) - ((dash--uniq-perms list)))) - -(defun -inits (list) - "Return all prefixes of LIST." - (declare (pure t) (side-effect-free t)) - (let ((res (list list))) - (setq list (reverse list)) - (while list - (push (reverse (!cdr list)) res)) - res)) - -(defun -tails (list) - "Return all suffixes of LIST." - (declare (pure t) (side-effect-free t)) - (-reductions-r-from #'cons nil list)) - -(defun -common-prefix (&rest lists) - "Return the longest common prefix of LISTS." - (declare (pure t) (side-effect-free t)) - (--reduce (--take-while (and acc (equal (pop acc) it)) it) - lists)) - -(defun -common-suffix (&rest lists) - "Return the longest common suffix of LISTS." - (declare (pure t) (side-effect-free t)) - (nreverse (apply #'-common-prefix (mapcar #'reverse lists)))) - -(defun -contains? (list element) - "Return non-nil if LIST contains ELEMENT. - -The test for equality is done with `equal', or with `-compare-fn' -if that is non-nil. As with `member', the return value is -actually the tail of LIST whose car is ELEMENT. - -Alias: `-contains-p'." - (declare (important-return-value t)) - (funcall (dash--member-fn) element list)) - -(defalias '-contains-p #'-contains?) - -(defun -same-items? (list1 list2) - "Return non-nil if LIST1 and LIST2 have the same distinct elements. - -The order of the elements in the lists does not matter. The -lists may be of different lengths, i.e., contain duplicate -elements. The test for equality is done with `equal', or with -`-compare-fn' if that is non-nil. - -Alias: `-same-items-p'." - (declare (important-return-value t)) - (let (test len1 len2) - (cond ((null (or list1 list2))) - ((null (and list1 list2)) nil) - ;; Use a hash table if `-compare-fn' is a known hash table - ;; test function and either list is long enough. - ((and (setq test (dash--hash-test-fn)) - (setq len1 (length list1)) - (setq len2 (length list2)) - (> (max len1 len2) dash--short-list-length)) - (let ((ht1 (make-hash-table :test test :size len1)) - (ht2 (make-hash-table :test test :size len2))) - (--each list1 (puthash it t ht1)) - ;; Move visited elements from `ht1' to `ht2'. This way, - ;; if visiting all of `list2' leaves `ht1' empty, then - ;; all elements from both lists have been accounted for. - (and (--every (cond ((gethash it ht1) - (remhash it ht1) - (puthash it t ht2)) - ((gethash it ht2))) - list2) - (zerop (hash-table-count ht1))))) - ((let ((member (dash--member-fn))) - (and (--all? (funcall member it list2) list1) - (--all? (funcall member it list1) list2))))))) - -(defalias '-same-items-p #'-same-items?) - -(defun -is-prefix? (prefix list) - "Return non-nil if PREFIX is a prefix of LIST. - -Alias: `-is-prefix-p'." - (declare (pure t) (side-effect-free t)) - (--each-while list (and (equal (car prefix) it) - (!cdr prefix))) - (null prefix)) - -(defun -is-suffix? (suffix list) - "Return non-nil if SUFFIX is a suffix of LIST. - -Alias: `-is-suffix-p'." - (declare (pure t) (side-effect-free t)) - (equal suffix (last list (length suffix)))) - -(defun -is-infix? (infix list) - "Return non-nil if INFIX is infix of LIST. - -This operation runs in O(n^2) time - -Alias: `-is-infix-p'" - (declare (pure t) (side-effect-free t)) - (let (done) - (while (and (not done) list) - (setq done (-is-prefix? infix list)) - (!cdr list)) - done)) - -(defalias '-is-prefix-p '-is-prefix?) -(defalias '-is-suffix-p '-is-suffix?) -(defalias '-is-infix-p '-is-infix?) - -(defun -sort (comparator list) - "Sort LIST, stably, comparing elements using COMPARATOR. -Return the sorted list. LIST is NOT modified by side effects. -COMPARATOR is called with two elements of LIST, and should return non-nil -if the first element should sort before the second." - (declare (important-return-value t)) - (sort (copy-sequence list) comparator)) - -(defmacro --sort (form list) - "Anaphoric form of `-sort'." - (declare (debug (def-form form))) - `(-sort (lambda (it other) (ignore it other) ,form) ,list)) - -(defun -list (&optional arg &rest args) - "Ensure ARG is a list. -If ARG is already a list, return it as is (not a copy). -Otherwise, return a new list with ARG as its only element. - -Another supported calling convention is (-list &rest ARGS). -In this case, if ARG is not a list, a new list with all of -ARGS as elements is returned. This use is supported for -backward compatibility and is otherwise deprecated." - (declare (advertised-calling-convention (arg) "2.18.0") - (pure t) (side-effect-free error-free)) - (if (listp arg) arg (cons arg args))) - -(defun -repeat (n x) - "Return a new list of length N with each element being X. -Return nil if N is less than 1." - (declare (pure t) (side-effect-free t)) - (and (>= n 0) (make-list n x))) - -(defun -sum (list) - "Return the sum of LIST." - (declare (pure t) (side-effect-free t)) - (apply #'+ list)) - -(defun -running-sum (list) - "Return a list with running sums of items in LIST. -LIST must be non-empty." - (declare (pure t) (side-effect-free t)) - (or list (signal 'wrong-type-argument (list #'consp list))) - (-reductions #'+ list)) - -(defun -product (list) - "Return the product of LIST." - (declare (pure t) (side-effect-free t)) - (apply #'* list)) - -(defun -running-product (list) - "Return a list with running products of items in LIST. -LIST must be non-empty." - (declare (pure t) (side-effect-free t)) - (or list (signal 'wrong-type-argument (list #'consp list))) - (-reductions #'* list)) - -(defun -max (list) - "Return the largest value from LIST of numbers or markers." - (declare (pure t) (side-effect-free t)) - (apply #'max list)) - -(defun -min (list) - "Return the smallest value from LIST of numbers or markers." - (declare (pure t) (side-effect-free t)) - (apply #'min list)) - -(defun -max-by (comparator list) - "Take a comparison function COMPARATOR and a LIST and return -the greatest element of the list by the comparison function. - -See also combinator `-on' which can transform the values before -comparing them." - (declare (important-return-value t)) - (--reduce (if (funcall comparator it acc) it acc) list)) - -(defun -min-by (comparator list) - "Take a comparison function COMPARATOR and a LIST and return -the least element of the list by the comparison function. - -See also combinator `-on' which can transform the values before -comparing them." - (declare (important-return-value t)) - (--reduce (if (funcall comparator it acc) acc it) list)) - -(defmacro --max-by (form list) - "Anaphoric version of `-max-by'. - -The items for the comparator form are exposed as \"it\" and \"other\"." - (declare (debug (def-form form))) - `(-max-by (lambda (it other) (ignore it other) ,form) ,list)) - -(defmacro --min-by (form list) - "Anaphoric version of `-min-by'. - -The items for the comparator form are exposed as \"it\" and \"other\"." - (declare (debug (def-form form))) - `(-min-by (lambda (it other) (ignore it other) ,form) ,list)) - -(defun -iota (count &optional start step) - "Return a list containing COUNT numbers. -Starts from START and adds STEP each time. The default START is -zero, the default STEP is 1. -This function takes its name from the corresponding primitive in -the APL language." - (declare (pure t) (side-effect-free t)) - (unless (natnump count) - (signal 'wrong-type-argument (list #'natnump count))) - (or start (setq start 0)) - (or step (setq step 1)) - (if (zerop step) - (make-list count start) - (--iterate (+ it step) start count))) - -(defun -fix (fn list) - "Compute the (least) fixpoint of FN with initial input LIST. - -FN is called at least once, results are compared with `equal'." - (declare (important-return-value t)) - (let ((re (funcall fn list))) - (while (not (equal list re)) - (setq list re) - (setq re (funcall fn re))) - re)) - -(defmacro --fix (form list) - "Anaphoric form of `-fix'." - (declare (debug (def-form form))) - `(-fix (lambda (it) (ignore it) ,form) ,list)) - -(defun -unfold (fun seed) - "Build a list from SEED using FUN. - -This is \"dual\" operation to `-reduce-r': while -reduce-r -consumes a list to produce a single value, `-unfold' takes a -seed value and builds a (potentially infinite!) list. - -FUN should return nil to stop the generating process, or a -cons (A . B), where A will be prepended to the result and B is -the new seed." - (declare (important-return-value t)) - (let ((last (funcall fun seed)) r) - (while last - (push (car last) r) - (setq last (funcall fun (cdr last)))) - (nreverse r))) - -(defmacro --unfold (form seed) - "Anaphoric version of `-unfold'." - (declare (debug (def-form form))) - `(-unfold (lambda (it) (ignore it) ,form) ,seed)) - -(defun -cons-pair? (obj) - "Return non-nil if OBJ is a true cons pair. -That is, a cons (A . B) where B is not a list. - -Alias: `-cons-pair-p'." - (declare (pure t) (side-effect-free error-free)) - (nlistp (cdr-safe obj))) - -(defalias '-cons-pair-p '-cons-pair?) - -(defun -cons-to-list (con) - "Convert a cons pair to a list with `car' and `cdr' of the pair respectively." - (declare (pure t) (side-effect-free t)) - (list (car con) (cdr con))) - -(defun -value-to-list (val) - "Convert a value to a list. - -If the value is a cons pair, make a list with two elements, `car' -and `cdr' of the pair respectively. - -If the value is anything else, wrap it in a list." - (declare (pure t) (side-effect-free t)) - (if (-cons-pair? val) (-cons-to-list val) (list val))) - -(defun -tree-mapreduce-from (fn folder init-value tree) - "Apply FN to each element of TREE, and make a list of the results. -If elements of TREE are lists themselves, apply FN recursively to -elements of these nested lists. - -Then reduce the resulting lists using FOLDER and initial value -INIT-VALUE. See `-reduce-r-from'. - -This is the same as calling `-tree-reduce-from' after `-tree-map' -but is twice as fast as it only traverse the structure once." - (declare (important-return-value t)) - (cond - ((null tree) ()) - ((-cons-pair? tree) (funcall fn tree)) - ((consp tree) - (-reduce-r-from - folder init-value - (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) - ((funcall fn tree)))) - -(defmacro --tree-mapreduce-from (form folder init-value tree) - "Anaphoric form of `-tree-mapreduce-from'." - (declare (debug (def-form def-form form form))) - `(-tree-mapreduce-from (lambda (it) (ignore it) ,form) - (lambda (it acc) (ignore it acc) ,folder) - ,init-value - ,tree)) - -(defun -tree-mapreduce (fn folder tree) - "Apply FN to each element of TREE, and make a list of the results. -If elements of TREE are lists themselves, apply FN recursively to -elements of these nested lists. - -Then reduce the resulting lists using FOLDER and initial value -INIT-VALUE. See `-reduce-r-from'. - -This is the same as calling `-tree-reduce' after `-tree-map' -but is twice as fast as it only traverse the structure once." - (declare (important-return-value t)) - (cond - ((null tree) ()) - ((-cons-pair? tree) (funcall fn tree)) - ((consp tree) - (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) - ((funcall fn tree)))) - -(defmacro --tree-mapreduce (form folder tree) - "Anaphoric form of `-tree-mapreduce'." - (declare (debug (def-form def-form form))) - `(-tree-mapreduce (lambda (it) (ignore it) ,form) - (lambda (it acc) (ignore it acc) ,folder) - ,tree)) - -(defun -tree-map (fn tree) - "Apply FN to each element of TREE while preserving the tree structure." - (declare (important-return-value t)) - (cond - ((null tree) ()) - ((-cons-pair? tree) (funcall fn tree)) - ((consp tree) - (mapcar (lambda (x) (-tree-map fn x)) tree)) - ((funcall fn tree)))) - -(defmacro --tree-map (form tree) - "Anaphoric form of `-tree-map'." - (declare (debug (def-form form))) - `(-tree-map (lambda (it) (ignore it) ,form) ,tree)) - -(defun -tree-reduce-from (fn init-value tree) - "Use FN to reduce elements of list TREE. -If elements of TREE are lists themselves, apply the reduction recursively. - -FN is first applied to INIT-VALUE and first element of the list, -then on this result and second element from the list etc. - -The initial value is ignored on cons pairs as they always contain -two elements." - (declare (important-return-value t)) - (cond - ((null tree) ()) - ((-cons-pair? tree) tree) - ((consp tree) - (-reduce-r-from - fn init-value - (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) - (tree))) - -(defmacro --tree-reduce-from (form init-value tree) - "Anaphoric form of `-tree-reduce-from'." - (declare (debug (def-form form form))) - `(-tree-reduce-from (lambda (it acc) (ignore it acc) ,form) - ,init-value ,tree)) - -(defun -tree-reduce (fn tree) - "Use FN to reduce elements of list TREE. -If elements of TREE are lists themselves, apply the reduction recursively. - -FN is first applied to first element of the list and second -element, then on this result and third element from the list etc. - -See `-reduce-r' for how exactly are lists of zero or one element handled." - (declare (important-return-value t)) - (cond - ((null tree) ()) - ((-cons-pair? tree) tree) - ((consp tree) - (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) - (tree))) - -(defmacro --tree-reduce (form tree) - "Anaphoric form of `-tree-reduce'." - (declare (debug (def-form form))) - `(-tree-reduce (lambda (it acc) (ignore it acc) ,form) ,tree)) - -(defun -tree-map-nodes (pred fun tree) - "Call FUN on each node of TREE that satisfies PRED. - -If PRED returns nil, continue descending down this node. If PRED -returns non-nil, apply FUN to this node and do not descend -further." - (cond ((funcall pred tree) (funcall fun tree)) - ((and (listp tree) (listp (cdr tree))) - (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)) - (tree))) - -(defmacro --tree-map-nodes (pred form tree) - "Anaphoric form of `-tree-map-nodes'." - (declare (debug (def-form def-form form))) - `(-tree-map-nodes (lambda (it) (ignore it) ,pred) - (lambda (it) (ignore it) ,form) - ,tree)) - -(defun -tree-seq (branch children tree) - "Return a sequence of the nodes in TREE, in depth-first search order. - -BRANCH is a predicate of one argument that returns non-nil if the -passed argument is a branch, that is, a node that can have children. - -CHILDREN is a function of one argument that returns the children -of the passed branch node. - -Non-branch nodes are simply copied." - (declare (important-return-value t)) - (cons tree - (and (funcall branch tree) - (-mapcat (lambda (x) (-tree-seq branch children x)) - (funcall children tree))))) - -(defmacro --tree-seq (branch children tree) - "Anaphoric form of `-tree-seq'." - (declare (debug (def-form def-form form))) - `(-tree-seq (lambda (it) (ignore it) ,branch) - (lambda (it) (ignore it) ,children) - ,tree)) - -(defun -clone (list) - "Create a deep copy of LIST. -The new list has the same elements and structure but all cons are -replaced with new ones. This is useful when you need to clone a -structure such as plist or alist." - (declare (pure t) (side-effect-free t)) - (-tree-map #'identity list)) - -;;; Combinators - -(defalias '-partial #'apply-partially) - -(defun -rpartial (fn &rest args) - "Return a function that is a partial application of FN to ARGS. -ARGS is a list of the last N arguments to pass to FN. The result -is a new function which does the same as FN, except that the last -N arguments are fixed at the values with which this function was -called. This is like `-partial', except the arguments are fixed -starting from the right rather than the left." - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest args-before) (apply fn (append args-before args)))) - -(defun -juxt (&rest fns) - "Return a function that is the juxtaposition of FNS. -The returned function takes a variable number of ARGS, applies -each of FNS in turn to ARGS, and returns the list of results." - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns))) - -(defun -compose (&rest fns) - "Compose FNS into a single composite function. -Return a function that takes a variable number of ARGS, applies -the last function in FNS to ARGS, and returns the result of -calling each remaining function on the result of the previous -function, right-to-left. If no FNS are given, return a variadic -`identity' function." - (declare (pure t) (side-effect-free error-free)) - (let* ((fns (nreverse fns)) - (head (car fns)) - (tail (cdr fns))) - (cond (tail - (lambda (&rest args) - (--reduce-from (funcall it acc) (apply head args) tail))) - (fns head) - ((lambda (&optional arg &rest _) arg))))) - -(defun -applify (fn) - "Return a function that applies FN to a single list of args. -This changes the arity of FN from taking N distinct arguments to -taking 1 argument which is a list of N arguments." - (declare (pure t) (side-effect-free error-free)) - (lambda (args) (apply fn args))) - -(defun -on (op trans) - "Return a function that calls TRANS on each arg and OP on the results. -The returned function takes a variable number of arguments, calls -the function TRANS on each one in turn, and then passes those -results as the list of arguments to OP, in the same order. - -For example, the following pairs of expressions are morally -equivalent: - - (funcall (-on #\\='+ #\\='1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3)) - (funcall (-on #\\='+ #\\='1+)) = (+)" - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest args) - ;; This unrolling seems to be a relatively cheap way to keep the - ;; overhead of `mapcar' + `apply' in check. - (cond ((cddr args) - (apply op (mapcar trans args))) - ((cdr args) - (funcall op (funcall trans (car args)) (funcall trans (cadr args)))) - (args - (funcall op (funcall trans (car args)))) - ((funcall op))))) - -(defun -flip (fn) - "Return a function that calls FN with its arguments reversed. -The returned function takes the same number of arguments as FN. - -For example, the following two expressions are morally -equivalent: - - (funcall (-flip #\\='-) 1 2) = (- 2 1) - -See also: `-rotate-args'." - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest args) ;; Open-code for speed. - (cond ((cddr args) (apply fn (nreverse args))) - ((cdr args) (funcall fn (cadr args) (car args))) - (args (funcall fn (car args))) - ((funcall fn))))) - -(defun -rotate-args (n fn) - "Return a function that calls FN with args rotated N places to the right. -The returned function takes the same number of arguments as FN, -rotates the list of arguments N places to the right (left if N is -negative) just like `-rotate', and applies FN to the result. - -See also: `-flip'." - (declare (pure t) (side-effect-free t)) - (if (zerop n) - fn - (let ((even (= (% n 2) 0))) - (lambda (&rest args) - (cond ((cddr args) ;; Open-code for speed. - (apply fn (-rotate n args))) - ((cdr args) - (let ((fst (car args)) - (snd (cadr args))) - (funcall fn (if even fst snd) (if even snd fst)))) - (args - (funcall fn (car args))) - ((funcall fn))))))) - -(defun -const (c) - "Return a function that returns C ignoring any additional arguments. - -In types: a -> b -> a" - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest _) c)) - -(defmacro -cut (&rest params) - "Take n-ary function and n arguments and specialize some of them. -Arguments denoted by <> will be left unspecialized. - -See SRFI-26 for detailed description." - (declare (debug (&optional sexp &rest &or "<>" form))) - (let* ((i 0) - (args (--keep (when (eq it '<>) - (setq i (1+ i)) - (make-symbol (format "D%d" i))) - params))) - `(lambda ,args - ,(let ((body (--map (if (eq it '<>) (pop args) it) params))) - (if (eq (car params) '<>) - (cons #'funcall body) - body))))) - -(defun -not (pred) - "Return a predicate that negates the result of PRED. -The returned predicate passes its arguments to PRED. If PRED -returns nil, the result is non-nil; otherwise the result is nil. - -See also: `-andfn' and `-orfn'." - (declare (pure t) (side-effect-free error-free)) - (lambda (&rest args) (not (apply pred args)))) - -(defun -orfn (&rest preds) - "Return a predicate that returns the first non-nil result of PREDS. -The returned predicate takes a variable number of arguments, -passes them to each predicate in PREDS in turn until one of them -returns non-nil, and returns that non-nil result without calling -the remaining PREDS. If all PREDS return nil, or if no PREDS are -given, the returned predicate returns nil. - -See also: `-andfn' and `-not'." - (declare (pure t) (side-effect-free error-free)) - ;; Open-code for speed. - (cond ((cdr preds) (lambda (&rest args) (--some (apply it args) preds))) - (preds (car preds)) - (#'ignore))) - -(defun -andfn (&rest preds) - "Return a predicate that returns non-nil if all PREDS do so. -The returned predicate P takes a variable number of arguments and -passes them to each predicate in PREDS in turn. If any one of -PREDS returns nil, P also returns nil without calling the -remaining PREDS. If all PREDS return non-nil, P returns the last -such value. If no PREDS are given, P always returns non-nil. - -See also: `-orfn' and `-not'." - (declare (pure t) (side-effect-free error-free)) - ;; Open-code for speed. - (cond ((cdr preds) (lambda (&rest args) (--every (apply it args) preds))) - (preds (car preds)) - ;; As a `pure' function, this runtime check may generate - ;; backward-incompatible bytecode for `(-andfn)' at compile-time, - ;; but I doubt that's a problem in practice (famous last words). - ((fboundp 'always) #'always) - ((lambda (&rest _) t)))) - -(defun -iteratefn (fn n) - "Return a function FN composed N times with itself. - -FN is a unary function. If you need to use a function of higher -arity, use `-applify' first to turn it into a unary function. - -With n = 0, this acts as identity function. - -In types: (a -> a) -> Int -> a -> a. - -This function satisfies the following law: - - (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." - (declare (pure t) (side-effect-free error-free)) - (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) - -(defun -counter (&optional beg end inc) - "Return a closure that counts from BEG to END, with increment INC. - -The closure will return the next value in the counting sequence -each time it is called, and nil after END is reached. BEG -defaults to 0, INC defaults to 1, and if END is nil, the counter -will increment indefinitely. - -The closure accepts any number of arguments, which are discarded." - (declare (pure t) (side-effect-free error-free)) - (let ((inc (or inc 1)) - (n (or beg 0))) - (lambda (&rest _) - (when (or (not end) (< n end)) - (prog1 n - (setq n (+ n inc))))))) - -(defvar -fixfn-max-iterations 1000 - "The default maximum number of iterations performed by `-fixfn' - unless otherwise specified.") - -(defun -fixfn (fn &optional equal-test halt-test) - "Return a function that computes the (least) fixpoint of FN. - -FN must be a unary function. The returned lambda takes a single -argument, X, the initial value for the fixpoint iteration. The -iteration halts when either of the following conditions is satisfied: - - 1. Iteration converges to the fixpoint, with equality being - tested using EQUAL-TEST. If EQUAL-TEST is not specified, - `equal' is used. For functions over the floating point - numbers, it may be necessary to provide an appropriate - approximate comparison test. - - 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a - simple counter that returns t after `-fixfn-max-iterations', - to guard against infinite iteration. Otherwise, HALT-TEST - must be a function that accepts a single argument, the - current value of X, and returns non-nil as long as iteration - should continue. In this way, a more sophisticated - convergence test may be supplied by the caller. - -The return value of the lambda is either the fixpoint or, if -iteration halted before converging, a cons with car `halted' and -cdr the final output from HALT-TEST. - -In types: (a -> a) -> a -> a." - (declare (important-return-value t)) - (let ((eqfn (or equal-test 'equal)) - (haltfn (or halt-test - (-not - (-counter 0 -fixfn-max-iterations))))) - (lambda (x) - (let ((re (funcall fn x)) - (halt? (funcall haltfn x))) - (while (and (not halt?) (not (funcall eqfn x re))) - (setq x re - re (funcall fn re) - halt? (funcall haltfn re))) - (if halt? (cons 'halted halt?) - re))))) - -(defun -prodfn (&rest fns) - "Return a function that applies each of FNS to each of a list of arguments. - -Takes a list of N functions and returns a function that takes a -list of length N, applying Ith function to Ith element of the -input list. Returns a list of length N. - -In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) - -This function satisfies the following laws: - - (-compose (-prodfn f g ...) - (-prodfn f\\=' g\\=' ...)) - = (-prodfn (-compose f f\\=') - (-compose g g\\=') - ...) - - (-prodfn f g ...) - = (-juxt (-compose f (-partial #\\='nth 0)) - (-compose g (-partial #\\='nth 1)) - ...) - - (-compose (-prodfn f g ...) - (-juxt f\\=' g\\=' ...)) - = (-juxt (-compose f f\\=') - (-compose g g\\=') - ...) - - (-compose (-partial #\\='nth n) - (-prod f1 f2 ...)) - = (-compose fn (-partial #\\='nth n))" - (declare (pure t) (side-effect-free t)) - (lambda (x) (--zip-with (funcall it other) fns x))) - -;;; Font lock - -(defvar dash--keywords - `(;; TODO: Do not fontify the following automatic variables - ;; globally; detect and limit to their local anaphoric scope. - (,(rx symbol-start (| "acc" "it" "it-index" "other") symbol-end) - 0 font-lock-variable-name-face) - ;; Macros in dev/examples.el. Based on `lisp-mode-symbol-regexp'. - (,(rx ?\( (group (| "defexamples" "def-example-group")) symbol-end - (+ (in "\t ")) - (group (* (| (syntax word) (syntax symbol) (: ?\\ nonl))))) - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)) - ;; Symbols in dev/examples.el. - ,(rx symbol-start (| "=>" "~>" "!!>") symbol-end) - ;; Elisp macro fontification was static prior to Emacs 25. - ,@(when (< emacs-major-version 25) - (let ((macs '("!cdr" - "!cons" - "-->" - "--all-p" - "--all?" - "--annotate" - "--any" - "--any-p" - "--any?" - "--count" - "--dotimes" - "--doto" - "--drop-while" - "--each" - "--each-indexed" - "--each-r" - "--each-r-while" - "--each-while" - "--every" - "--every-p" - "--every?" - "--filter" - "--find" - "--find-index" - "--find-indices" - "--find-last-index" - "--first" - "--fix" - "--group-by" - "--if-let" - "--iterate" - "--keep" - "--last" - "--map" - "--map-first" - "--map-indexed" - "--map-last" - "--map-when" - "--mapcat" - "--max-by" - "--min-by" - "--none-p" - "--none?" - "--only-some-p" - "--only-some?" - "--partition-after-pred" - "--partition-by" - "--partition-by-header" - "--reduce" - "--reduce-from" - "--reduce-r" - "--reduce-r-from" - "--reductions" - "--reductions-from" - "--reductions-r" - "--reductions-r-from" - "--reject" - "--reject-first" - "--reject-last" - "--remove" - "--remove-first" - "--remove-last" - "--replace-where" - "--select" - "--separate" - "--some" - "--some-p" - "--some?" - "--sort" - "--splice" - "--splice-list" - "--split-when" - "--split-with" - "--take-while" - "--tree-map" - "--tree-map-nodes" - "--tree-mapreduce" - "--tree-mapreduce-from" - "--tree-reduce" - "--tree-reduce-from" - "--tree-seq" - "--unfold" - "--update-at" - "--when-let" - "--zip-with" - "->" - "->>" - "-as->" - "-cut" - "-doto" - "-if-let" - "-if-let*" - "-lambda" - "-let" - "-let*" - "-setq" - "-some-->" - "-some->" - "-some->>" - "-split-on" - "-when-let" - "-when-let*"))) - `((,(concat "(" (regexp-opt macs 'symbols)) . 1))))) - "Font lock keywords for `dash-fontify-mode'.") - -(defcustom dash-fontify-mode-lighter nil - "Mode line lighter for `dash-fontify-mode'. -Either a string to display in the mode line when -`dash-fontify-mode' is on, or nil to display -nothing (the default)." - :package-version '(dash . "2.18.0") - :type '(choice (string :tag "Lighter" :value " Dash") - (const :tag "Nothing" nil))) - -;;;###autoload -(define-minor-mode dash-fontify-mode - "Toggle fontification of Dash special variables. - -Dash-Fontify mode is a buffer-local minor mode intended for Emacs -Lisp buffers. Enabling it causes the special variables bound in -anaphoric Dash macros to be fontified. These anaphoras include -`it', `it-index', `acc', and `other'. In older Emacs versions -which do not dynamically detect macros, Dash-Fontify mode -additionally fontifies Dash macro calls. - -See also `dash-fontify-mode-lighter' and -`global-dash-fontify-mode'." - :lighter dash-fontify-mode-lighter - (if dash-fontify-mode - (font-lock-add-keywords nil dash--keywords t) - (font-lock-remove-keywords nil dash--keywords)) - (cond ((fboundp 'font-lock-flush) ;; Added in Emacs 25. - (font-lock-flush)) - ;; `font-lock-fontify-buffer' unconditionally enables - ;; `font-lock-mode' and is marked `interactive-only' in later - ;; Emacs versions which have `font-lock-flush', so we guard - ;; and pacify as needed, respectively. - (font-lock-mode - (with-no-warnings - (font-lock-fontify-buffer))))) - -(defun dash--turn-on-fontify-mode () - "Enable `dash-fontify-mode' if in an Emacs Lisp buffer." - (when (derived-mode-p #'emacs-lisp-mode) - (dash-fontify-mode))) - -;;;###autoload -(define-globalized-minor-mode global-dash-fontify-mode - dash-fontify-mode dash--turn-on-fontify-mode) - -(defcustom dash-enable-fontlock nil - "If non-nil, fontify Dash macro calls and special variables." - :set (lambda (sym val) - (set-default sym val) - (global-dash-fontify-mode (if val 1 0))) - :type 'boolean) - -(make-obsolete-variable - 'dash-enable-fontlock #'global-dash-fontify-mode "2.18.0") - -(define-obsolete-function-alias - 'dash-enable-font-lock #'global-dash-fontify-mode "2.18.0") - -;;; Info - -(defvar dash--info-doc-spec '("(dash) Index" nil "^ -+ .*: " "\\( \\|$\\)") - "The Dash :doc-spec entry for `info-lookup-alist'. -It is based on that for `emacs-lisp-mode'.") - -(defun dash--info-elisp-docs () - "Return the `emacs-lisp-mode' symbol docs from `info-lookup-alist'. -Specifically, return the cons containing their -`info-lookup->doc-spec' so that we can modify it." - (defvar info-lookup-alist) - (nthcdr 3 (assq #'emacs-lisp-mode (cdr (assq 'symbol info-lookup-alist))))) - -;;;###autoload -(defun dash-register-info-lookup () - "Register the Dash Info manual with `info-lookup-symbol'. -This allows Dash symbols to be looked up with \\[info-lookup-symbol]." - (interactive) - (require 'info-look) - (let ((docs (dash--info-elisp-docs))) - (setcar docs (append (car docs) (list dash--info-doc-spec))) - (info-lookup-reset))) - -(defun dash-unload-function () - "Remove Dash from `info-lookup-alist'. -Used by `unload-feature', which see." - (let ((docs (and (featurep 'info-look) - (dash--info-elisp-docs)))) - (when (member dash--info-doc-spec (car docs)) - (setcar docs (remove dash--info-doc-spec (car docs))) - (info-lookup-reset))) - nil) - -(provide 'dash) -;;; dash.el ends here diff --git a/elpa/dash-20230502.1324/dash.info b/elpa/dash-20230502.1324/dash.info deleted file mode 100644 index a99d3237..00000000 --- a/elpa/dash-20230502.1324/dash.info +++ /dev/null @@ -1,4948 +0,0 @@ -This is dash.info, produced by makeinfo version 6.7 from dash.texi. - -This manual is for Dash version 2.19.1. - - Copyright © 2012–2023 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with the Invariant Sections being “GNU General Public - License,” and no Front-Cover Texts or Back-Cover Texts. A copy of - the license is included in the section entitled “GNU Free - Documentation License”. -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Dash: (dash.info). A modern list library for GNU Emacs. -END-INFO-DIR-ENTRY - - -File: dash.info, Node: Top, Next: Installation, Up: (dir) - -Dash -**** - -This manual is for Dash version 2.19.1. - - Copyright © 2012–2023 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with the Invariant Sections being “GNU General Public - License,” and no Front-Cover Texts or Back-Cover Texts. A copy of - the license is included in the section entitled “GNU Free - Documentation License”. - -* Menu: - -* Installation:: Installing and configuring Dash. -* Functions:: Dash API reference. -* Development:: Contributing to Dash development. - -Appendices - -* FDL:: The license for this documentation. -* GPL:: Conditions for copying and changing Dash. -* Index:: Index including functions and macros. - - — The Detailed Node Listing — - -Installation - -* Using in a package:: Listing Dash as a package dependency. -* Fontification of special variables:: Font Lock of anaphoric macro variables. -* Info symbol lookup:: Looking up Dash symbols in this manual. - -Functions - -* Maps:: -* Sublist selection:: -* List to list:: -* Reductions:: -* Unfolding:: -* Predicates:: -* Partitioning:: -* Indexing:: -* Set operations:: -* Other list operations:: -* Tree operations:: -* Threading macros:: -* Binding:: -* Side effects:: -* Destructive operations:: -* Function combinators:: - -Development - -* Contribute:: How to contribute. -* Contributors:: List of contributors. - - -File: dash.info, Node: Installation, Next: Functions, Prev: Top, Up: Top - -1 Installation -************** - -Dash is available on GNU ELPA (https://elpa.gnu.org/), GNU-devel ELPA -(https://elpa.gnu.org/devel/), and MELPA (https://melpa.org/), and can -be installed with the standard command ‘package-install’ (*note -(emacs)Package Installation::). - -‘M-x package-install dash ’ - Install the Dash library. - - Alternatively, you can just dump ‘dash.el’ in your ‘load-path’ -somewhere (*note (emacs)Lisp Libraries::). - -* Menu: - -* Using in a package:: Listing Dash as a package dependency. -* Fontification of special variables:: Font Lock of anaphoric macro variables. -* Info symbol lookup:: Looking up Dash symbols in this manual. - - -File: dash.info, Node: Using in a package, Next: Fontification of special variables, Up: Installation - -1.1 Using in a package -====================== - -If you use Dash in your own package, be sure to list it as a dependency -in the library’s headers as follows (*note (elisp)Library Headers::). - - ;; Package-Requires: ((dash "2.19.1")) - - -File: dash.info, Node: Fontification of special variables, Next: Info symbol lookup, Prev: Using in a package, Up: Installation - -1.2 Fontification of special variables -====================================== - -The autoloaded minor mode ‘dash-fontify-mode’ is provided for optional -fontification of anaphoric Dash variables (‘it’, ‘acc’, etc.) in Emacs -Lisp buffers using search-based Font Lock (*note (emacs)Font Lock::). -In older Emacs versions which do not dynamically detect macros, the -minor mode also fontifies calls to Dash macros. - - To automatically enable the minor mode in all Emacs Lisp buffers, -just call its autoloaded global counterpart ‘global-dash-fontify-mode’, -either interactively or from your ‘user-init-file’: - - (global-dash-fontify-mode) - - -File: dash.info, Node: Info symbol lookup, Prev: Fontification of special variables, Up: Installation - -1.3 Info symbol lookup -====================== - -While editing Elisp files, you can use ‘C-h S’ (‘info-lookup-symbol’) to -look up Elisp symbols in the relevant Info manuals (*note (emacs)Info -Lookup::). To enable the same for Dash symbols, use the command -‘dash-register-info-lookup’. It can be called directly when needed, or -automatically from your ‘user-init-file’. For example: - - (with-eval-after-load 'info-look - (dash-register-info-lookup)) - - -File: dash.info, Node: Functions, Next: Development, Prev: Installation, Up: Top - -2 Functions -*********** - -This chapter contains reference documentation for the Dash API -(Application Programming Interface). The names of all public functions -defined in the library are prefixed with a dash character (‘-’). - - The library also provides anaphoric macro versions of functions where -that makes sense. The names of these macros are prefixed with two -dashes (‘--’) instead of one. - - For instance, while the function ‘-map’ applies a function to each -element of a list, its anaphoric counterpart ‘--map’ evaluates a form -with the local variable ‘it’ temporarily bound to the current list -element instead. - - ;; Normal version. - (-map (lambda (n) (* n n)) '(1 2 3 4)) - ⇒ (1 4 9 16) - - ;; Anaphoric version. - (--map (* it it) '(1 2 3 4)) - ⇒ (1 4 9 16) - - The normal version can, of course, also be written as in the -following example, which demonstrates the utility of both versions. - - (defun my-square (n) - "Return N multiplied by itself." - (* n n)) - - (-map #'my-square '(1 2 3 4)) - ⇒ (1 4 9 16) - -* Menu: - -* Maps:: -* Sublist selection:: -* List to list:: -* Reductions:: -* Unfolding:: -* Predicates:: -* Partitioning:: -* Indexing:: -* Set operations:: -* Other list operations:: -* Tree operations:: -* Threading macros:: -* Binding:: -* Side effects:: -* Destructive operations:: -* Function combinators:: - - -File: dash.info, Node: Maps, Next: Sublist selection, Up: Functions - -2.1 Maps -======== - -Functions in this category take a transforming function, which is then -applied sequentially to each or selected elements of the input list. -The results are collected in order and returned as a new list. - - -- Function: -map (fn list) - Apply FN to each item in LIST and return the list of results. - - This function’s anaphoric counterpart is ‘--map’. - - (-map (lambda (num) (* num num)) '(1 2 3 4)) - ⇒ (1 4 9 16) - (-map #'1+ '(1 2 3 4)) - ⇒ (2 3 4 5) - (--map (* it it) '(1 2 3 4)) - ⇒ (1 4 9 16) - - -- Function: -map-when (pred rep list) - Use PRED to conditionally apply REP to each item in LIST. Return a - copy of LIST where the items for which PRED returns ‘nil’ are - unchanged, and the rest are mapped through the REP function. - - Alias: ‘-replace-where’ - - See also: ‘-update-at’ (*note -update-at::) - - (-map-when 'even? 'square '(1 2 3 4)) - ⇒ (1 4 3 16) - (--map-when (> it 2) (* it it) '(1 2 3 4)) - ⇒ (1 2 9 16) - (--map-when (= it 2) 17 '(1 2 3 4)) - ⇒ (1 17 3 4) - - -- Function: -map-first (pred rep list) - Use PRED to determine the first item in LIST to call REP on. - Return a copy of LIST where the first item for which PRED returns - non-‘nil’ is replaced with the result of calling REP on that item. - - See also: ‘-map-when’ (*note -map-when::), ‘-replace-first’ (*note - -replace-first::) - - (-map-first 'even? 'square '(1 2 3 4)) - ⇒ (1 4 3 4) - (--map-first (> it 2) (* it it) '(1 2 3 4)) - ⇒ (1 2 9 4) - (--map-first (= it 2) 17 '(1 2 3 2)) - ⇒ (1 17 3 2) - - -- Function: -map-last (pred rep list) - Use PRED to determine the last item in LIST to call REP on. Return - a copy of LIST where the last item for which PRED returns non-‘nil’ - is replaced with the result of calling REP on that item. - - See also: ‘-map-when’ (*note -map-when::), ‘-replace-last’ (*note - -replace-last::) - - (-map-last 'even? 'square '(1 2 3 4)) - ⇒ (1 2 3 16) - (--map-last (> it 2) (* it it) '(1 2 3 4)) - ⇒ (1 2 3 16) - (--map-last (= it 2) 17 '(1 2 3 2)) - ⇒ (1 2 3 17) - - -- Function: -map-indexed (fn list) - Apply FN to each index and item in LIST and return the list of - results. This is like ‘-map’ (*note -map::), but FN takes two - arguments: the index of the current element within LIST, and the - element itself. - - This function’s anaphoric counterpart is ‘--map-indexed’. - - For a side-effecting variant, see also ‘-each-indexed’ (*note - -each-indexed::). - - (-map-indexed (lambda (index item) (- item index)) '(1 2 3 4)) - ⇒ (1 1 1 1) - (--map-indexed (- it it-index) '(1 2 3 4)) - ⇒ (1 1 1 1) - (-map-indexed #'* '(1 2 3 4)) - ⇒ (0 2 6 12) - - -- Function: -annotate (fn list) - Pair each item in LIST with the result of passing it to FN. - - Return an alist of (RESULT . ITEM), where each ITEM is the - corresponding element of LIST, and RESULT is the value obtained by - calling FN on ITEM. - - This function’s anaphoric counterpart is ‘--annotate’. - - (-annotate #'1+ '(1 2 3)) - ⇒ ((2 . 1) (3 . 2) (4 . 3)) - (-annotate #'length '((f o o) (bar baz))) - ⇒ ((3 f o o) (2 bar baz)) - (--annotate (> it 1) '(0 1 2 3)) - ⇒ ((nil . 0) (nil . 1) (t . 2) (t . 3)) - - -- Function: -splice (pred fun list) - Splice lists generated by FUN in place of items satisfying PRED in - LIST. - - Call PRED on each element of LIST. Whenever the result of PRED is - ‘nil’, leave that ‘it’ as-is. Otherwise, call FUN on the same ‘it’ - that satisfied PRED. The result should be a (possibly empty) list - of items to splice in place of ‘it’ in LIST. - - This can be useful as an alternative to the ‘,@’ construct in a ‘`’ - structure, in case you need to splice several lists at marked - positions (for example with keywords). - - This function’s anaphoric counterpart is ‘--splice’. - - See also: ‘-splice-list’ (*note -splice-list::), ‘-insert-at’ - (*note -insert-at::). - - (-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2)) - ⇒ (a 1 1 b 2 2) - (--splice t (list it it) '(1 2 3 4)) - ⇒ (1 1 2 2 3 3 4 4) - (--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar))) - ⇒ ((foo) (magical) (code) (bar)) - - -- Function: -splice-list (pred new-list list) - Splice NEW-LIST in place of elements matching PRED in LIST. - - See also: ‘-splice’ (*note -splice::), ‘-insert-at’ (*note - -insert-at::) - - (-splice-list 'keywordp '(a b c) '(1 :foo 2)) - ⇒ (1 a b c 2) - (-splice-list 'keywordp nil '(1 :foo 2)) - ⇒ (1 2) - (--splice-list (keywordp it) '(a b c) '(1 :foo 2)) - ⇒ (1 a b c 2) - - -- Function: -mapcat (fn list) - Return the concatenation of the result of mapping FN over LIST. - Thus function FN should return a list. - - (-mapcat 'list '(1 2 3)) - ⇒ (1 2 3) - (-mapcat (lambda (item) (list 0 item)) '(1 2 3)) - ⇒ (0 1 0 2 0 3) - (--mapcat (list 0 it) '(1 2 3)) - ⇒ (0 1 0 2 0 3) - - -- Function: -copy (list) - Create a shallow copy of LIST. - - (-copy '(1 2 3)) - ⇒ (1 2 3) - (let ((a '(1 2 3))) (eq a (-copy a))) - ⇒ nil - - -File: dash.info, Node: Sublist selection, Next: List to list, Prev: Maps, Up: Functions - -2.2 Sublist selection -===================== - -Functions returning a sublist of the original list. - - -- Function: -filter (pred list) - Return a new list of the items in LIST for which PRED returns - non-‘nil’. - - Alias: ‘-select’. - - This function’s anaphoric counterpart is ‘--filter’. - - For similar operations, see also ‘-keep’ (*note -keep::) and - ‘-remove’ (*note -remove::). - - (-filter (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) - ⇒ (2 4) - (-filter #'natnump '(-2 -1 0 1 2)) - ⇒ (0 1 2) - (--filter (= 0 (% it 2)) '(1 2 3 4)) - ⇒ (2 4) - - -- Function: -remove (pred list) - Return a new list of the items in LIST for which PRED returns - ‘nil’. - - Alias: ‘-reject’. - - This function’s anaphoric counterpart is ‘--remove’. - - For similar operations, see also ‘-keep’ (*note -keep::) and - ‘-filter’ (*note -filter::). - - (-remove (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) - ⇒ (1 3) - (-remove #'natnump '(-2 -1 0 1 2)) - ⇒ (-2 -1) - (--remove (= 0 (% it 2)) '(1 2 3 4)) - ⇒ (1 3) - - -- Function: -remove-first (pred list) - Remove the first item from LIST for which PRED returns non-‘nil’. - This is a non-destructive operation, but only the front of LIST - leading up to the removed item is a copy; the rest is LIST’s - original tail. If no item is removed, then the result is a - complete copy. - - Alias: ‘-reject-first’. - - This function’s anaphoric counterpart is ‘--remove-first’. - - See also ‘-map-first’ (*note -map-first::), ‘-remove-item’ (*note - -remove-item::), and ‘-remove-last’ (*note -remove-last::). - - (-remove-first #'natnump '(-2 -1 0 1 2)) - ⇒ (-2 -1 1 2) - (-remove-first #'stringp '(1 2 "first" "second")) - ⇒ (1 2 "second") - (--remove-first (> it 3) '(1 2 3 4 5 6)) - ⇒ (1 2 3 5 6) - - -- Function: -remove-last (pred list) - Remove the last item from LIST for which PRED returns non-‘nil’. - The result is a copy of LIST regardless of whether an element is - removed. - - Alias: ‘-reject-last’. - - This function’s anaphoric counterpart is ‘--remove-last’. - - See also ‘-map-last’ (*note -map-last::), ‘-remove-item’ (*note - -remove-item::), and ‘-remove-first’ (*note -remove-first::). - - (-remove-last #'natnump '(1 3 5 4 7 8 10 -11)) - ⇒ (1 3 5 4 7 8 -11) - (-remove-last #'stringp '(1 2 "last" "second")) - ⇒ (1 2 "last") - (--remove-last (> it 3) '(1 2 3 4 5 6 7 8 9 10)) - ⇒ (1 2 3 4 5 6 7 8 9) - - -- Function: -remove-item (item list) - Return a copy of LIST with all occurrences of ITEM removed. The - comparison is done with ‘equal’. - - (-remove-item 3 '(1 2 3 2 3 4 5 3)) - ⇒ (1 2 2 4 5) - (-remove-item 'foo '(foo bar baz foo)) - ⇒ (bar baz) - (-remove-item "bob" '("alice" "bob" "eve" "bob")) - ⇒ ("alice" "eve") - - -- Function: -non-nil (list) - Return a copy of LIST with all ‘nil’ items removed. - - (-non-nil '(nil 1 nil 2 nil nil 3 4 nil 5 nil)) - ⇒ (1 2 3 4 5) - (-non-nil '((nil))) - ⇒ ((nil)) - (-non-nil ()) - ⇒ () - - -- Function: -slice (list from &optional to step) - Return copy of LIST, starting from index FROM to index TO. - - FROM or TO may be negative. These values are then interpreted - modulo the length of the list. - - If STEP is a number, only each STEPth item in the resulting section - is returned. Defaults to 1. - - (-slice '(1 2 3 4 5) 1) - ⇒ (2 3 4 5) - (-slice '(1 2 3 4 5) 0 3) - ⇒ (1 2 3) - (-slice '(1 2 3 4 5 6 7 8 9) 1 -1 2) - ⇒ (2 4 6 8) - - -- Function: -take (n list) - Return a copy of the first N items in LIST. Return a copy of LIST - if it contains N items or fewer. Return ‘nil’ if N is zero or - less. - - See also: ‘-take-last’ (*note -take-last::). - - (-take 3 '(1 2 3 4 5)) - ⇒ (1 2 3) - (-take 17 '(1 2 3 4 5)) - ⇒ (1 2 3 4 5) - (-take 0 '(1 2 3 4 5)) - ⇒ () - - -- Function: -take-last (n list) - Return a copy of the last N items of LIST in order. Return a copy - of LIST if it contains N items or fewer. Return ‘nil’ if N is zero - or less. - - See also: ‘-take’ (*note -take::). - - (-take-last 3 '(1 2 3 4 5)) - ⇒ (3 4 5) - (-take-last 17 '(1 2 3 4 5)) - ⇒ (1 2 3 4 5) - (-take-last 1 '(1 2 3 4 5)) - ⇒ (5) - - -- Function: -drop (n list) - Return the tail (not a copy) of LIST without the first N items. - Return ‘nil’ if LIST contains N items or fewer. Return LIST if N - is zero or less. - - For another variant, see also ‘-drop-last’ (*note -drop-last::). - - (-drop 3 '(1 2 3 4 5)) - ⇒ (4 5) - (-drop 17 '(1 2 3 4 5)) - ⇒ () - (-drop 0 '(1 2 3 4 5)) - ⇒ (1 2 3 4 5) - - -- Function: -drop-last (n list) - Return a copy of LIST without its last N items. Return a copy of - LIST if N is zero or less. Return ‘nil’ if LIST contains N items - or fewer. - - See also: ‘-drop’ (*note -drop::). - - (-drop-last 3 '(1 2 3 4 5)) - ⇒ (1 2) - (-drop-last 17 '(1 2 3 4 5)) - ⇒ () - (-drop-last 0 '(1 2 3 4 5)) - ⇒ (1 2 3 4 5) - - -- Function: -take-while (pred list) - Take successive items from LIST for which PRED returns non-‘nil’. - PRED is a function of one argument. Return a new list of the - successive elements from the start of LIST for which PRED returns - non-‘nil’. - - This function’s anaphoric counterpart is ‘--take-while’. - - For another variant, see also ‘-drop-while’ (*note -drop-while::). - - (-take-while #'even? '(1 2 3 4)) - ⇒ () - (-take-while #'even? '(2 4 5 6)) - ⇒ (2 4) - (--take-while (< it 4) '(1 2 3 4 3 2 1)) - ⇒ (1 2 3) - - -- Function: -drop-while (pred list) - Drop successive items from LIST for which PRED returns non-‘nil’. - PRED is a function of one argument. Return the tail (not a copy) - of LIST starting from its first element for which PRED returns - ‘nil’. - - This function’s anaphoric counterpart is ‘--drop-while’. - - For another variant, see also ‘-take-while’ (*note -take-while::). - - (-drop-while #'even? '(1 2 3 4)) - ⇒ (1 2 3 4) - (-drop-while #'even? '(2 4 5 6)) - ⇒ (5 6) - (--drop-while (< it 4) '(1 2 3 4 3 2 1)) - ⇒ (4 3 2 1) - - -- Function: -select-by-indices (indices list) - Return a list whose elements are elements from LIST selected as - ‘(nth i list)‘ for all i from INDICES. - - (-select-by-indices '(4 10 2 3 6) '("v" "e" "l" "o" "c" "i" "r" "a" "p" "t" "o" "r")) - ⇒ ("c" "o" "l" "o" "r") - (-select-by-indices '(2 1 0) '("a" "b" "c")) - ⇒ ("c" "b" "a") - (-select-by-indices '(0 1 2 0 1 3 3 1) '("f" "a" "r" "l")) - ⇒ ("f" "a" "r" "f" "a" "l" "l" "a") - - -- Function: -select-columns (columns table) - Select COLUMNS from TABLE. - - TABLE is a list of lists where each element represents one row. It - is assumed each row has the same length. - - Each row is transformed such that only the specified COLUMNS are - selected. - - See also: ‘-select-column’ (*note -select-column::), - ‘-select-by-indices’ (*note -select-by-indices::) - - (-select-columns '(0 2) '((1 2 3) (a b c) (:a :b :c))) - ⇒ ((1 3) (a c) (:a :c)) - (-select-columns '(1) '((1 2 3) (a b c) (:a :b :c))) - ⇒ ((2) (b) (:b)) - (-select-columns nil '((1 2 3) (a b c) (:a :b :c))) - ⇒ (nil nil nil) - - -- Function: -select-column (column table) - Select COLUMN from TABLE. - - TABLE is a list of lists where each element represents one row. It - is assumed each row has the same length. - - The single selected column is returned as a list. - - See also: ‘-select-columns’ (*note -select-columns::), - ‘-select-by-indices’ (*note -select-by-indices::) - - (-select-column 1 '((1 2 3) (a b c) (:a :b :c))) - ⇒ (2 b :b) - - -File: dash.info, Node: List to list, Next: Reductions, Prev: Sublist selection, Up: Functions - -2.3 List to list -================ - -Functions returning a modified copy of the input list. - - -- Function: -keep (fn list) - Return a new list of the non-‘nil’ results of applying FN to each - item in LIST. Like ‘-filter’ (*note -filter::), but returns the - non-‘nil’ results of FN instead of the corresponding elements of - LIST. - - Its anaphoric counterpart is ‘--keep’. - - (-keep #'cdr '((1 2 3) (4 5) (6))) - ⇒ ((2 3) (5)) - (-keep (lambda (n) (and (> n 3) (* 10 n))) '(1 2 3 4 5 6)) - ⇒ (40 50 60) - (--keep (and (> it 3) (* 10 it)) '(1 2 3 4 5 6)) - ⇒ (40 50 60) - - -- Function: -concat (&rest sequences) - Concatenate all the arguments and make the result a list. The - result is a list whose elements are the elements of all the - arguments. Each argument may be a list, vector or string. - - All arguments except the last argument are copied. The last - argument is just used as the tail of the new list. - - (-concat '(1)) - ⇒ (1) - (-concat '(1) '(2)) - ⇒ (1 2) - (-concat '(1) '(2 3) '(4)) - ⇒ (1 2 3 4) - - -- Function: -flatten (l) - Take a nested list L and return its contents as a single, flat - list. - - Note that because ‘nil’ represents a list of zero elements (an - empty list), any mention of ‘nil’ in L will disappear after - flattening. If you need to preserve nils, consider ‘-flatten-n’ - (*note -flatten-n::) or map them to some unique symbol and then map - them back. - - Conses of two atoms are considered "terminals", that is, they - aren’t flattened further. - - See also: ‘-flatten-n’ (*note -flatten-n::) - - (-flatten '((1))) - ⇒ (1) - (-flatten '((1 (2 3) (((4 (5))))))) - ⇒ (1 2 3 4 5) - (-flatten '(1 2 (3 . 4))) - ⇒ (1 2 (3 . 4)) - - -- Function: -flatten-n (num list) - Flatten NUM levels of a nested LIST. - - See also: ‘-flatten’ (*note -flatten::) - - (-flatten-n 1 '((1 2) ((3 4) ((5 6))))) - ⇒ (1 2 (3 4) ((5 6))) - (-flatten-n 2 '((1 2) ((3 4) ((5 6))))) - ⇒ (1 2 3 4 (5 6)) - (-flatten-n 3 '((1 2) ((3 4) ((5 6))))) - ⇒ (1 2 3 4 5 6) - - -- Function: -replace (old new list) - Replace all OLD items in LIST with NEW. - - Elements are compared using ‘equal’. - - See also: ‘-replace-at’ (*note -replace-at::) - - (-replace 1 "1" '(1 2 3 4 3 2 1)) - ⇒ ("1" 2 3 4 3 2 "1") - (-replace "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) - ⇒ ("a" "nice" "bar" "sentence" "about" "bar") - (-replace 1 2 nil) - ⇒ nil - - -- Function: -replace-first (old new list) - Replace the first occurrence of OLD with NEW in LIST. - - Elements are compared using ‘equal’. - - See also: ‘-map-first’ (*note -map-first::) - - (-replace-first 1 "1" '(1 2 3 4 3 2 1)) - ⇒ ("1" 2 3 4 3 2 1) - (-replace-first "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) - ⇒ ("a" "nice" "bar" "sentence" "about" "foo") - (-replace-first 1 2 nil) - ⇒ nil - - -- Function: -replace-last (old new list) - Replace the last occurrence of OLD with NEW in LIST. - - Elements are compared using ‘equal’. - - See also: ‘-map-last’ (*note -map-last::) - - (-replace-last 1 "1" '(1 2 3 4 3 2 1)) - ⇒ (1 2 3 4 3 2 "1") - (-replace-last "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) - ⇒ ("a" "nice" "foo" "sentence" "about" "bar") - (-replace-last 1 2 nil) - ⇒ nil - - -- Function: -insert-at (n x list) - Return a list with X inserted into LIST at position N. - - See also: ‘-splice’ (*note -splice::), ‘-splice-list’ (*note - -splice-list::) - - (-insert-at 1 'x '(a b c)) - ⇒ (a x b c) - (-insert-at 12 'x '(a b c)) - ⇒ (a b c x) - - -- Function: -replace-at (n x list) - Return a list with element at Nth position in LIST replaced with X. - - See also: ‘-replace’ (*note -replace::) - - (-replace-at 0 9 '(0 1 2 3 4 5)) - ⇒ (9 1 2 3 4 5) - (-replace-at 1 9 '(0 1 2 3 4 5)) - ⇒ (0 9 2 3 4 5) - (-replace-at 4 9 '(0 1 2 3 4 5)) - ⇒ (0 1 2 3 9 5) - - -- Function: -update-at (n func list) - Use FUNC to update the Nth element of LIST. Return a copy of LIST - where the Nth element is replaced with the result of calling FUNC - on it. - - See also: ‘-map-when’ (*note -map-when::) - - (-update-at 0 (lambda (x) (+ x 9)) '(0 1 2 3 4 5)) - ⇒ (9 1 2 3 4 5) - (-update-at 1 (lambda (x) (+ x 8)) '(0 1 2 3 4 5)) - ⇒ (0 9 2 3 4 5) - (--update-at 2 (length it) '("foo" "bar" "baz" "quux")) - ⇒ ("foo" "bar" 3 "quux") - - -- Function: -remove-at (n list) - Return LIST with its element at index N removed. That is, remove - any element selected as (nth N LIST) from LIST and return the - result. - - This is a non-destructive operation: parts of LIST (but not - necessarily all of it) are copied as needed to avoid destructively - modifying it. - - See also: ‘-remove-at-indices’ (*note -remove-at-indices::), - ‘-remove’ (*note -remove::). - - (-remove-at 0 '(a b c)) - ⇒ (b c) - (-remove-at 1 '(a b c)) - ⇒ (a c) - (-remove-at 2 '(a b c)) - ⇒ (a b) - - -- Function: -remove-at-indices (indices list) - Return LIST with its elements at INDICES removed. That is, for - each index I in INDICES, remove any element selected as (nth I - LIST) from LIST. - - This is a non-destructive operation: parts of LIST (but not - necessarily all of it) are copied as needed to avoid destructively - modifying it. - - See also: ‘-remove-at’ (*note -remove-at::), ‘-remove’ (*note - -remove::). - - (-remove-at-indices '(0) '(a b c d e)) - ⇒ (b c d e) - (-remove-at-indices '(1 3) '(a b c d e)) - ⇒ (a c e) - (-remove-at-indices '(4 0 2) '(a b c d e)) - ⇒ (b d) - - -File: dash.info, Node: Reductions, Next: Unfolding, Prev: List to list, Up: Functions - -2.4 Reductions -============== - -Functions reducing lists to a single value (which may also be a list). - - -- Function: -reduce-from (fn init list) - Reduce the function FN across LIST, starting with INIT. Return the - result of applying FN to INIT and the first element of LIST, then - applying FN to that result and the second element, etc. If LIST is - empty, return INIT without calling FN. - - This function’s anaphoric counterpart is ‘--reduce-from’. - - For other folds, see also ‘-reduce’ (*note -reduce::) and - ‘-reduce-r’ (*note -reduce-r::). - - (-reduce-from #'- 10 '(1 2 3)) - ⇒ 4 - (-reduce-from #'list 10 '(1 2 3)) - ⇒ (((10 1) 2) 3) - (--reduce-from (concat acc " " it) "START" '("a" "b" "c")) - ⇒ "START a b c" - - -- Function: -reduce-r-from (fn init list) - Reduce the function FN across LIST in reverse, starting with INIT. - Return the result of applying FN to the last element of LIST and - INIT, then applying FN to the second-to-last element and the - previous result of FN, etc. That is, the first argument of FN is - the current element, and its second argument the accumulated value. - If LIST is empty, return INIT without calling FN. - - This function is like ‘-reduce-from’ (*note -reduce-from::) but the - operation associates from the right rather than left. In other - words, it starts from the end of LIST and flips the arguments to - FN. Conceptually, it is like replacing the conses in LIST with - applications of FN, and its last link with INIT, and evaluating the - resulting expression. - - This function’s anaphoric counterpart is ‘--reduce-r-from’. - - For other folds, see also ‘-reduce-r’ (*note -reduce-r::) and - ‘-reduce’ (*note -reduce::). - - (-reduce-r-from #'- 10 '(1 2 3)) - ⇒ -8 - (-reduce-r-from #'list 10 '(1 2 3)) - ⇒ (1 (2 (3 10))) - (--reduce-r-from (concat it " " acc) "END" '("a" "b" "c")) - ⇒ "a b c END" - - -- Function: -reduce (fn list) - Reduce the function FN across LIST. Return the result of applying - FN to the first two elements of LIST, then applying FN to that - result and the third element, etc. If LIST contains a single - element, return it without calling FN. If LIST is empty, return - the result of calling FN with no arguments. - - This function’s anaphoric counterpart is ‘--reduce’. - - For other folds, see also ‘-reduce-from’ (*note -reduce-from::) and - ‘-reduce-r’ (*note -reduce-r::). - - (-reduce #'- '(1 2 3 4)) - ⇒ -8 - (-reduce #'list '(1 2 3 4)) - ⇒ (((1 2) 3) 4) - (--reduce (format "%s-%d" acc it) '(1 2 3)) - ⇒ "1-2-3" - - -- Function: -reduce-r (fn list) - Reduce the function FN across LIST in reverse. Return the result - of applying FN to the last two elements of LIST, then applying FN - to the third-to-last element and the previous result of FN, etc. - That is, the first argument of FN is the current element, and its - second argument the accumulated value. If LIST contains a single - element, return it without calling FN. If LIST is empty, return - the result of calling FN with no arguments. - - This function is like ‘-reduce’ (*note -reduce::) but the operation - associates from the right rather than left. In other words, it - starts from the end of LIST and flips the arguments to FN. - Conceptually, it is like replacing the conses in LIST with - applications of FN, ignoring its last link, and evaluating the - resulting expression. - - This function’s anaphoric counterpart is ‘--reduce-r’. - - For other folds, see also ‘-reduce-r-from’ (*note -reduce-r-from::) - and ‘-reduce’ (*note -reduce::). - - (-reduce-r #'- '(1 2 3 4)) - ⇒ -2 - (-reduce-r #'list '(1 2 3 4)) - ⇒ (1 (2 (3 4))) - (--reduce-r (format "%s-%d" acc it) '(1 2 3)) - ⇒ "3-2-1" - - -- Function: -reductions-from (fn init list) - Return a list of FN’s intermediate reductions across LIST. That - is, a list of the intermediate values of the accumulator when - ‘-reduce-from’ (*note -reduce-from::) (which see) is called with - the same arguments. - - This function’s anaphoric counterpart is ‘--reductions-from’. - - For other folds, see also ‘-reductions’ (*note -reductions::) and - ‘-reductions-r’ (*note -reductions-r::). - - (-reductions-from #'max 0 '(2 1 4 3)) - ⇒ (0 2 2 4 4) - (-reductions-from #'* 1 '(1 2 3 4)) - ⇒ (1 1 2 6 24) - (--reductions-from (format "(FN %s %d)" acc it) "INIT" '(1 2 3)) - ⇒ ("INIT" "(FN INIT 1)" "(FN (FN INIT 1) 2)" "(FN (FN (FN INIT 1) 2) 3)") - - -- Function: -reductions-r-from (fn init list) - Return a list of FN’s intermediate reductions across reversed LIST. - That is, a list of the intermediate values of the accumulator when - ‘-reduce-r-from’ (*note -reduce-r-from::) (which see) is called - with the same arguments. - - This function’s anaphoric counterpart is ‘--reductions-r-from’. - - For other folds, see also ‘-reductions’ (*note -reductions::) and - ‘-reductions-r’ (*note -reductions-r::). - - (-reductions-r-from #'max 0 '(2 1 4 3)) - ⇒ (4 4 4 3 0) - (-reductions-r-from #'* 1 '(1 2 3 4)) - ⇒ (24 24 12 4 1) - (--reductions-r-from (format "(FN %d %s)" it acc) "INIT" '(1 2 3)) - ⇒ ("(FN 1 (FN 2 (FN 3 INIT)))" "(FN 2 (FN 3 INIT))" "(FN 3 INIT)" "INIT") - - -- Function: -reductions (fn list) - Return a list of FN’s intermediate reductions across LIST. That - is, a list of the intermediate values of the accumulator when - ‘-reduce’ (*note -reduce::) (which see) is called with the same - arguments. - - This function’s anaphoric counterpart is ‘--reductions’. - - For other folds, see also ‘-reductions’ (*note -reductions::) and - ‘-reductions-r’ (*note -reductions-r::). - - (-reductions #'+ '(1 2 3 4)) - ⇒ (1 3 6 10) - (-reductions #'* '(1 2 3 4)) - ⇒ (1 2 6 24) - (--reductions (format "(FN %s %d)" acc it) '(1 2 3)) - ⇒ (1 "(FN 1 2)" "(FN (FN 1 2) 3)") - - -- Function: -reductions-r (fn list) - Return a list of FN’s intermediate reductions across reversed LIST. - That is, a list of the intermediate values of the accumulator when - ‘-reduce-r’ (*note -reduce-r::) (which see) is called with the same - arguments. - - This function’s anaphoric counterpart is ‘--reductions-r’. - - For other folds, see also ‘-reductions-r-from’ (*note - -reductions-r-from::) and ‘-reductions’ (*note -reductions::). - - (-reductions-r #'+ '(1 2 3 4)) - ⇒ (10 9 7 4) - (-reductions-r #'* '(1 2 3 4)) - ⇒ (24 24 12 4) - (--reductions-r (format "(FN %d %s)" it acc) '(1 2 3)) - ⇒ ("(FN 1 (FN 2 3))" "(FN 2 3)" 3) - - -- Function: -count (pred list) - Counts the number of items in LIST where (PRED item) is non-‘nil’. - - (-count 'even? '(1 2 3 4 5)) - ⇒ 2 - (--count (< it 4) '(1 2 3 4)) - ⇒ 3 - - -- Function: -sum (list) - Return the sum of LIST. - - (-sum ()) - ⇒ 0 - (-sum '(1)) - ⇒ 1 - (-sum '(1 2 3 4)) - ⇒ 10 - - -- Function: -running-sum (list) - Return a list with running sums of items in LIST. LIST must be - non-empty. - - (-running-sum '(1 2 3 4)) - ⇒ (1 3 6 10) - (-running-sum '(1)) - ⇒ (1) - (-running-sum ()) - error→ Wrong type argument: consp, nil - - -- Function: -product (list) - Return the product of LIST. - - (-product ()) - ⇒ 1 - (-product '(1)) - ⇒ 1 - (-product '(1 2 3 4)) - ⇒ 24 - - -- Function: -running-product (list) - Return a list with running products of items in LIST. LIST must be - non-empty. - - (-running-product '(1 2 3 4)) - ⇒ (1 2 6 24) - (-running-product '(1)) - ⇒ (1) - (-running-product ()) - error→ Wrong type argument: consp, nil - - -- Function: -inits (list) - Return all prefixes of LIST. - - (-inits '(1 2 3 4)) - ⇒ (nil (1) (1 2) (1 2 3) (1 2 3 4)) - (-inits nil) - ⇒ (nil) - (-inits '(1)) - ⇒ (nil (1)) - - -- Function: -tails (list) - Return all suffixes of LIST. - - (-tails '(1 2 3 4)) - ⇒ ((1 2 3 4) (2 3 4) (3 4) (4) nil) - (-tails nil) - ⇒ (nil) - (-tails '(1)) - ⇒ ((1) nil) - - -- Function: -common-prefix (&rest lists) - Return the longest common prefix of LISTS. - - (-common-prefix '(1)) - ⇒ (1) - (-common-prefix '(1 2) '(3 4) '(1 2)) - ⇒ () - (-common-prefix '(1 2) '(1 2 3) '(1 2 3 4)) - ⇒ (1 2) - - -- Function: -common-suffix (&rest lists) - Return the longest common suffix of LISTS. - - (-common-suffix '(1)) - ⇒ (1) - (-common-suffix '(1 2) '(3 4) '(1 2)) - ⇒ () - (-common-suffix '(1 2 3 4) '(2 3 4) '(3 4)) - ⇒ (3 4) - - -- Function: -min (list) - Return the smallest value from LIST of numbers or markers. - - (-min '(0)) - ⇒ 0 - (-min '(3 2 1)) - ⇒ 1 - (-min '(1 2 3)) - ⇒ 1 - - -- Function: -min-by (comparator list) - Take a comparison function COMPARATOR and a LIST and return the - least element of the list by the comparison function. - - See also combinator ‘-on’ (*note -on::) which can transform the - values before comparing them. - - (-min-by '> '(4 3 6 1)) - ⇒ 1 - (--min-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) - ⇒ (1 2 3) - (--min-by (> (length it) (length other)) '((1 2 3) (2) (3 2))) - ⇒ (2) - - -- Function: -max (list) - Return the largest value from LIST of numbers or markers. - - (-max '(0)) - ⇒ 0 - (-max '(3 2 1)) - ⇒ 3 - (-max '(1 2 3)) - ⇒ 3 - - -- Function: -max-by (comparator list) - Take a comparison function COMPARATOR and a LIST and return the - greatest element of the list by the comparison function. - - See also combinator ‘-on’ (*note -on::) which can transform the - values before comparing them. - - (-max-by '> '(4 3 6 1)) - ⇒ 6 - (--max-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) - ⇒ (3 2) - (--max-by (> (length it) (length other)) '((1 2 3) (2) (3 2))) - ⇒ (1 2 3) - - -- Function: -frequencies (list) - Count the occurrences of each distinct element of LIST. - - Return an alist of (ELEMENT . N), where each ELEMENT occurs N - times in LIST. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. - - See also ‘-count’ (*note -count::) and ‘-group-by’ (*note - -group-by::). - - (-frequencies ()) - ⇒ () - (-frequencies '(1 2 3 1 2 1)) - ⇒ ((1 . 3) (2 . 2) (3 . 1)) - (let ((-compare-fn #'string=)) (-frequencies '(a "a"))) - ⇒ ((a . 2)) - - -File: dash.info, Node: Unfolding, Next: Predicates, Prev: Reductions, Up: Functions - -2.5 Unfolding -============= - -Operations dual to reductions, building lists from a seed value rather -than consuming a list to produce a single value. - - -- Function: -iterate (fun init n) - Return a list of iterated applications of FUN to INIT. - - This means a list of the form: - - (INIT (FUN INIT) (FUN (FUN INIT)) ...) - - N is the length of the returned list. - - (-iterate #'1+ 1 10) - ⇒ (1 2 3 4 5 6 7 8 9 10) - (-iterate (lambda (x) (+ x x)) 2 5) - ⇒ (2 4 8 16 32) - (--iterate (* it it) 2 5) - ⇒ (2 4 16 256 65536) - - -- Function: -unfold (fun seed) - Build a list from SEED using FUN. - - This is "dual" operation to ‘-reduce-r’ (*note -reduce-r::): while - -reduce-r consumes a list to produce a single value, ‘-unfold’ - (*note -unfold::) takes a seed value and builds a (potentially - infinite!) list. - - FUN should return ‘nil’ to stop the generating process, or a cons - (A . B), where A will be prepended to the result and B is the new - seed. - - (-unfold (lambda (x) (unless (= x 0) (cons x (1- x)))) 10) - ⇒ (10 9 8 7 6 5 4 3 2 1) - (--unfold (when it (cons it (cdr it))) '(1 2 3 4)) - ⇒ ((1 2 3 4) (2 3 4) (3 4) (4)) - (--unfold (when it (cons it (butlast it))) '(1 2 3 4)) - ⇒ ((1 2 3 4) (1 2 3) (1 2) (1)) - - -- Function: -repeat (n x) - Return a new list of length N with each element being X. Return - ‘nil’ if N is less than 1. - - (-repeat 3 :a) - ⇒ (:a :a :a) - (-repeat 1 :a) - ⇒ (:a) - (-repeat 0 :a) - ⇒ () - - -- Function: -cycle (list) - Return an infinite circular copy of LIST. The returned list cycles - through the elements of LIST and repeats from the beginning. - - (-take 5 (-cycle '(1 2 3))) - ⇒ (1 2 3 1 2) - (-take 7 (-cycle '(1 "and" 3))) - ⇒ (1 "and" 3 1 "and" 3 1) - (-zip-lists (-cycle '(3)) '(1 2)) - ⇒ ((3 1) (3 2)) - - -File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Functions - -2.6 Predicates -============== - -Reductions of one or more lists to a boolean value. - - -- Function: -some (pred list) - Return (PRED x) for the first LIST item where (PRED x) is - non-‘nil’, else ‘nil’. - - Alias: ‘-any’. - - This function’s anaphoric counterpart is ‘--some’. - - (-some #'stringp '(1 "2" 3)) - ⇒ t - (--some (string-match-p "x" it) '("foo" "axe" "xor")) - ⇒ 1 - (--some (= it-index 3) '(0 1 2)) - ⇒ nil - - -- Function: -every (pred list) - Return non-‘nil’ if PRED returns non-‘nil’ for all items in LIST. - If so, return the last such result of PRED. Otherwise, once an - item is reached for which PRED returns ‘nil’, return ‘nil’ without - calling PRED on any further LIST elements. - - This function is like ‘-every-p’, but on success returns the last - non-‘nil’ result of PRED instead of just ‘t’. - - This function’s anaphoric counterpart is ‘--every’. - - (-every #'numberp '(1 2 3)) - ⇒ t - (--every (string-match-p "x" it) '("axe" "xor")) - ⇒ 0 - (--every (= it it-index) '(0 1 3)) - ⇒ nil - - -- Function: -any? (pred list) - Return ‘t’ if (PRED X) is non-‘nil’ for any X in LIST, else ‘nil’. - - Alias: ‘-any-p’, ‘-some?’, ‘-some-p’ - - (-any? #'numberp '(nil 0 t)) - ⇒ t - (-any? #'numberp '(nil t t)) - ⇒ nil - (-any? #'null '(1 3 5)) - ⇒ nil - - -- Function: -all? (pred list) - Return ‘t’ if (PRED X) is non-‘nil’ for all X in LIST, else ‘nil’. - In the latter case, stop after the first X for which (PRED X) is - ‘nil’, without calling PRED on any subsequent elements of LIST. - - The similar function ‘-every’ (*note -every::) is more widely - useful, since it returns the last non-‘nil’ result of PRED instead - of just ‘t’ on success. - - Alias: ‘-all-p’, ‘-every-p’, ‘-every?’. - - This function’s anaphoric counterpart is ‘--all?’. - - (-all? #'numberp '(1 2 3)) - ⇒ t - (-all? #'numberp '(2 t 6)) - ⇒ nil - (--all? (= 0 (% it 2)) '(2 4 6)) - ⇒ t - - -- Function: -none? (pred list) - Return ‘t’ if (PRED X) is ‘nil’ for all X in LIST, else ‘nil’. - - Alias: ‘-none-p’ - - (-none? 'even? '(1 2 3)) - ⇒ nil - (-none? 'even? '(1 3 5)) - ⇒ t - (--none? (= 0 (% it 2)) '(1 2 3)) - ⇒ nil - - -- Function: -only-some? (pred list) - Return ‘t’ if different LIST items both satisfy and do not satisfy - PRED. That is, if PRED returns both ‘nil’ for at least one item, - and non-‘nil’ for at least one other item in LIST. Return ‘nil’ if - all items satisfy the predicate or none of them do. - - Alias: ‘-only-some-p’ - - (-only-some? 'even? '(1 2 3)) - ⇒ t - (-only-some? 'even? '(1 3 5)) - ⇒ nil - (-only-some? 'even? '(2 4 6)) - ⇒ nil - - -- Function: -contains? (list element) - Return non-‘nil’ if LIST contains ELEMENT. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. As with ‘member’, the return value is - actually the tail of LIST whose car is ELEMENT. - - Alias: ‘-contains-p’. - - (-contains? '(1 2 3) 1) - ⇒ (1 2 3) - (-contains? '(1 2 3) 2) - ⇒ (2 3) - (-contains? '(1 2 3) 4) - ⇒ () - - -- Function: -is-prefix? (prefix list) - Return non-‘nil’ if PREFIX is a prefix of LIST. - - Alias: ‘-is-prefix-p’. - - (-is-prefix? '(1 2 3) '(1 2 3 4 5)) - ⇒ t - (-is-prefix? '(1 2 3 4 5) '(1 2 3)) - ⇒ nil - (-is-prefix? '(1 3) '(1 2 3 4 5)) - ⇒ nil - - -- Function: -is-suffix? (suffix list) - Return non-‘nil’ if SUFFIX is a suffix of LIST. - - Alias: ‘-is-suffix-p’. - - (-is-suffix? '(3 4 5) '(1 2 3 4 5)) - ⇒ t - (-is-suffix? '(1 2 3 4 5) '(3 4 5)) - ⇒ nil - (-is-suffix? '(3 5) '(1 2 3 4 5)) - ⇒ nil - - -- Function: -is-infix? (infix list) - Return non-‘nil’ if INFIX is infix of LIST. - - This operation runs in O(n^2) time - - Alias: ‘-is-infix-p’ - - (-is-infix? '(1 2 3) '(1 2 3 4 5)) - ⇒ t - (-is-infix? '(2 3 4) '(1 2 3 4 5)) - ⇒ t - (-is-infix? '(3 4 5) '(1 2 3 4 5)) - ⇒ t - - -- Function: -cons-pair? (obj) - Return non-‘nil’ if OBJ is a true cons pair. That is, a cons (A . - B) where B is not a list. - - Alias: ‘-cons-pair-p’. - - (-cons-pair? '(1 . 2)) - ⇒ t - (-cons-pair? '(1 2)) - ⇒ nil - (-cons-pair? '(1)) - ⇒ nil - - -File: dash.info, Node: Partitioning, Next: Indexing, Prev: Predicates, Up: Functions - -2.7 Partitioning -================ - -Functions partitioning the input list into a list of lists. - - -- Function: -split-at (n list) - Split LIST into two sublists after the Nth element. The result is - a list of two elements (TAKE DROP) where TAKE is a new list of the - first N elements of LIST, and DROP is the remaining elements of - LIST (not a copy). TAKE and DROP are like the results of ‘-take’ - (*note -take::) and ‘-drop’ (*note -drop::), respectively, but the - split is done in a single list traversal. - - (-split-at 3 '(1 2 3 4 5)) - ⇒ ((1 2 3) (4 5)) - (-split-at 17 '(1 2 3 4 5)) - ⇒ ((1 2 3 4 5) nil) - (-split-at 0 '(1 2 3 4 5)) - ⇒ (nil (1 2 3 4 5)) - - -- Function: -split-with (pred list) - Split LIST into a prefix satisfying PRED, and the rest. The first - sublist is the prefix of LIST with successive elements satisfying - PRED, and the second sublist is the remaining elements that do not. - The result is like performing - - ((-take-while PRED LIST) (-drop-while PRED LIST)) - - but in no more than a single pass through LIST. - - (-split-with 'even? '(1 2 3 4)) - ⇒ (nil (1 2 3 4)) - (-split-with 'even? '(2 4 5 6)) - ⇒ ((2 4) (5 6)) - (--split-with (< it 4) '(1 2 3 4 3 2 1)) - ⇒ ((1 2 3) (4 3 2 1)) - - -- Macro: -split-on (item list) - Split the LIST each time ITEM is found. - - Unlike ‘-partition-by’ (*note -partition-by::), the ITEM is - discarded from the results. Empty lists are also removed from the - result. - - Comparison is done by ‘equal’. - - See also ‘-split-when’ (*note -split-when::) - - (-split-on '| '(Nil | Leaf a | Node [Tree a])) - ⇒ ((Nil) (Leaf a) (Node [Tree a])) - (-split-on :endgroup '("a" "b" :endgroup "c" :endgroup "d" "e")) - ⇒ (("a" "b") ("c") ("d" "e")) - (-split-on :endgroup '("a" "b" :endgroup :endgroup "d" "e")) - ⇒ (("a" "b") ("d" "e")) - - -- Function: -split-when (fn list) - Split the LIST on each element where FN returns non-‘nil’. - - Unlike ‘-partition-by’ (*note -partition-by::), the "matched" - element is discarded from the results. Empty lists are also - removed from the result. - - This function can be thought of as a generalization of - ‘split-string’. - - (-split-when 'even? '(1 2 3 4 5 6)) - ⇒ ((1) (3) (5)) - (-split-when 'even? '(1 2 3 4 6 8 9)) - ⇒ ((1) (3) (9)) - (--split-when (memq it '(&optional &rest)) '(a b &optional c d &rest args)) - ⇒ ((a b) (c d) (args)) - - -- Function: -separate (pred list) - Split LIST into two sublists based on whether items satisfy PRED. - The result is like performing - - ((-filter PRED LIST) (-remove PRED LIST)) - - but in a single pass through LIST. - - (-separate (lambda (num) (= 0 (% num 2))) '(1 2 3 4 5 6 7)) - ⇒ ((2 4 6) (1 3 5 7)) - (--separate (< it 5) '(3 7 5 9 3 2 1 4 6)) - ⇒ ((3 3 2 1 4) (7 5 9 6)) - (-separate 'cdr '((1 2) (1) (1 2 3) (4))) - ⇒ (((1 2) (1 2 3)) ((1) (4))) - - -- Function: -partition (n list) - Return a new list with the items in LIST grouped into N-sized - sublists. If there are not enough items to make the last group - N-sized, those items are discarded. - - (-partition 2 '(1 2 3 4 5 6)) - ⇒ ((1 2) (3 4) (5 6)) - (-partition 2 '(1 2 3 4 5 6 7)) - ⇒ ((1 2) (3 4) (5 6)) - (-partition 3 '(1 2 3 4 5 6 7)) - ⇒ ((1 2 3) (4 5 6)) - - -- Function: -partition-all (n list) - Return a new list with the items in LIST grouped into N-sized - sublists. The last group may contain less than N items. - - (-partition-all 2 '(1 2 3 4 5 6)) - ⇒ ((1 2) (3 4) (5 6)) - (-partition-all 2 '(1 2 3 4 5 6 7)) - ⇒ ((1 2) (3 4) (5 6) (7)) - (-partition-all 3 '(1 2 3 4 5 6 7)) - ⇒ ((1 2 3) (4 5 6) (7)) - - -- Function: -partition-in-steps (n step list) - Partition LIST into sublists of length N that are STEP items apart. - Like ‘-partition-all-in-steps’ (*note -partition-all-in-steps::), - but if there are not enough items to make the last group N-sized, - those items are discarded. - - (-partition-in-steps 2 1 '(1 2 3 4)) - ⇒ ((1 2) (2 3) (3 4)) - (-partition-in-steps 3 2 '(1 2 3 4)) - ⇒ ((1 2 3)) - (-partition-in-steps 3 2 '(1 2 3 4 5)) - ⇒ ((1 2 3) (3 4 5)) - - -- Function: -partition-all-in-steps (n step list) - Partition LIST into sublists of length N that are STEP items apart. - Adjacent groups may overlap if N exceeds the STEP stride. Trailing - groups may contain less than N items. - - (-partition-all-in-steps 2 1 '(1 2 3 4)) - ⇒ ((1 2) (2 3) (3 4) (4)) - (-partition-all-in-steps 3 2 '(1 2 3 4)) - ⇒ ((1 2 3) (3 4)) - (-partition-all-in-steps 3 2 '(1 2 3 4 5)) - ⇒ ((1 2 3) (3 4 5) (5)) - - -- Function: -partition-by (fn list) - Apply FN to each item in LIST, splitting it each time FN returns a - new value. - - (-partition-by 'even? ()) - ⇒ () - (-partition-by 'even? '(1 1 2 2 2 3 4 6 8)) - ⇒ ((1 1) (2 2 2) (3) (4 6 8)) - (--partition-by (< it 3) '(1 2 3 4 3 2 1)) - ⇒ ((1 2) (3 4 3) (2 1)) - - -- Function: -partition-by-header (fn list) - Apply FN to the first item in LIST. That is the header value. - Apply FN to each item in LIST, splitting it each time FN returns - the header value, but only after seeing at least one other value - (the body). - - (--partition-by-header (= it 1) '(1 2 3 1 2 1 2 3 4)) - ⇒ ((1 2 3) (1 2) (1 2 3 4)) - (--partition-by-header (> it 0) '(1 2 0 1 0 1 2 3 0)) - ⇒ ((1 2 0) (1 0) (1 2 3 0)) - (-partition-by-header 'even? '(2 1 1 1 4 1 3 5 6 6 1)) - ⇒ ((2 1 1 1) (4 1 3 5) (6 6 1)) - - -- Function: -partition-after-pred (pred list) - Partition LIST after each element for which PRED returns non-‘nil’. - - This function’s anaphoric counterpart is ‘--partition-after-pred’. - - (-partition-after-pred #'booleanp ()) - ⇒ () - (-partition-after-pred #'booleanp '(t t)) - ⇒ ((t) (t)) - (-partition-after-pred #'booleanp '(0 0 t t 0 t)) - ⇒ ((0 0 t) (t) (0 t)) - - -- Function: -partition-before-pred (pred list) - Partition directly before each time PRED is true on an element of - LIST. - - (-partition-before-pred #'booleanp ()) - ⇒ () - (-partition-before-pred #'booleanp '(0 t)) - ⇒ ((0) (t)) - (-partition-before-pred #'booleanp '(0 0 t 0 t t)) - ⇒ ((0 0) (t 0) (t) (t)) - - -- Function: -partition-before-item (item list) - Partition directly before each time ITEM appears in LIST. - - (-partition-before-item 3 ()) - ⇒ () - (-partition-before-item 3 '(1)) - ⇒ ((1)) - (-partition-before-item 3 '(3)) - ⇒ ((3)) - - -- Function: -partition-after-item (item list) - Partition directly after each time ITEM appears in LIST. - - (-partition-after-item 3 ()) - ⇒ () - (-partition-after-item 3 '(1)) - ⇒ ((1)) - (-partition-after-item 3 '(3)) - ⇒ ((3)) - - -- Function: -group-by (fn list) - Separate LIST into an alist whose keys are FN applied to the - elements of LIST. Keys are compared by ‘equal’. - - (-group-by 'even? ()) - ⇒ () - (-group-by 'even? '(1 1 2 2 2 3 4 6 8)) - ⇒ ((nil 1 1 3) (t 2 2 2 4 6 8)) - (--group-by (car (split-string it "/")) '("a/b" "c/d" "a/e")) - ⇒ (("a" "a/b" "a/e") ("c" "c/d")) - - -File: dash.info, Node: Indexing, Next: Set operations, Prev: Partitioning, Up: Functions - -2.8 Indexing -============ - -Functions retrieving or sorting based on list indices and related -predicates. - - -- Function: -elem-index (elem list) - Return the first index of ELEM in LIST. That is, the index within - LIST of the first element that is ‘equal’ to ELEM. Return ‘nil’ if - there is no such element. - - See also: ‘-find-index’ (*note -find-index::). - - (-elem-index 2 '(6 7 8 3 4)) - ⇒ nil - (-elem-index "bar" '("foo" "bar" "baz")) - ⇒ 1 - (-elem-index '(1 2) '((3) (5 6) (1 2) nil)) - ⇒ 2 - - -- Function: -elem-indices (elem list) - Return the list of indices at which ELEM appears in LIST. That is, - the indices of all elements of LIST ‘equal’ to ELEM, in the same - ascending order as they appear in LIST. - - (-elem-indices 2 '(6 7 8 3 4 1)) - ⇒ () - (-elem-indices "bar" '("foo" "bar" "baz")) - ⇒ (1) - (-elem-indices '(1 2) '((3) (1 2) (5 6) (1 2) nil)) - ⇒ (1 3) - - -- Function: -find-index (pred list) - Return the index of the first item satisfying PRED in LIST. Return - ‘nil’ if no such item is found. - - PRED is called with one argument, the current list element, until - it returns non-‘nil’, at which point the search terminates. - - This function’s anaphoric counterpart is ‘--find-index’. - - See also: ‘-first’ (*note -first::), ‘-find-last-index’ (*note - -find-last-index::). - - (-find-index #'numberp '(a b c)) - ⇒ nil - (-find-index #'natnump '(1 0 -1)) - ⇒ 0 - (--find-index (> it 5) '(2 4 1 6 3 3 5 8)) - ⇒ 3 - - -- Function: -find-last-index (pred list) - Return the index of the last item satisfying PRED in LIST. Return - ‘nil’ if no such item is found. - - Predicate PRED is called with one argument each time, namely the - current list element. - - This function’s anaphoric counterpart is ‘--find-last-index’. - - See also: ‘-last’ (*note -last::), ‘-find-index’ (*note - -find-index::). - - (-find-last-index #'numberp '(a b c)) - ⇒ nil - (--find-last-index (> it 5) '(2 7 1 6 3 8 5 2)) - ⇒ 5 - (-find-last-index (-partial #'string< 'a) '(c b a)) - ⇒ 1 - - -- Function: -find-indices (pred list) - Return the list of indices in LIST satisfying PRED. - - Each element of LIST in turn is passed to PRED. If the result is - non-‘nil’, the index of that element in LIST is included in the - result. The returned indices are in ascending order, i.e., in the - same order as they appear in LIST. - - This function’s anaphoric counterpart is ‘--find-indices’. - - See also: ‘-find-index’ (*note -find-index::), ‘-elem-indices’ - (*note -elem-indices::). - - (-find-indices #'numberp '(a b c)) - ⇒ () - (-find-indices #'numberp '(8 1 d 2 b c a 3)) - ⇒ (0 1 3 7) - (--find-indices (> it 5) '(2 4 1 6 3 3 5 8)) - ⇒ (3 7) - - -- Function: -grade-up (comparator list) - Grade elements of LIST using COMPARATOR relation. This yields a - permutation vector such that applying this permutation to LIST - sorts it in ascending order. - - (-grade-up #'< '(3 1 4 2 1 3 3)) - ⇒ (1 4 3 0 5 6 2) - (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices (-grade-up #'< l) l)) - ⇒ (1 1 2 3 3 3 4) - - -- Function: -grade-down (comparator list) - Grade elements of LIST using COMPARATOR relation. This yields a - permutation vector such that applying this permutation to LIST - sorts it in descending order. - - (-grade-down #'< '(3 1 4 2 1 3 3)) - ⇒ (2 0 5 6 3 1 4) - (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices (-grade-down #'< l) l)) - ⇒ (4 3 3 3 2 1 1) - - -File: dash.info, Node: Set operations, Next: Other list operations, Prev: Indexing, Up: Functions - -2.9 Set operations -================== - -Operations pretending lists are sets. - - -- Function: -union (list1 list2) - Return a new list of distinct elements appearing in either LIST1 or - LIST2. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. - - (-union '(1 2 3) '(3 4 5)) - ⇒ (1 2 3 4 5) - (-union '(1 2 2 4) ()) - ⇒ (1 2 4) - (-union '(1 1 2 2) '(4 4 3 2 1)) - ⇒ (1 2 4 3) - - -- Function: -difference (list1 list2) - Return a new list with the distinct members of LIST1 that are not - in LIST2. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. - - (-difference () ()) - ⇒ () - (-difference '(1 2 3) '(4 5 6)) - ⇒ (1 2 3) - (-difference '(1 2 3 4) '(3 4 5 6)) - ⇒ (1 2) - - -- Function: -intersection (list1 list2) - Return a new list of distinct elements appearing in both LIST1 and - LIST2. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. - - (-intersection () ()) - ⇒ () - (-intersection '(1 2 3) '(4 5 6)) - ⇒ () - (-intersection '(1 2 2 3) '(4 3 3 2)) - ⇒ (2 3) - - -- Function: -powerset (list) - Return the power set of LIST. - - (-powerset ()) - ⇒ (nil) - (-powerset '(x y)) - ⇒ ((x y) (x) (y) nil) - (-powerset '(x y z)) - ⇒ ((x y z) (x y) (x z) (x) (y z) (y) (z) nil) - - -- Function: -permutations (list) - Return the distinct permutations of LIST. - - Duplicate elements of LIST are determined by ‘equal’, or by - ‘-compare-fn’ if that is non-‘nil’. - - (-permutations ()) - ⇒ (nil) - (-permutations '(a a b)) - ⇒ ((a a b) (a b a) (b a a)) - (-permutations '(a b c)) - ⇒ ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a)) - - -- Function: -distinct (list) - Return a copy of LIST with all duplicate elements removed. - - The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that is non-‘nil’. - - Alias: ‘-uniq’. - - (-distinct ()) - ⇒ () - (-distinct '(1 1 2 3 3)) - ⇒ (1 2 3) - (-distinct '(t t t)) - ⇒ (t) - - -- Function: -same-items? (list1 list2) - Return non-‘nil’ if LIST1 and LIST2 have the same distinct - elements. - - The order of the elements in the lists does not matter. The lists - may be of different lengths, i.e., contain duplicate elements. The - test for equality is done with ‘equal’, or with ‘-compare-fn’ if - that is non-‘nil’. - - Alias: ‘-same-items-p’. - - (-same-items? '(1 2 3) '(1 2 3)) - ⇒ t - (-same-items? '(1 1 2 3) '(3 3 2 1)) - ⇒ t - (-same-items? '(1 2 3) '(1 2 3 4)) - ⇒ nil - - -File: dash.info, Node: Other list operations, Next: Tree operations, Prev: Set operations, Up: Functions - -2.10 Other list operations -========================== - -Other list functions not fit to be classified elsewhere. - - -- Function: -rotate (n list) - Rotate LIST N places to the right (left if N is negative). The - time complexity is O(n). - - (-rotate 3 '(1 2 3 4 5 6 7)) - ⇒ (5 6 7 1 2 3 4) - (-rotate -3 '(1 2 3 4 5 6 7)) - ⇒ (4 5 6 7 1 2 3) - (-rotate 16 '(1 2 3 4 5 6 7)) - ⇒ (6 7 1 2 3 4 5) - - -- Function: -cons* (&rest args) - Make a new list from the elements of ARGS. The last 2 elements of - ARGS are used as the final cons of the result, so if the final - element of ARGS is not a list, the result is a dotted list. With - no ARGS, return ‘nil’. - - (-cons* 1 2) - ⇒ (1 . 2) - (-cons* 1 2 3) - ⇒ (1 2 . 3) - (-cons* 1) - ⇒ 1 - - -- Function: -snoc (list elem &rest elements) - Append ELEM to the end of the list. - - This is like ‘cons’, but operates on the end of list. - - If any ELEMENTS are given, append them to the list as well. - - (-snoc '(1 2 3) 4) - ⇒ (1 2 3 4) - (-snoc '(1 2 3) 4 5 6) - ⇒ (1 2 3 4 5 6) - (-snoc '(1 2 3) '(4 5 6)) - ⇒ (1 2 3 (4 5 6)) - - -- Function: -interpose (sep list) - Return a new list of all elements in LIST separated by SEP. - - (-interpose "-" ()) - ⇒ () - (-interpose "-" '("a")) - ⇒ ("a") - (-interpose "-" '("a" "b" "c")) - ⇒ ("a" "-" "b" "-" "c") - - -- Function: -interleave (&rest lists) - Return a new list of the first item in each list, then the second - etc. - - (-interleave '(1 2) '("a" "b")) - ⇒ (1 "a" 2 "b") - (-interleave '(1 2) '("a" "b") '("A" "B")) - ⇒ (1 "a" "A" 2 "b" "B") - (-interleave '(1 2 3) '("a" "b")) - ⇒ (1 "a" 2 "b") - - -- Function: -iota (count &optional start step) - Return a list containing COUNT numbers. Starts from START and adds - STEP each time. The default START is zero, the default STEP is 1. - This function takes its name from the corresponding primitive in - the APL language. - - (-iota 6) - ⇒ (0 1 2 3 4 5) - (-iota 4 2.5 -2) - ⇒ (2.5 0.5 -1.5 -3.5) - (-iota -1) - error→ Wrong type argument: natnump, -1 - - -- Function: -zip-with (fn list1 list2) - Zip LIST1 and LIST2 into a new list using the function FN. That - is, apply FN pairwise taking as first argument the next element of - LIST1 and as second argument the next element of LIST2 at the - corresponding position. The result is as long as the shorter list. - - This function’s anaphoric counterpart is ‘--zip-with’. - - For other zips, see also ‘-zip-lists’ (*note -zip-lists::) and - ‘-zip-fill’ (*note -zip-fill::). - - (-zip-with #'+ '(1 2 3 4) '(5 6 7)) - ⇒ (6 8 10) - (-zip-with #'cons '(1 2 3) '(4 5 6 7)) - ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (--zip-with (format "%s & %s" it other) '(Batman Jekyll) '(Robin Hyde)) - ⇒ ("Batman & Robin" "Jekyll & Hyde") - - -- Function: -zip-pair (list1 list2) - Zip LIST1 and LIST2 together. - - Make a pair with the head of each list, followed by a pair with the - second element of each list, and so on. The number of pairs - returned is equal to the length of the shorter input list. - - See also: ‘-zip-lists’ (*note -zip-lists::). - - (-zip-pair '(1 2 3 4) '(5 6 7)) - ⇒ ((1 . 5) (2 . 6) (3 . 7)) - (-zip-pair '(1 2 3) '(4 5 6)) - ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (-zip-pair '(1 2) '(3)) - ⇒ ((1 . 3)) - - -- Function: -zip-lists (&rest lists) - Zip LISTS together. - - Group the head of each list, followed by the second element of each - list, and so on. The number of returned groupings is equal to the - length of the shortest input list, and the length of each grouping - is equal to the number of input LISTS. - - The return value is always a list of proper lists, in contrast to - ‘-zip’ (*note -zip::) which returns a list of dotted pairs when - only two input LISTS are provided. - - See also: ‘-zip-pair’ (*note -zip-pair::). - - (-zip-lists '(1 2 3) '(4 5 6)) - ⇒ ((1 4) (2 5) (3 6)) - (-zip-lists '(1 2 3) '(4 5 6 7)) - ⇒ ((1 4) (2 5) (3 6)) - (-zip-lists '(1 2) '(3 4 5) '(6)) - ⇒ ((1 3 6)) - - -- Function: -zip-lists-fill (fill-value &rest lists) - Zip LISTS together, padding shorter lists with FILL-VALUE. This is - like ‘-zip-lists’ (*note -zip-lists::) (which see), except it - retains all elements at positions beyond the end of the shortest - list. The number of returned groupings is equal to the length of - the longest input list, and the length of each grouping is equal to - the number of input LISTS. - - (-zip-lists-fill 0 '(1 2) '(3 4 5) '(6)) - ⇒ ((1 3 6) (2 4 0) (0 5 0)) - (-zip-lists-fill 0 '(1 2) '(3 4) '(5 6)) - ⇒ ((1 3 5) (2 4 6)) - (-zip-lists-fill 0 '(1 2 3) nil) - ⇒ ((1 0) (2 0) (3 0)) - - -- Function: -zip (&rest lists) - Zip LISTS together. - - Group the head of each list, followed by the second element of each - list, and so on. The number of returned groupings is equal to the - length of the shortest input list, and the number of items in each - grouping is equal to the number of input LISTS. - - If only two LISTS are provided as arguments, return the groupings - as a list of dotted pairs. Otherwise, return the groupings as a - list of proper lists. - - Since the return value changes form depending on the number of - arguments, it is generally recommended to use ‘-zip-lists’ (*note - -zip-lists::) instead, or ‘-zip-pair’ (*note -zip-pair::) if a list - of dotted pairs is desired. - - See also: ‘-unzip’ (*note -unzip::). - - (-zip '(1 2 3 4) '(5 6 7) '(8 9)) - ⇒ ((1 5 8) (2 6 9)) - (-zip '(1 2 3) '(4 5 6) '(7 8 9)) - ⇒ ((1 4 7) (2 5 8) (3 6 9)) - (-zip '(1 2 3)) - ⇒ ((1) (2) (3)) - - -- Function: -zip-fill (fill-value &rest lists) - Zip LISTS together, padding shorter lists with FILL-VALUE. This is - like ‘-zip’ (*note -zip::) (which see), except it retains all - elements at positions beyond the end of the shortest list. The - number of returned groupings is equal to the length of the longest - input list, and the length of each grouping is equal to the number - of input LISTS. - - Since the return value changes form depending on the number of - arguments, it is generally recommended to use ‘-zip-lists-fill’ - (*note -zip-lists-fill::) instead, unless a list of dotted pairs is - explicitly desired. - - (-zip-fill 0 '(1 2 3) '(4 5)) - ⇒ ((1 . 4) (2 . 5) (3 . 0)) - (-zip-fill 0 () '(1 2 3)) - ⇒ ((0 . 1) (0 . 2) (0 . 3)) - (-zip-fill 0 '(1 2) '(3 4) '(5 6)) - ⇒ ((1 3 5) (2 4 6)) - - -- Function: -unzip-lists (lists) - Unzip LISTS. - - This works just like ‘-zip-lists’ (*note -zip-lists::) (which see), - but takes a list of lists instead of a variable number of - arguments, such that - - (-unzip-lists (-zip-lists ARGS...)) - - is identity (given that the lists comprising ARGS are of the same - length). - - (-unzip-lists (-zip-lists '(1 2) '(3 4) '(5 6))) - ⇒ ((1 2) (3 4) (5 6)) - (-unzip-lists '((1 2 3) (4 5) (6 7) (8 9))) - ⇒ ((1 4 6 8) (2 5 7 9)) - (-unzip-lists '((1 2 3) (4 5 6))) - ⇒ ((1 4) (2 5) (3 6)) - - -- Function: -unzip (lists) - Unzip LISTS. - - This works just like ‘-zip’ (*note -zip::) (which see), but takes a - list of lists instead of a variable number of arguments, such that - - (-unzip (-zip L1 L2 L3 ...)) - - is identity (given that the lists are of the same length, and that - ‘-zip’ (*note -zip::) is not called with two arguments, because of - the caveat described in its docstring). - - Note in particular that calling ‘-unzip’ (*note -unzip::) on a list - of two lists will return a list of dotted pairs. - - Since the return value changes form depending on the number of - LISTS, it is generally recommended to use ‘-unzip-lists’ (*note - -unzip-lists::) instead. - - (-unzip (-zip '(1 2) '(3 4) '(5 6))) - ⇒ ((1 . 2) (3 . 4) (5 . 6)) - (-unzip '((1 2 3) (4 5 6))) - ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (-unzip '((1 2 3) (4 5) (6 7) (8 9))) - ⇒ ((1 4 6 8) (2 5 7 9)) - - -- Function: -pad (fill-value &rest lists) - Pad each of LISTS with FILL-VALUE until they all have equal - lengths. - - Ensure all LISTS are as long as the longest one by repeatedly - appending FILL-VALUE to the shorter lists, and return the resulting - LISTS. - - (-pad 0 ()) - ⇒ (nil) - (-pad 0 '(1 2) '(3 4)) - ⇒ ((1 2) (3 4)) - (-pad 0 '(1 2) '(3 4 5 6) '(7 8 9)) - ⇒ ((1 2 0 0) (3 4 5 6) (7 8 9 0)) - - -- Function: -table (fn &rest lists) - Compute outer product of LISTS using function FN. - - The function FN should have the same arity as the number of - supplied lists. - - The outer product is computed by applying fn to all possible - combinations created by taking one element from each list in order. - The dimension of the result is (length lists). - - See also: ‘-table-flat’ (*note -table-flat::) - - (-table '* '(1 2 3) '(1 2 3)) - ⇒ ((1 2 3) (2 4 6) (3 6 9)) - (-table (lambda (a b) (-sum (-zip-with '* a b))) '((1 2) (3 4)) '((1 3) (2 4))) - ⇒ ((7 15) (10 22)) - (apply '-table 'list (-repeat 3 '(1 2))) - ⇒ ((((1 1 1) (2 1 1)) ((1 2 1) (2 2 1))) (((1 1 2) (2 1 2)) ((1 2 2) (2 2 2)))) - - -- Function: -table-flat (fn &rest lists) - Compute flat outer product of LISTS using function FN. - - The function FN should have the same arity as the number of - supplied lists. - - The outer product is computed by applying fn to all possible - combinations created by taking one element from each list in order. - The results are flattened, ignoring the tensor structure of the - result. This is equivalent to calling: - - (-flatten-n (1- (length lists)) (apply ’-table fn lists)) - - but the implementation here is much more efficient. - - See also: ‘-flatten-n’ (*note -flatten-n::), ‘-table’ (*note - -table::) - - (-table-flat 'list '(1 2 3) '(a b c)) - ⇒ ((1 a) (2 a) (3 a) (1 b) (2 b) (3 b) (1 c) (2 c) (3 c)) - (-table-flat '* '(1 2 3) '(1 2 3)) - ⇒ (1 2 3 2 4 6 3 6 9) - (apply '-table-flat 'list (-repeat 3 '(1 2))) - ⇒ ((1 1 1) (2 1 1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2)) - - -- Function: -first (pred list) - Return the first item in LIST for which PRED returns non-‘nil’. - Return ‘nil’ if no such element is found. - - To get the first item in the list no questions asked, use - ‘-first-item’ (*note -first-item::). - - Alias: ‘-find’. - - This function’s anaphoric counterpart is ‘--first’. - - (-first #'natnump '(-1 0 1)) - ⇒ 0 - (-first #'null '(1 2 3)) - ⇒ nil - (--first (> it 2) '(1 2 3)) - ⇒ 3 - - -- Function: -last (pred list) - Return the last x in LIST where (PRED x) is non-‘nil’, else ‘nil’. - - (-last 'even? '(1 2 3 4 5 6 3 3 3)) - ⇒ 6 - (-last 'even? '(1 3 7 5 9)) - ⇒ nil - (--last (> (length it) 3) '("a" "looong" "word" "and" "short" "one")) - ⇒ "short" - - -- Function: -first-item (list) - Return the first item of LIST, or ‘nil’ on an empty list. - - See also: ‘-second-item’ (*note -second-item::), ‘-last-item’ - (*note -last-item::), etc. - - (-first-item ()) - ⇒ () - (-first-item '(1 2 3 4 5)) - ⇒ 1 - (let ((list (list 1 2 3))) (setf (-first-item list) 5) list) - ⇒ (5 2 3) - - -- Function: -second-item (list) - Return the second item of LIST, or ‘nil’ if LIST is too short. - - See also: ‘-first-item’ (*note -first-item::), ‘-third-item’ (*note - -third-item::), etc. - - (-second-item ()) - ⇒ () - (-second-item '(1 2 3 4 5)) - ⇒ 2 - (let ((list (list 1 2))) (setf (-second-item list) 5) list) - ⇒ (1 5) - - -- Function: -third-item (list) - Return the third item of LIST, or ‘nil’ if LIST is too short. - - See also: ‘-second-item’ (*note -second-item::), ‘-fourth-item’ - (*note -fourth-item::), etc. - - (-third-item ()) - ⇒ () - (-third-item '(1 2)) - ⇒ () - (-third-item '(1 2 3 4 5)) - ⇒ 3 - - -- Function: -fourth-item (list) - Return the fourth item of LIST, or ‘nil’ if LIST is too short. - - See also: ‘-third-item’ (*note -third-item::), ‘-fifth-item’ (*note - -fifth-item::), etc. - - (-fourth-item ()) - ⇒ () - (-fourth-item '(1 2 3)) - ⇒ () - (-fourth-item '(1 2 3 4 5)) - ⇒ 4 - - -- Function: -fifth-item (list) - Return the fifth item of LIST, or ‘nil’ if LIST is too short. - - See also: ‘-fourth-item’ (*note -fourth-item::), ‘-last-item’ - (*note -last-item::), etc. - - (-fifth-item ()) - ⇒ () - (-fifth-item '(1 2 3 4)) - ⇒ () - (-fifth-item '(1 2 3 4 5)) - ⇒ 5 - - -- Function: -last-item (list) - Return the last item of LIST, or ‘nil’ on an empty list. - - See also: ‘-first-item’ (*note -first-item::), etc. - - (-last-item ()) - ⇒ () - (-last-item '(1 2 3 4 5)) - ⇒ 5 - (let ((list (list 1 2 3))) (setf (-last-item list) 5) list) - ⇒ (1 2 5) - - -- Function: -butlast (list) - Return a list of all items in list except for the last. - - (-butlast '(1 2 3)) - ⇒ (1 2) - (-butlast '(1 2)) - ⇒ (1) - (-butlast '(1)) - ⇒ nil - - -- Function: -sort (comparator list) - Sort LIST, stably, comparing elements using COMPARATOR. Return the - sorted list. LIST is NOT modified by side effects. COMPARATOR is - called with two elements of LIST, and should return non-‘nil’ if - the first element should sort before the second. - - (-sort #'< '(3 1 2)) - ⇒ (1 2 3) - (-sort #'> '(3 1 2)) - ⇒ (3 2 1) - (--sort (< it other) '(3 1 2)) - ⇒ (1 2 3) - - -- Function: -list (arg) - Ensure ARG is a list. If ARG is already a list, return it as is - (not a copy). Otherwise, return a new list with ARG as its only - element. - - Another supported calling convention is (-list &rest ARGS). In - this case, if ARG is not a list, a new list with all of ARGS as - elements is returned. This use is supported for backward - compatibility and is otherwise deprecated. - - (-list 1) - ⇒ (1) - (-list ()) - ⇒ () - (-list '(1 2 3)) - ⇒ (1 2 3) - - -- Function: -fix (fn list) - Compute the (least) fixpoint of FN with initial input LIST. - - FN is called at least once, results are compared with ‘equal’. - - (-fix (lambda (l) (-non-nil (--mapcat (-split-at (/ (length it) 2) it) l))) '((1 2 3))) - ⇒ ((1) (2) (3)) - (let ((l '((starwars scifi) (jedi starwars warrior)))) (--fix (-uniq (--mapcat (cons it (cdr (assq it l))) it)) '(jedi book))) - ⇒ (jedi starwars warrior scifi book) - - -File: dash.info, Node: Tree operations, Next: Threading macros, Prev: Other list operations, Up: Functions - -2.11 Tree operations -==================== - -Functions pretending lists are trees. - - -- Function: -tree-seq (branch children tree) - Return a sequence of the nodes in TREE, in depth-first search - order. - - BRANCH is a predicate of one argument that returns non-‘nil’ if the - passed argument is a branch, that is, a node that can have - children. - - CHILDREN is a function of one argument that returns the children of - the passed branch node. - - Non-branch nodes are simply copied. - - (-tree-seq 'listp 'identity '(1 (2 3) 4 (5 (6 7)))) - ⇒ ((1 (2 3) 4 (5 (6 7))) 1 (2 3) 2 3 4 (5 (6 7)) 5 (6 7) 6 7) - (-tree-seq 'listp 'reverse '(1 (2 3) 4 (5 (6 7)))) - ⇒ ((1 (2 3) 4 (5 (6 7))) (5 (6 7)) (6 7) 7 6 5 4 (2 3) 3 2 1) - (--tree-seq (vectorp it) (append it nil) [1 [2 3] 4 [5 [6 7]]]) - ⇒ ([1 [2 3] 4 [5 [6 7]]] 1 [2 3] 2 3 4 [5 [6 7]] 5 [6 7] 6 7) - - -- Function: -tree-map (fn tree) - Apply FN to each element of TREE while preserving the tree - structure. - - (-tree-map '1+ '(1 (2 3) (4 (5 6) 7))) - ⇒ (2 (3 4) (5 (6 7) 8)) - (-tree-map '(lambda (x) (cons x (expt 2 x))) '(1 (2 3) 4)) - ⇒ ((1 . 2) ((2 . 4) (3 . 8)) (4 . 16)) - (--tree-map (length it) '("" ("

" "text" "

") "")) - ⇒ (6 (3 4 4) 7) - - -- Function: -tree-map-nodes (pred fun tree) - Call FUN on each node of TREE that satisfies PRED. - - If PRED returns ‘nil’, continue descending down this node. If PRED - returns non-‘nil’, apply FUN to this node and do not descend - further. - - (-tree-map-nodes 'vectorp (lambda (x) (-sum (append x nil))) '(1 [2 3] 4 (5 [6 7] 8))) - ⇒ (1 5 4 (5 13 8)) - (-tree-map-nodes 'keywordp (lambda (x) (symbol-name x)) '(1 :foo 4 ((5 6 :bar) :baz 8))) - ⇒ (1 ":foo" 4 ((5 6 ":bar") ":baz" 8)) - (--tree-map-nodes (eq (car-safe it) 'add-mode) (-concat it (list :mode 'emacs-lisp-mode)) '(with-mode emacs-lisp-mode (foo bar) (add-mode a b) (baz (add-mode c d)))) - ⇒ (with-mode emacs-lisp-mode (foo bar) (add-mode a b :mode emacs-lisp-mode) (baz (add-mode c d :mode emacs-lisp-mode))) - - -- Function: -tree-reduce (fn tree) - Use FN to reduce elements of list TREE. If elements of TREE are - lists themselves, apply the reduction recursively. - - FN is first applied to first element of the list and second - element, then on this result and third element from the list etc. - - See ‘-reduce-r’ (*note -reduce-r::) for how exactly are lists of - zero or one element handled. - - (-tree-reduce '+ '(1 (2 3) (4 5))) - ⇒ 15 - (-tree-reduce 'concat '("strings" (" on" " various") ((" levels")))) - ⇒ "strings on various levels" - (--tree-reduce (cond ((stringp it) (concat it " " acc)) (t (let ((sn (symbol-name it))) (concat "<" sn ">" acc "")))) '(body (p "some words") (div "more" (b "bold") "words"))) - ⇒ "

some words

more bold words
" - - -- Function: -tree-reduce-from (fn init-value tree) - Use FN to reduce elements of list TREE. If elements of TREE are - lists themselves, apply the reduction recursively. - - FN is first applied to INIT-VALUE and first element of the list, - then on this result and second element from the list etc. - - The initial value is ignored on cons pairs as they always contain - two elements. - - (-tree-reduce-from '+ 1 '(1 (1 1) ((1)))) - ⇒ 8 - (--tree-reduce-from (-concat acc (list it)) nil '(1 (2 3 (4 5)) (6 7))) - ⇒ ((7 6) ((5 4) 3 2) 1) - - -- Function: -tree-mapreduce (fn folder tree) - Apply FN to each element of TREE, and make a list of the results. - If elements of TREE are lists themselves, apply FN recursively to - elements of these nested lists. - - Then reduce the resulting lists using FOLDER and initial value - INIT-VALUE. See ‘-reduce-r-from’ (*note -reduce-r-from::). - - This is the same as calling ‘-tree-reduce’ (*note -tree-reduce::) - after ‘-tree-map’ (*note -tree-map::) but is twice as fast as it - only traverse the structure once. - - (-tree-mapreduce 'list 'append '(1 (2 (3 4) (5 6)) (7 (8 9)))) - ⇒ (1 2 3 4 5 6 7 8 9) - (--tree-mapreduce 1 (+ it acc) '(1 (2 (4 9) (2 1)) (7 (4 3)))) - ⇒ 9 - (--tree-mapreduce 0 (max acc (1+ it)) '(1 (2 (4 9) (2 1)) (7 (4 3)))) - ⇒ 3 - - -- Function: -tree-mapreduce-from (fn folder init-value tree) - Apply FN to each element of TREE, and make a list of the results. - If elements of TREE are lists themselves, apply FN recursively to - elements of these nested lists. - - Then reduce the resulting lists using FOLDER and initial value - INIT-VALUE. See ‘-reduce-r-from’ (*note -reduce-r-from::). - - This is the same as calling ‘-tree-reduce-from’ (*note - -tree-reduce-from::) after ‘-tree-map’ (*note -tree-map::) but is - twice as fast as it only traverse the structure once. - - (-tree-mapreduce-from 'identity '* 1 '(1 (2 (3 4) (5 6)) (7 (8 9)))) - ⇒ 362880 - (--tree-mapreduce-from (+ it it) (cons it acc) nil '(1 (2 (4 9) (2 1)) (7 (4 3)))) - ⇒ (2 (4 (8 18) (4 2)) (14 (8 6))) - (concat "{" (--tree-mapreduce-from (cond ((-cons-pair? it) (concat (symbol-name (car it)) " -> " (symbol-name (cdr it)))) (t (concat (symbol-name it) " : {"))) (concat it (unless (or (equal acc "}") (equal (substring it (1- (length it))) "{")) ", ") acc) "}" '((elisp-mode (foo (bar . booze)) (baz . qux)) (c-mode (foo . bla) (bum . bam))))) - ⇒ "{elisp-mode : {foo : {bar -> booze}, baz -> qux}, c-mode : {foo -> bla, bum -> bam}}" - - -- Function: -clone (list) - Create a deep copy of LIST. The new list has the same elements and - structure but all cons are replaced with new ones. This is useful - when you need to clone a structure such as plist or alist. - - (let* ((a (list (list 1))) (b (-clone a))) (setcar (car a) 2) b) - ⇒ ((1)) - - -File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions - -2.12 Threading macros -===================== - -Macros that conditionally combine sequential forms for brevity or -readability. - - -- Macro: -> (x &optional form &rest more) - Thread the expr through the forms. Insert X as the second item in - the first form, making a list of it if it is not a list already. - If there are more forms, insert the first form as the second item - in second form, etc. - - (-> '(2 3 5)) - ⇒ (2 3 5) - (-> '(2 3 5) (append '(8 13))) - ⇒ (2 3 5 8 13) - (-> '(2 3 5) (append '(8 13)) (-slice 1 -1)) - ⇒ (3 5 8) - - -- Macro: ->> (x &optional form &rest more) - Thread the expr through the forms. Insert X as the last item in - the first form, making a list of it if it is not a list already. - If there are more forms, insert the first form as the last item in - second form, etc. - - (->> '(1 2 3) (-map 'square)) - ⇒ (1 4 9) - (->> '(1 2 3) (-map 'square) (-remove 'even?)) - ⇒ (1 9) - (->> '(1 2 3) (-map 'square) (-reduce '+)) - ⇒ 14 - - -- Macro: --> (x &rest forms) - Starting with the value of X, thread each expression through FORMS. - - Insert X at the position signified by the symbol ‘it’ in the first - form. If there are more forms, insert the first form at the - position signified by ‘it’ in in second form, etc. - - (--> "def" (concat "abc" it "ghi")) - ⇒ "abcdefghi" - (--> "def" (concat "abc" it "ghi") (upcase it)) - ⇒ "ABCDEFGHI" - (--> "def" (concat "abc" it "ghi") upcase) - ⇒ "ABCDEFGHI" - - -- Macro: -as-> (value variable &rest forms) - Starting with VALUE, thread VARIABLE through FORMS. - - In the first form, bind VARIABLE to VALUE. In the second form, - bind VARIABLE to the result of the first form, and so forth. - - (-as-> 3 my-var (1+ my-var) (list my-var) (mapcar (lambda (ele) (* 2 ele)) my-var)) - ⇒ (8) - (-as-> 3 my-var 1+) - ⇒ 4 - (-as-> 3 my-var) - ⇒ 3 - - -- Macro: -some-> (x &optional form &rest more) - When expr is non-‘nil’, thread it through the first form (via ‘->’ - (*note ->::)), and when that result is non-‘nil’, through the next - form, etc. - - (-some-> '(2 3 5)) - ⇒ (2 3 5) - (-some-> 5 square) - ⇒ 25 - (-some-> 5 even? square) - ⇒ nil - - -- Macro: -some->> (x &optional form &rest more) - When expr is non-‘nil’, thread it through the first form (via ‘->>’ - (*note ->>::)), and when that result is non-‘nil’, through the next - form, etc. - - (-some->> '(1 2 3) (-map 'square)) - ⇒ (1 4 9) - (-some->> '(1 3 5) (-last 'even?) (+ 100)) - ⇒ nil - (-some->> '(2 4 6) (-last 'even?) (+ 100)) - ⇒ 106 - - -- Macro: -some--> (expr &rest forms) - Thread EXPR through FORMS via ‘-->’ (*note -->::), while the result - is non-‘nil’. When EXPR evaluates to non-‘nil’, thread the result - through the first of FORMS, and when that result is non-‘nil’, - thread it through the next form, etc. - - (-some--> "def" (concat "abc" it "ghi")) - ⇒ "abcdefghi" - (-some--> nil (concat "abc" it "ghi")) - ⇒ nil - (-some--> '(0 1) (-remove #'natnump it) (append it it) (-map #'1+ it)) - ⇒ () - - -- Macro: -doto (init &rest forms) - Evaluate INIT and pass it as argument to FORMS with ‘->’ (*note - ->::). The RESULT of evaluating INIT is threaded through each of - FORMS individually using ‘->’ (*note ->::), which see. The return - value is RESULT, which FORMS may have modified by side effect. - - (-doto (list 1 2 3) pop pop) - ⇒ (3) - (-doto (cons 1 2) (setcar 3) (setcdr 4)) - ⇒ (3 . 4) - (gethash 'k (--doto (make-hash-table) (puthash 'k 'v it))) - ⇒ v - - -File: dash.info, Node: Binding, Next: Side effects, Prev: Threading macros, Up: Functions - -2.13 Binding -============ - -Macros that combine ‘let’ and ‘let*’ with destructuring and flow -control. - - -- Macro: -when-let ((var val) &rest body) - If VAL evaluates to non-‘nil’, bind it to VAR and execute body. - - Note: binding is done according to ‘-let’ (*note -let::). - - (-when-let (match-index (string-match "d" "abcd")) (+ match-index 2)) - ⇒ 5 - (-when-let ((&plist :foo foo) (list :foo "foo")) foo) - ⇒ "foo" - (-when-let ((&plist :foo foo) (list :bar "bar")) foo) - ⇒ nil - - -- Macro: -when-let* (vars-vals &rest body) - If all VALS evaluate to true, bind them to their corresponding VARS - and execute body. VARS-VALS should be a list of (VAR VAL) pairs. - - Note: binding is done according to ‘-let*’ (*note -let*::). VALS - are evaluated sequentially, and evaluation stops after the first - ‘nil’ VAL is encountered. - - (-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) - ⇒ 15 - (-when-let* ((x 5) (y nil) (z 7)) (+ x y z)) - ⇒ nil - - -- Macro: -if-let ((var val) then &rest else) - If VAL evaluates to non-‘nil’, bind it to VAR and do THEN, - otherwise do ELSE. - - Note: binding is done according to ‘-let’ (*note -let::). - - (-if-let (match-index (string-match "d" "abc")) (+ match-index 3) 7) - ⇒ 7 - (--if-let (even? 4) it nil) - ⇒ t - - -- Macro: -if-let* (vars-vals then &rest else) - If all VALS evaluate to true, bind them to their corresponding VARS - and do THEN, otherwise do ELSE. VARS-VALS should be a list of (VAR - VAL) pairs. - - Note: binding is done according to ‘-let*’ (*note -let*::). VALS - are evaluated sequentially, and evaluation stops after the first - ‘nil’ VAL is encountered. - - (-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") - ⇒ 15 - (-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") - ⇒ "foo" - (-if-let* (((_ _ x) '(nil nil 7))) x) - ⇒ 7 - - -- Macro: -let (varlist &rest body) - Bind variables according to VARLIST then eval BODY. - - VARLIST is a list of lists of the form (PATTERN SOURCE). Each - PATTERN is matched against the SOURCE "structurally". SOURCE is - only evaluated once for each PATTERN. Each PATTERN is matched - recursively, and can therefore contain sub-patterns which are - matched against corresponding sub-expressions of SOURCE. - - All the SOURCEs are evalled before any symbols are bound (i.e. "in - parallel"). - - If VARLIST only contains one (PATTERN SOURCE) element, you can - optionally specify it using a vector and discarding the outer-most - parens. Thus - - (-let ((PATTERN SOURCE)) ...) - - becomes - - (-let [PATTERN SOURCE] ...). - - ‘-let’ (*note -let::) uses a convention of not binding places - (symbols) starting with _ whenever it’s possible. You can use this - to skip over entries you don’t care about. However, this is not - *always* possible (as a result of implementation) and these symbols - might get bound to undefined values. - - Following is the overview of supported patterns. Remember that - patterns can be matched recursively, so every a, b, aK in the - following can be a matching construct and not necessarily a - symbol/variable. - - Symbol: - - a - bind the SOURCE to A. This is just like regular ‘let’. - - Conses and lists: - - (a) - bind ‘car’ of cons/list to A - - (a . b) - bind car of cons to A and ‘cdr’ to B - - (a b) - bind car of list to A and ‘cadr’ to B - - (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to - A3... - - (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST. - - Vectors: - - [a] - bind 0th element of a non-list sequence to A (works with - vectors, strings, bit arrays...) - - [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st - to A1, 2nd to A2, ... If the PATTERN is shorter than SOURCE, the - values at places not in PATTERN are ignored. If the PATTERN is - longer than SOURCE, an ‘error’ is thrown. - - [a1 a2 a3 ... &rest rest] - as above, but bind the rest of the - sequence to REST. This is conceptually the same as improper list - matching (a1 a2 ... aN . rest) - - Key/value stores: - - (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE plist to aK. If the value is not found, aK is ‘nil’. Uses - ‘plist-get’ to fetch values. - - (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE alist to aK. If the value is not found, aK is ‘nil’. Uses - ‘assoc’ to fetch values. - - (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE hash table to aK. If the value is not found, aK is ‘nil’. - Uses ‘gethash’ to fetch values. - - Further, special keyword &keys supports "inline" matching of - plist-like key-value pairs, similarly to &keys keyword of - ‘cl-defun’. - - (a1 a2 ... aN &keys key1 b1 ... keyN bK) - - This binds N values from the list to a1 ... aN, then interprets the - cdr as a plist (see key/value matching above). - - A shorthand notation for kv-destructuring exists which allows the - patterns be optionally left out and derived from the key name in - the following fashion: - - - a key :foo is converted into ‘foo’ pattern, - a key ’bar is - converted into ‘bar’ pattern, - a key "baz" is converted into ‘baz’ - pattern. - - That is, the entire value under the key is bound to the derived - variable without any further destructuring. - - This is possible only when the form following the key is not a - valid pattern (i.e. not a symbol, a cons cell or a vector). - Otherwise the matching proceeds as usual and in case of an invalid - spec fails with an error. - - Thus the patterns are normalized as follows: - - ;; derive all the missing patterns (&plist :foo ’bar "baz") => - (&plist :foo foo ’bar bar "baz" baz) - - ;; we can specify some but not others (&plist :foo ’bar - explicit-bar) => (&plist :foo foo ’bar explicit-bar) - - ;; nothing happens, we store :foo in x (&plist :foo x) => (&plist - :foo x) - - ;; nothing happens, we match recursively (&plist :foo (a b c)) => - (&plist :foo (a b c)) - - You can name the source using the syntax SYMBOL &as PATTERN. This - syntax works with lists (proper or improper), vectors and all types - of maps. - - (list &as a b c) (list 1 2 3) - - binds A to 1, B to 2, C to 3 and LIST to (1 2 3). - - Similarly: - - (bounds &as beg . end) (cons 1 2) - - binds BEG to 1, END to 2 and BOUNDS to (1 . 2). - - (items &as first . rest) (list 1 2 3) - - binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3) - - [vect &as _ b c] [1 2 3] - - binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as - usual). - - (plist &as &plist :b b) (list :a 1 :b 2 :c 3) - - binds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and - &hash. - - This is especially useful when we want to capture the result of a - computation and destructure at the same time. Consider the form - (function-returning-complex-structure) returning a list of two - vectors with two items each. We want to capture this entire result - and pass it to another computation, but at the same time we want to - get the second item from each vector. We can achieve it with - pattern - - (result &as [_ a] [_ b]) (function-returning-complex-structure) - - Note: Clojure programmers may know this feature as the ":as - binding". The difference is that we put the &as at the front - because we need to support improper list binding. - - (-let (([a (b c) d] [1 (2 3) 4])) (list a b c d)) - ⇒ (1 2 3 4) - (-let [(a b c . d) (list 1 2 3 4 5 6)] (list a b c d)) - ⇒ (1 2 3 (4 5 6)) - (-let [(&plist :foo foo :bar bar) (list :baz 3 :foo 1 :qux 4 :bar 2)] (list foo bar)) - ⇒ (1 2) - - -- Macro: -let* (varlist &rest body) - Bind variables according to VARLIST then eval BODY. - - VARLIST is a list of lists of the form (PATTERN SOURCE). Each - PATTERN is matched against the SOURCE structurally. SOURCE is only - evaluated once for each PATTERN. - - Each SOURCE can refer to the symbols already bound by this VARLIST. - This is useful if you want to destructure SOURCE recursively but - also want to name the intermediate structures. - - See ‘-let’ (*note -let::) for the list of all possible patterns. - - (-let* (((a . b) (cons 1 2)) ((c . d) (cons 3 4))) (list a b c d)) - ⇒ (1 2 3 4) - (-let* (((a . b) (cons 1 (cons 2 3))) ((c . d) b)) (list a b c d)) - ⇒ (1 (2 . 3) 2 3) - (-let* (((&alist "foo" foo "bar" bar) (list (cons "foo" 1) (cons "bar" (list 'a 'b 'c)))) ((a b c) bar)) (list foo a b c bar)) - ⇒ (1 a b c (a b c)) - - -- Macro: -lambda (match-form &rest body) - Return a lambda which destructures its input as MATCH-FORM and - executes BODY. - - Note that you have to enclose the MATCH-FORM in a pair of parens, - such that: - - (-lambda (x) body) (-lambda (x y ...) body) - - has the usual semantics of ‘lambda’. Furthermore, these get - translated into normal ‘lambda’, so there is no performance - penalty. - - See ‘-let’ (*note -let::) for a description of the destructuring - mechanism. - - (-map (-lambda ((x y)) (+ x y)) '((1 2) (3 4) (5 6))) - ⇒ (3 7 11) - (-map (-lambda ([x y]) (+ x y)) '([1 2] [3 4] [5 6])) - ⇒ (3 7 11) - (funcall (-lambda ((_ . a) (_ . b)) (-concat a b)) '(1 2 3) '(4 5 6)) - ⇒ (2 3 5 6) - - -- Macro: -setq ([match-form val] ...) - Bind each MATCH-FORM to the value of its VAL. - - MATCH-FORM destructuring is done according to the rules of ‘-let’ - (*note -let::). - - This macro allows you to bind multiple variables by destructuring - the value, so for example: - - (-setq (a b) x (&plist :c c) plist) - - expands roughly speaking to the following code - - (setq a (car x) b (cadr x) c (plist-get plist :c)) - - Care is taken to only evaluate each VAL once so that in case of - multiple assignments it does not cause unexpected side effects. - - (let (a) (-setq a 1) a) - ⇒ 1 - (let (a b) (-setq (a b) (list 1 2)) (list a b)) - ⇒ (1 2) - (let (c) (-setq (&plist :c c) (list :c "c")) c) - ⇒ "c" - - -File: dash.info, Node: Side effects, Next: Destructive operations, Prev: Binding, Up: Functions - -2.14 Side effects -================= - -Functions iterating over lists for side effect only. - - -- Function: -each (list fn) - Call FN on each element of LIST. Return ‘nil’; this function is - intended for side effects. - - Its anaphoric counterpart is ‘--each’. - - For access to the current element’s index in LIST, see - ‘-each-indexed’ (*note -each-indexed::). - - (let (l) (-each '(1 2 3) (lambda (x) (push x l))) l) - ⇒ (3 2 1) - (let (l) (--each '(1 2 3) (push it l)) l) - ⇒ (3 2 1) - (-each '(1 2 3) #'identity) - ⇒ nil - - -- Function: -each-while (list pred fn) - Call FN on each ITEM in LIST, while (PRED ITEM) is non-‘nil’. Once - an ITEM is reached for which PRED returns ‘nil’, FN is no longer - called. Return ‘nil’; this function is intended for side effects. - - Its anaphoric counterpart is ‘--each-while’. - - (let (l) (-each-while '(2 4 5 6) #'even? (lambda (x) (push x l))) l) - ⇒ (4 2) - (let (l) (--each-while '(1 2 3 4) (< it 3) (push it l)) l) - ⇒ (2 1) - (let ((s 0)) (--each-while '(1 3 4 5) (< it 5) (setq s (+ s it))) s) - ⇒ 8 - - -- Function: -each-indexed (list fn) - Call FN on each index and element of LIST. For each ITEM at INDEX - in LIST, call (funcall FN INDEX ITEM). Return ‘nil’; this function - is intended for side effects. - - See also: ‘-map-indexed’ (*note -map-indexed::). - - (let (l) (-each-indexed '(a b c) (lambda (i x) (push (list x i) l))) l) - ⇒ ((c 2) (b 1) (a 0)) - (let (l) (--each-indexed '(a b c) (push (list it it-index) l)) l) - ⇒ ((c 2) (b 1) (a 0)) - (let (l) (--each-indexed () (push it l)) l) - ⇒ () - - -- Function: -each-r (list fn) - Call FN on each element of LIST in reversed order. Return ‘nil’; - this function is intended for side effects. - - Its anaphoric counterpart is ‘--each-r’. - - (let (l) (-each-r '(1 2 3) (lambda (x) (push x l))) l) - ⇒ (1 2 3) - (let (l) (--each-r '(1 2 3) (push it l)) l) - ⇒ (1 2 3) - (-each-r '(1 2 3) #'identity) - ⇒ nil - - -- Function: -each-r-while (list pred fn) - Call FN on each ITEM in reversed LIST, while (PRED ITEM) is - non-‘nil’. Once an ITEM is reached for which PRED returns ‘nil’, - FN is no longer called. Return ‘nil’; this function is intended - for side effects. - - Its anaphoric counterpart is ‘--each-r-while’. - - (let (l) (-each-r-while '(2 4 5 6) #'even? (lambda (x) (push x l))) l) - ⇒ (6) - (let (l) (--each-r-while '(1 2 3 4) (>= it 3) (push it l)) l) - ⇒ (3 4) - (let ((s 0)) (--each-r-while '(1 2 3 5) (> it 1) (setq s (+ s it))) s) - ⇒ 10 - - -- Function: -dotimes (num fn) - Call FN NUM times, presumably for side effects. FN is called with - a single argument on successive integers running from 0, inclusive, - to NUM, exclusive. FN is not called if NUM is less than 1. - - This function’s anaphoric counterpart is ‘--dotimes’. - - (let (s) (-dotimes 3 (lambda (n) (push n s))) s) - ⇒ (2 1 0) - (let (s) (-dotimes 0 (lambda (n) (push n s))) s) - ⇒ () - (let (s) (--dotimes 5 (push it s)) s) - ⇒ (4 3 2 1 0) - - -File: dash.info, Node: Destructive operations, Next: Function combinators, Prev: Side effects, Up: Functions - -2.15 Destructive operations -=========================== - -Macros that modify variables holding lists. - - -- Macro: !cons (car cdr) - Destructive: Set CDR to the cons of CAR and CDR. - - (let (l) (!cons 5 l) l) - ⇒ (5) - (let ((l '(3))) (!cons 5 l) l) - ⇒ (5 3) - - -- Macro: !cdr (list) - Destructive: Set LIST to the cdr of LIST. - - (let ((l '(3))) (!cdr l) l) - ⇒ () - (let ((l '(3 5))) (!cdr l) l) - ⇒ (5) - - -File: dash.info, Node: Function combinators, Prev: Destructive operations, Up: Functions - -2.16 Function combinators -========================= - -Functions that manipulate and compose other functions. - - -- Function: -partial (fun &rest args) - Return a function that is a partial application of FUN to ARGS. - ARGS is a list of the first N arguments to pass to FUN. The result - is a new function which does the same as FUN, except that the first - N arguments are fixed at the values with which this function was - called. - - (funcall (-partial #'+ 5)) - ⇒ 5 - (funcall (-partial #'- 5) 3) - ⇒ 2 - (funcall (-partial #'+ 5 2) 3) - ⇒ 10 - - -- Function: -rpartial (fn &rest args) - Return a function that is a partial application of FN to ARGS. - ARGS is a list of the last N arguments to pass to FN. The result - is a new function which does the same as FN, except that the last N - arguments are fixed at the values with which this function was - called. This is like ‘-partial’ (*note -partial::), except the - arguments are fixed starting from the right rather than the left. - - (funcall (-rpartial #'- 5)) - ⇒ -5 - (funcall (-rpartial #'- 5) 8) - ⇒ 3 - (funcall (-rpartial #'- 5 2) 10) - ⇒ 3 - - -- Function: -juxt (&rest fns) - Return a function that is the juxtaposition of FNS. The returned - function takes a variable number of ARGS, applies each of FNS in - turn to ARGS, and returns the list of results. - - (funcall (-juxt) 1 2) - ⇒ () - (funcall (-juxt #'+ #'- #'* #'/) 7 5) - ⇒ (12 2 35 1) - (mapcar (-juxt #'number-to-string #'1+) '(1 2)) - ⇒ (("1" 2) ("2" 3)) - - -- Function: -compose (&rest fns) - Compose FNS into a single composite function. Return a function - that takes a variable number of ARGS, applies the last function in - FNS to ARGS, and returns the result of calling each remaining - function on the result of the previous function, right-to-left. If - no FNS are given, return a variadic ‘identity’ function. - - (funcall (-compose #'- #'1+ #'+) 1 2 3) - ⇒ -7 - (funcall (-compose #'identity #'1+) 3) - ⇒ 4 - (mapcar (-compose #'not #'stringp) '(nil "")) - ⇒ (t nil) - - -- Function: -applify (fn) - Return a function that applies FN to a single list of args. This - changes the arity of FN from taking N distinct arguments to taking - 1 argument which is a list of N arguments. - - (funcall (-applify #'+) nil) - ⇒ 0 - (mapcar (-applify #'+) '((1 1 1) (1 2 3) (5 5 5))) - ⇒ (3 6 15) - (funcall (-applify #'<) '(3 6)) - ⇒ t - - -- Function: -on (op trans) - Return a function that calls TRANS on each arg and OP on the - results. The returned function takes a variable number of - arguments, calls the function TRANS on each one in turn, and then - passes those results as the list of arguments to OP, in the same - order. - - For example, the following pairs of expressions are morally - equivalent: - - (funcall (-on #’+ #’1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3)) (funcall - (-on #’+ #’1+)) = (+) - - (-sort (-on #'< #'length) '((1 2 3) (1) (1 2))) - ⇒ ((1) (1 2) (1 2 3)) - (funcall (-on #'min #'string-to-number) "22" "2" "1" "12") - ⇒ 1 - (-min-by (-on #'> #'length) '((1 2 3) (4) (1 2))) - ⇒ (4) - - -- Function: -flip (fn) - Return a function that calls FN with its arguments reversed. The - returned function takes the same number of arguments as FN. - - For example, the following two expressions are morally equivalent: - - (funcall (-flip #’-) 1 2) = (- 2 1) - - See also: ‘-rotate-args’ (*note -rotate-args::). - - (-sort (-flip #'<) '(4 3 6 1)) - ⇒ (6 4 3 1) - (funcall (-flip #'-) 3 2 1 10) - ⇒ 4 - (funcall (-flip #'1+) 1) - ⇒ 2 - - -- Function: -rotate-args (n fn) - Return a function that calls FN with args rotated N places to the - right. The returned function takes the same number of arguments as - FN, rotates the list of arguments N places to the right (left if N - is negative) just like ‘-rotate’ (*note -rotate::), and applies FN - to the result. - - See also: ‘-flip’ (*note -flip::). - - (funcall (-rotate-args -1 #'list) 1 2 3 4) - ⇒ (2 3 4 1) - (funcall (-rotate-args 1 #'-) 1 10 100) - ⇒ 89 - (funcall (-rotate-args 2 #'list) 3 4 5 1 2) - ⇒ (1 2 3 4 5) - - -- Function: -const (c) - Return a function that returns C ignoring any additional arguments. - - In types: a -> b -> a - - (funcall (-const 2) 1 3 "foo") - ⇒ 2 - (mapcar (-const 1) '("a" "b" "c" "d")) - ⇒ (1 1 1 1) - (-sum (mapcar (-const 1) '("a" "b" "c" "d"))) - ⇒ 4 - - -- Macro: -cut (&rest params) - Take n-ary function and n arguments and specialize some of them. - Arguments denoted by <> will be left unspecialized. - - See SRFI-26 for detailed description. - - (funcall (-cut list 1 <> 3 <> 5) 2 4) - ⇒ (1 2 3 4 5) - (-map (-cut funcall <> 5) `(1+ 1- ,(lambda (x) (/ 1.0 x)))) - ⇒ (6 4 0.2) - (-map (-cut <> 1 2 3) '(list vector string)) - ⇒ ((1 2 3) [1 2 3] "\1\2\3") - - -- Function: -not (pred) - Return a predicate that negates the result of PRED. The returned - predicate passes its arguments to PRED. If PRED returns ‘nil’, the - result is non-‘nil’; otherwise the result is ‘nil’. - - See also: ‘-andfn’ (*note -andfn::) and ‘-orfn’ (*note -orfn::). - - (funcall (-not #'numberp) "5") - ⇒ t - (-sort (-not #'<) '(5 2 1 0 6)) - ⇒ (6 5 2 1 0) - (-filter (-not (-partial #'< 4)) '(1 2 3 4 5 6 7 8)) - ⇒ (1 2 3 4) - - -- Function: -orfn (&rest preds) - Return a predicate that returns the first non-‘nil’ result of - PREDS. The returned predicate takes a variable number of - arguments, passes them to each predicate in PREDS in turn until one - of them returns non-‘nil’, and returns that non-‘nil’ result - without calling the remaining PREDS. If all PREDS return ‘nil’, or - if no PREDS are given, the returned predicate returns ‘nil’. - - See also: ‘-andfn’ (*note -andfn::) and ‘-not’ (*note -not::). - - (-filter (-orfn #'natnump #'booleanp) '(1 nil "a" -4 b c t)) - ⇒ (1 nil t) - (funcall (-orfn #'symbolp (-cut string-match-p "x" <>)) "axe") - ⇒ 1 - (funcall (-orfn #'= #'+) 1 1) - ⇒ t - - -- Function: -andfn (&rest preds) - Return a predicate that returns non-‘nil’ if all PREDS do so. The - returned predicate P takes a variable number of arguments and - passes them to each predicate in PREDS in turn. If any one of - PREDS returns ‘nil’, P also returns ‘nil’ without calling the - remaining PREDS. If all PREDS return non-‘nil’, P returns the last - such value. If no PREDS are given, P always returns non-‘nil’. - - See also: ‘-orfn’ (*note -orfn::) and ‘-not’ (*note -not::). - - (-filter (-andfn #'numberp (-cut < <> 5)) '(a 1 b 6 c 2)) - ⇒ (1 2) - (mapcar (-andfn #'numberp #'1+) '(a 1 b 6)) - ⇒ (nil 2 nil 7) - (funcall (-andfn #'= #'+) 1 1) - ⇒ 2 - - -- Function: -iteratefn (fn n) - Return a function FN composed N times with itself. - - FN is a unary function. If you need to use a function of higher - arity, use ‘-applify’ (*note -applify::) first to turn it into a - unary function. - - With n = 0, this acts as identity function. - - In types: (a -> a) -> Int -> a -> a. - - This function satisfies the following law: - - (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init - (1+ n))). - - (funcall (-iteratefn (lambda (x) (* x x)) 3) 2) - ⇒ 256 - (funcall (-iteratefn '1+ 3) 1) - ⇒ 4 - (funcall (-iteratefn 'cdr 3) '(1 2 3 4 5)) - ⇒ (4 5) - - -- Function: -fixfn (fn &optional equal-test halt-test) - Return a function that computes the (least) fixpoint of FN. - - FN must be a unary function. The returned lambda takes a single - argument, X, the initial value for the fixpoint iteration. The - iteration halts when either of the following conditions is - satisfied: - - 1. Iteration converges to the fixpoint, with equality being tested - using EQUAL-TEST. If EQUAL-TEST is not specified, ‘equal’ is used. - For functions over the floating point numbers, it may be necessary - to provide an appropriate approximate comparison test. - - 2. HALT-TEST returns a non-‘nil’ value. HALT-TEST defaults to a - simple counter that returns ‘t’ after ‘-fixfn-max-iterations’, to - guard against infinite iteration. Otherwise, HALT-TEST must be a - function that accepts a single argument, the current value of X, - and returns non-‘nil’ as long as iteration should continue. In - this way, a more sophisticated convergence test may be supplied by - the caller. - - The return value of the lambda is either the fixpoint or, if - iteration halted before converging, a cons with car ‘halted’ and - cdr the final output from HALT-TEST. - - In types: (a -> a) -> a -> a. - - (funcall (-fixfn #'cos #'approx=) 0.7) - ⇒ 0.7390851332151607 - (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) - ⇒ 1.8555845286409378 - (funcall (-fixfn #'sin #'approx=) 0.1) - ⇒ (halted . t) - - -- Function: -prodfn (&rest fns) - Return a function that applies each of FNS to each of a list of - arguments. - - Takes a list of N functions and returns a function that takes a - list of length N, applying Ith function to Ith element of the input - list. Returns a list of length N. - - In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) - - This function satisfies the following laws: - - (-compose (-prodfn f g ...) (-prodfn f’ g’ ...)) = (-prodfn - (-compose f f’) (-compose g g’) ...) - - (-prodfn f g ...) = (-juxt (-compose f (-partial #’nth 0)) - (-compose g (-partial #’nth 1)) ...) - - (-compose (-prodfn f g ...) (-juxt f’ g’ ...)) = (-juxt (-compose f - f’) (-compose g g’) ...) - - (-compose (-partial #’nth n) (-prod f1 f2 ...)) = (-compose fn - (-partial #’nth n)) - - (funcall (-prodfn #'1+ #'1- #'number-to-string) '(1 2 3)) - ⇒ (2 1 "3") - (-map (-prodfn #'1- #'1+) '((1 2) (3 4) (5 6))) - ⇒ ((0 3) (2 5) (4 7)) - (apply #'+ (funcall (-prodfn #'length #'string-to-number) '((t) "5"))) - ⇒ 6 - - -File: dash.info, Node: Development, Next: FDL, Prev: Functions, Up: Top - -3 Development -************* - -The Dash repository is hosted on GitHub at -. - -* Menu: - -* Contribute:: How to contribute. -* Contributors:: List of contributors. - - -File: dash.info, Node: Contribute, Next: Contributors, Up: Development - -3.1 Contribute -============== - -Yes, please do. Pure functions in the list manipulation realm only, -please. There’s a suite of examples/tests in ‘dev/examples.el’, so -remember to add tests for your additions, or they may get broken later. - - Run the tests with ‘make check’. Regenerate the docs with ‘make -docs’. Contributors are encouraged to install these commands as a Git -pre-commit hook, so that the tests are always running and the docs are -always in sync: - - $ cp dev/pre-commit.sh .git/hooks/pre-commit - - Oh, and don’t edit ‘README.md’ or ‘dash.texi’ directly, as they are -auto-generated. Instead, change their respective templates -‘readme-template.md’ or ‘dash-template.texi’. - - To ensure that Dash can be distributed with GNU ELPA or Emacs, we -require that all contributors assign copyright to the Free Software -Foundation. For more on this, *note (emacs)Copyright Assignment::. - - -File: dash.info, Node: Contributors, Prev: Contribute, Up: Development - -3.2 Contributors -================ - - • Matus Goljer (https://github.com/Fuco1) contributed lots of - features and functions. - • Takafumi Arakaki (https://github.com/tkf) contributed ‘-group-by’. - • tali713 (https://github.com/tali713) is the author of ‘-applify’. - • Víctor M. Valenzuela (https://github.com/vemv) contributed - ‘-repeat’. - • Nic Ferrier (https://github.com/nicferrier) contributed ‘-cons*’. - • Wilfred Hughes (https://github.com/Wilfred) contributed ‘-slice’, - ‘-first-item’, and ‘-last-item’. - • Emanuel Evans (https://github.com/shosti) contributed ‘-if-let’, - ‘-when-let’, and ‘-insert-at’. - • Johan Andersson (https://github.com/rejeep) contributed ‘-sum’, - ‘-product’, and ‘-same-items?’. - • Christina Whyte (https://github.com/kurisuwhyte) contributed - ‘-compose’. - • Steve Lamb (https://github.com/steventlamb) contributed ‘-cycle’, - ‘-pad’, ‘-annotate’, ‘-zip-fill’, and a variadic version of ‘-zip’. - • Fredrik Bergroth (https://github.com/fbergroth) made the ‘-if-let’ - family use ‘-let’ destructuring and improved the script for - generating documentation. - • Mark Oteiza (https://github.com/holomorph) contributed ‘-iota’ and - the script to create an Info manual. - • Vasilij Schneidermann (https://github.com/wasamasa) contributed - ‘-some’. - • William West (https://github.com/occidens) made ‘-fixfn’ more - robust at handling floats. - • Cam Saul (https://github.com/camsaul) contributed ‘-some->’, - ‘-some->>’, and ‘-some-->’. - • Basil L. Contovounesios (https://github.com/basil-conto) - contributed ‘-common-prefix’, ‘-common-suffix’, and various other - improvements. - • Paul Pogonyshev (https://github.com/doublep) contributed ‘-each-r’ - and ‘-each-r-while’. - - Thanks! - - New contributors are very welcome. *Note Contribute::. - - -File: dash.info, Node: FDL, Next: GPL, Prev: Development, Up: Top - -Appendix A GNU Free Documentation License -***************************************** - - Version 1.3, 3 November 2008 - - Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - 0. PREAMBLE - - The purpose of this License is to make a manual, textbook, or other - functional and useful document “free” in the sense of freedom: to - assure everyone the effective freedom to copy and redistribute it, - with or without modifying it, either commercially or - noncommercially. Secondarily, this License preserves for the - author and publisher a way to get credit for their work, while not - being considered responsible for modifications made by others. - - This License is a kind of “copyleft”, which means that derivative - works of the document must themselves be free in the same sense. - It complements the GNU General Public License, which is a copyleft - license designed for free software. - - We have designed this License in order to use it for manuals for - free software, because free software needs free documentation: a - free program should come with manuals providing the same freedoms - that the software does. But this License is not limited to - software manuals; it can be used for any textual work, regardless - of subject matter or whether it is published as a printed book. We - recommend this License principally for works whose purpose is - instruction or reference. - - 1. APPLICABILITY AND DEFINITIONS - - This License applies to any manual or other work, in any medium, - that contains a notice placed by the copyright holder saying it can - be distributed under the terms of this License. Such a notice - grants a world-wide, royalty-free license, unlimited in duration, - to use that work under the conditions stated herein. The - “Document”, below, refers to any such manual or work. Any member - of the public is a licensee, and is addressed as “you”. You accept - the license if you copy, modify or distribute the work in a way - requiring permission under copyright law. - - A “Modified Version” of the Document means any work containing the - Document or a portion of it, either copied verbatim, or with - modifications and/or translated into another language. - - A “Secondary Section” is a named appendix or a front-matter section - of the Document that deals exclusively with the relationship of the - publishers or authors of the Document to the Document’s overall - subject (or to related matters) and contains nothing that could - fall directly within that overall subject. (Thus, if the Document - is in part a textbook of mathematics, a Secondary Section may not - explain any mathematics.) The relationship could be a matter of - historical connection with the subject or with related matters, or - of legal, commercial, philosophical, ethical or political position - regarding them. - - The “Invariant Sections” are certain Secondary Sections whose - titles are designated, as being those of Invariant Sections, in the - notice that says that the Document is released under this License. - If a section does not fit the above definition of Secondary then it - is not allowed to be designated as Invariant. The Document may - contain zero Invariant Sections. If the Document does not identify - any Invariant Sections then there are none. - - The “Cover Texts” are certain short passages of text that are - listed, as Front-Cover Texts or Back-Cover Texts, in the notice - that says that the Document is released under this License. A - Front-Cover Text may be at most 5 words, and a Back-Cover Text may - be at most 25 words. - - A “Transparent” copy of the Document means a machine-readable copy, - represented in a format whose specification is available to the - general public, that is suitable for revising the document - straightforwardly with generic text editors or (for images composed - of pixels) generic paint programs or (for drawings) some widely - available drawing editor, and that is suitable for input to text - formatters or for automatic translation to a variety of formats - suitable for input to text formatters. A copy made in an otherwise - Transparent file format whose markup, or absence of markup, has - been arranged to thwart or discourage subsequent modification by - readers is not Transparent. An image format is not Transparent if - used for any substantial amount of text. A copy that is not - “Transparent” is called “Opaque”. - - Examples of suitable formats for Transparent copies include plain - ASCII without markup, Texinfo input format, LaTeX input format, - SGML or XML using a publicly available DTD, and standard-conforming - simple HTML, PostScript or PDF designed for human modification. - Examples of transparent image formats include PNG, XCF and JPG. - Opaque formats include proprietary formats that can be read and - edited only by proprietary word processors, SGML or XML for which - the DTD and/or processing tools are not generally available, and - the machine-generated HTML, PostScript or PDF produced by some word - processors for output purposes only. - - The “Title Page” means, for a printed book, the title page itself, - plus such following pages as are needed to hold, legibly, the - material this License requires to appear in the title page. For - works in formats which do not have any title page as such, “Title - Page” means the text near the most prominent appearance of the - work’s title, preceding the beginning of the body of the text. - - The “publisher” means any person or entity that distributes copies - of the Document to the public. - - A section “Entitled XYZ” means a named subunit of the Document - whose title either is precisely XYZ or contains XYZ in parentheses - following text that translates XYZ in another language. (Here XYZ - stands for a specific section name mentioned below, such as - “Acknowledgements”, “Dedications”, “Endorsements”, or “History”.) - To “Preserve the Title” of such a section when you modify the - Document means that it remains a section “Entitled XYZ” according - to this definition. - - The Document may include Warranty Disclaimers next to the notice - which states that this License applies to the Document. These - Warranty Disclaimers are considered to be included by reference in - this License, but only as regards disclaiming warranties: any other - implication that these Warranty Disclaimers may have is void and - has no effect on the meaning of this License. - - 2. VERBATIM COPYING - - You may copy and distribute the Document in any medium, either - commercially or noncommercially, provided that this License, the - copyright notices, and the license notice saying this License - applies to the Document are reproduced in all copies, and that you - add no other conditions whatsoever to those of this License. You - may not use technical measures to obstruct or control the reading - or further copying of the copies you make or distribute. However, - you may accept compensation in exchange for copies. If you - distribute a large enough number of copies you must also follow the - conditions in section 3. - - You may also lend copies, under the same conditions stated above, - and you may publicly display copies. - - 3. COPYING IN QUANTITY - - If you publish printed copies (or copies in media that commonly - have printed covers) of the Document, numbering more than 100, and - the Document’s license notice requires Cover Texts, you must - enclose the copies in covers that carry, clearly and legibly, all - these Cover Texts: Front-Cover Texts on the front cover, and - Back-Cover Texts on the back cover. Both covers must also clearly - and legibly identify you as the publisher of these copies. The - front cover must present the full title with all words of the title - equally prominent and visible. You may add other material on the - covers in addition. Copying with changes limited to the covers, as - long as they preserve the title of the Document and satisfy these - conditions, can be treated as verbatim copying in other respects. - - If the required texts for either cover are too voluminous to fit - legibly, you should put the first ones listed (as many as fit - reasonably) on the actual cover, and continue the rest onto - adjacent pages. - - If you publish or distribute Opaque copies of the Document - numbering more than 100, you must either include a machine-readable - Transparent copy along with each Opaque copy, or state in or with - each Opaque copy a computer-network location from which the general - network-using public has access to download using public-standard - network protocols a complete Transparent copy of the Document, free - of added material. If you use the latter option, you must take - reasonably prudent steps, when you begin distribution of Opaque - copies in quantity, to ensure that this Transparent copy will - remain thus accessible at the stated location until at least one - year after the last time you distribute an Opaque copy (directly or - through your agents or retailers) of that edition to the public. - - It is requested, but not required, that you contact the authors of - the Document well before redistributing any large number of copies, - to give them a chance to provide you with an updated version of the - Document. - - 4. MODIFICATIONS - - You may copy and distribute a Modified Version of the Document - under the conditions of sections 2 and 3 above, provided that you - release the Modified Version under precisely this License, with the - Modified Version filling the role of the Document, thus licensing - distribution and modification of the Modified Version to whoever - possesses a copy of it. In addition, you must do these things in - the Modified Version: - - A. Use in the Title Page (and on the covers, if any) a title - distinct from that of the Document, and from those of previous - versions (which should, if there were any, be listed in the - History section of the Document). You may use the same title - as a previous version if the original publisher of that - version gives permission. - - B. List on the Title Page, as authors, one or more persons or - entities responsible for authorship of the modifications in - the Modified Version, together with at least five of the - principal authors of the Document (all of its principal - authors, if it has fewer than five), unless they release you - from this requirement. - - C. State on the Title page the name of the publisher of the - Modified Version, as the publisher. - - D. Preserve all the copyright notices of the Document. - - E. Add an appropriate copyright notice for your modifications - adjacent to the other copyright notices. - - F. Include, immediately after the copyright notices, a license - notice giving the public permission to use the Modified - Version under the terms of this License, in the form shown in - the Addendum below. - - G. Preserve in that license notice the full lists of Invariant - Sections and required Cover Texts given in the Document’s - license notice. - - H. Include an unaltered copy of this License. - - I. Preserve the section Entitled “History”, Preserve its Title, - and add to it an item stating at least the title, year, new - authors, and publisher of the Modified Version as given on the - Title Page. If there is no section Entitled “History” in the - Document, create one stating the title, year, authors, and - publisher of the Document as given on its Title Page, then add - an item describing the Modified Version as stated in the - previous sentence. - - J. Preserve the network location, if any, given in the Document - for public access to a Transparent copy of the Document, and - likewise the network locations given in the Document for - previous versions it was based on. These may be placed in the - “History” section. You may omit a network location for a work - that was published at least four years before the Document - itself, or if the original publisher of the version it refers - to gives permission. - - K. For any section Entitled “Acknowledgements” or “Dedications”, - Preserve the Title of the section, and preserve in the section - all the substance and tone of each of the contributor - acknowledgements and/or dedications given therein. - - L. Preserve all the Invariant Sections of the Document, unaltered - in their text and in their titles. Section numbers or the - equivalent are not considered part of the section titles. - - M. Delete any section Entitled “Endorsements”. Such a section - may not be included in the Modified Version. - - N. Do not retitle any existing section to be Entitled - “Endorsements” or to conflict in title with any Invariant - Section. - - O. Preserve any Warranty Disclaimers. - - If the Modified Version includes new front-matter sections or - appendices that qualify as Secondary Sections and contain no - material copied from the Document, you may at your option designate - some or all of these sections as invariant. To do this, add their - titles to the list of Invariant Sections in the Modified Version’s - license notice. These titles must be distinct from any other - section titles. - - You may add a section Entitled “Endorsements”, provided it contains - nothing but endorsements of your Modified Version by various - parties—for example, statements of peer review or that the text has - been approved by an organization as the authoritative definition of - a standard. - - You may add a passage of up to five words as a Front-Cover Text, - and a passage of up to 25 words as a Back-Cover Text, to the end of - the list of Cover Texts in the Modified Version. Only one passage - of Front-Cover Text and one of Back-Cover Text may be added by (or - through arrangements made by) any one entity. If the Document - already includes a cover text for the same cover, previously added - by you or by arrangement made by the same entity you are acting on - behalf of, you may not add another; but you may replace the old - one, on explicit permission from the previous publisher that added - the old one. - - The author(s) and publisher(s) of the Document do not by this - License give permission to use their names for publicity for or to - assert or imply endorsement of any Modified Version. - - 5. COMBINING DOCUMENTS - - You may combine the Document with other documents released under - this License, under the terms defined in section 4 above for - modified versions, provided that you include in the combination all - of the Invariant Sections of all of the original documents, - unmodified, and list them all as Invariant Sections of your - combined work in its license notice, and that you preserve all - their Warranty Disclaimers. - - The combined work need only contain one copy of this License, and - multiple identical Invariant Sections may be replaced with a single - copy. If there are multiple Invariant Sections with the same name - but different contents, make the title of each such section unique - by adding at the end of it, in parentheses, the name of the - original author or publisher of that section if known, or else a - unique number. Make the same adjustment to the section titles in - the list of Invariant Sections in the license notice of the - combined work. - - In the combination, you must combine any sections Entitled - “History” in the various original documents, forming one section - Entitled “History”; likewise combine any sections Entitled - “Acknowledgements”, and any sections Entitled “Dedications”. You - must delete all sections Entitled “Endorsements.” - - 6. COLLECTIONS OF DOCUMENTS - - You may make a collection consisting of the Document and other - documents released under this License, and replace the individual - copies of this License in the various documents with a single copy - that is included in the collection, provided that you follow the - rules of this License for verbatim copying of each of the documents - in all other respects. - - You may extract a single document from such a collection, and - distribute it individually under this License, provided you insert - a copy of this License into the extracted document, and follow this - License in all other respects regarding verbatim copying of that - document. - - 7. AGGREGATION WITH INDEPENDENT WORKS - - A compilation of the Document or its derivatives with other - separate and independent documents or works, in or on a volume of a - storage or distribution medium, is called an “aggregate” if the - copyright resulting from the compilation is not used to limit the - legal rights of the compilation’s users beyond what the individual - works permit. When the Document is included in an aggregate, this - License does not apply to the other works in the aggregate which - are not themselves derivative works of the Document. - - If the Cover Text requirement of section 3 is applicable to these - copies of the Document, then if the Document is less than one half - of the entire aggregate, the Document’s Cover Texts may be placed - on covers that bracket the Document within the aggregate, or the - electronic equivalent of covers if the Document is in electronic - form. Otherwise they must appear on printed covers that bracket - the whole aggregate. - - 8. TRANSLATION - - Translation is considered a kind of modification, so you may - distribute translations of the Document under the terms of section - 4. Replacing Invariant Sections with translations requires special - permission from their copyright holders, but you may include - translations of some or all Invariant Sections in addition to the - original versions of these Invariant Sections. You may include a - translation of this License, and all the license notices in the - Document, and any Warranty Disclaimers, provided that you also - include the original English version of this License and the - original versions of those notices and disclaimers. In case of a - disagreement between the translation and the original version of - this License or a notice or disclaimer, the original version will - prevail. - - If a section in the Document is Entitled “Acknowledgements”, - “Dedications”, or “History”, the requirement (section 4) to - Preserve its Title (section 1) will typically require changing the - actual title. - - 9. TERMINATION - - You may not copy, modify, sublicense, or distribute the Document - except as expressly provided under this License. Any attempt - otherwise to copy, modify, sublicense, or distribute it is void, - and will automatically terminate your rights under this License. - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, receipt of a copy of some or all of the - same material does not give you any rights to use it. - - 10. FUTURE REVISIONS OF THIS LICENSE - - The Free Software Foundation may publish new, revised versions of - the GNU Free Documentation License from time to time. Such new - versions will be similar in spirit to the present version, but may - differ in detail to address new problems or concerns. See - . - - Each version of the License is given a distinguishing version - number. If the Document specifies that a particular numbered - version of this License “or any later version” applies to it, you - have the option of following the terms and conditions either of - that specified version or of any later version that has been - published (not as a draft) by the Free Software Foundation. If the - Document does not specify a version number of this License, you may - choose any version ever published (not as a draft) by the Free - Software Foundation. If the Document specifies that a proxy can - decide which future versions of this License can be used, that - proxy’s public statement of acceptance of a version permanently - authorizes you to choose that version for the Document. - - 11. RELICENSING - - “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any - World Wide Web server that publishes copyrightable works and also - provides prominent facilities for anybody to edit those works. A - public wiki that anybody can edit is an example of such a server. - A “Massive Multiauthor Collaboration” (or “MMC”) contained in the - site means any set of copyrightable works thus published on the MMC - site. - - “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 - license published by Creative Commons Corporation, a not-for-profit - corporation with a principal place of business in San Francisco, - California, as well as future copyleft versions of that license - published by that same organization. - - “Incorporate” means to publish or republish a Document, in whole or - in part, as part of another Document. - - An MMC is “eligible for relicensing” if it is licensed under this - License, and if all works that were first published under this - License somewhere other than this MMC, and subsequently - incorporated in whole or in part into the MMC, (1) had no cover - texts or invariant sections, and (2) were thus incorporated prior - to November 1, 2008. - - The operator of an MMC Site may republish an MMC contained in the - site under CC-BY-SA on the same site at any time before August 1, - 2009, provided the MMC is eligible for relicensing. - -ADDENDUM: How to use this License for your documents -==================================================== - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and license -notices just after the title page: - - Copyright (C) YEAR YOUR NAME. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. - - If you have Invariant Sections, Front-Cover Texts and Back-Cover -Texts, replace the “with...Texts.” line with this: - - with the Invariant Sections being LIST THEIR TITLES, with - the Front-Cover Texts being LIST, and with the Back-Cover Texts - being LIST. - - If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - - If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of free -software license, such as the GNU General Public License, to permit -their use in free software. - - -File: dash.info, Node: GPL, Next: Index, Prev: FDL, Up: Top - -Appendix B GNU General Public License -************************************* - - Version 3, 29 June 2007 - - Copyright © 2007 Free Software Foundation, Inc. - - Everyone is permitted to copy and distribute verbatim copies of this - license document, but changing it is not allowed. - -Preamble -======== - -The GNU General Public License is a free, copyleft license for software -and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program—to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers’ and authors’ protection, the GPL clearly explains -that there is no warranty for this free software. For both users’ and -authors’ sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users’ freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS -==================== - - 0. Definitions. - - “This License” refers to version 3 of the GNU General Public - License. - - “Copyright” also means copyright-like laws that apply to other - kinds of works, such as semiconductor masks. - - “The Program” refers to any copyrightable work licensed under this - License. Each licensee is addressed as “you”. “Licensees” and - “recipients” may be individuals or organizations. - - To “modify” a work means to copy from or adapt all or part of the - work in a fashion requiring copyright permission, other than the - making of an exact copy. The resulting work is called a “modified - version” of the earlier work or a work “based on” the earlier work. - - A “covered work” means either the unmodified Program or a work - based on the Program. - - To “propagate” a work means to do anything with it that, without - permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it on - a computer or modifying a private copy. Propagation includes - copying, distribution (with or without modification), making - available to the public, and in some countries other activities as - well. - - To “convey” a work means any kind of propagation that enables other - parties to make or receive copies. Mere interaction with a user - through a computer network, with no transfer of a copy, is not - conveying. - - An interactive user interface displays “Appropriate Legal Notices” - to the extent that it includes a convenient and prominently visible - feature that (1) displays an appropriate copyright notice, and (2) - tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may convey - the work under this License, and how to view a copy of this - License. If the interface presents a list of user commands or - options, such as a menu, a prominent item in the list meets this - criterion. - - 1. Source Code. - - The “source code” for a work means the preferred form of the work - for making modifications to it. “Object code” means any non-source - form of a work. - - A “Standard Interface” means an interface that either is an - official standard defined by a recognized standards body, or, in - the case of interfaces specified for a particular programming - language, one that is widely used among developers working in that - language. - - The “System Libraries” of an executable work include anything, - other than the work as a whole, that (a) is included in the normal - form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work with - that Major Component, or to implement a Standard Interface for - which an implementation is available to the public in source code - form. A “Major Component”, in this context, means a major - essential component (kernel, window system, and so on) of the - specific operating system (if any) on which the executable work - runs, or a compiler used to produce the work, or an object code - interpreter used to run it. - - The “Corresponding Source” for a work in object code form means all - the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including scripts - to control those activities. However, it does not include the - work’s System Libraries, or general-purpose tools or generally - available free programs which are used unmodified in performing - those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files associated - with source files for the work, and the source code for shared - libraries and dynamically linked subprograms that the work is - specifically designed to require, such as by intimate data - communication or control flow between those subprograms and other - parts of the work. - - The Corresponding Source need not include anything that users can - regenerate automatically from other parts of the Corresponding - Source. - - The Corresponding Source for a work in source code form is that - same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of - copyright on the Program, and are irrevocable provided the stated - conditions are met. This License explicitly affirms your unlimited - permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, given - its content, constitutes a covered work. This License acknowledges - your rights of fair use or other equivalent, as provided by - copyright law. - - You may make, run and propagate covered works that you do not - convey, without conditions so long as your license otherwise - remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for you, - or provide you with facilities for running those works, provided - that you comply with the terms of this License in conveying all - material for which you do not control copyright. Those thus making - or running the covered works for you must do so exclusively on your - behalf, under your direction and control, on terms that prohibit - them from making any copies of your copyrighted material outside - their relationship with you. - - Conveying under any other circumstances is permitted solely under - the conditions stated below. Sublicensing is not allowed; section - 10 makes it unnecessary. - - 3. Protecting Users’ Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological - measure under any applicable law fulfilling obligations under - article 11 of the WIPO copyright treaty adopted on 20 December - 1996, or similar laws prohibiting or restricting circumvention of - such measures. - - When you convey a covered work, you waive any legal power to forbid - circumvention of technological measures to the extent such - circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention to - limit operation or modification of the work as a means of - enforcing, against the work’s users, your or third parties’ legal - rights to forbid circumvention of technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program’s source code as you - receive it, in any medium, provided that you conspicuously and - appropriately publish on each copy an appropriate copyright notice; - keep intact all notices stating that this License and any - non-permissive terms added in accord with section 7 apply to the - code; keep intact all notices of the absence of any warranty; and - give all recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, - and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to - produce it from the Program, in the form of source code under the - terms of section 4, provided that you also meet all of these - conditions: - - a. The work must carry prominent notices stating that you - modified it, and giving a relevant date. - - b. The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in - section 4 to “keep intact all notices”. - - c. You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable - section 7 additional terms, to the whole of the work, and all - its parts, regardless of how they are packaged. This License - gives no permission to license the work in any other way, but - it does not invalidate such permission if you have separately - received it. - - d. If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has - interactive interfaces that do not display Appropriate Legal - Notices, your work need not make them do so. - - A compilation of a covered work with other separate and independent - works, which are not by their nature extensions of the covered - work, and which are not combined with it such as to form a larger - program, in or on a volume of a storage or distribution medium, is - called an “aggregate” if the compilation and its resulting - copyright are not used to limit the access or legal rights of the - compilation’s users beyond what the individual works permit. - Inclusion of a covered work in an aggregate does not cause this - License to apply to the other parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms - of sections 4 and 5, provided that you also convey the - machine-readable Corresponding Source under the terms of this - License, in one of these ways: - - a. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that - product model, to give anyone who possesses the object code - either (1) a copy of the Corresponding Source for all the - software in the product that is covered by this License, on a - durable physical medium customarily used for software - interchange, for a price no more than your reasonable cost of - physically performing this conveying of source, or (2) access - to copy the Corresponding Source from a network server at no - charge. - - c. Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, - and only if you received the object code with such an offer, - in accord with subsection 6b. - - d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to - the Corresponding Source in the same way through the same - place at no further charge. You need not require recipients - to copy the Corresponding Source along with the object code. - If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated by - you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to the - object code saying where to find the Corresponding Source. - Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long as - needed to satisfy these requirements. - - e. Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the - general public at no charge under subsection 6d. - - A separable portion of the object code, whose source code is - excluded from the Corresponding Source as a System Library, need - not be included in conveying the object code work. - - A “User Product” is either (1) a “consumer product”, which means - any tangible personal property which is normally used for personal, - family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product is - a consumer product, doubtful cases shall be resolved in favor of - coverage. For a particular product received by a particular user, - “normally used” refers to a typical or common use of that class of - product, regardless of the status of the particular user or of the - way in which the particular user actually uses, or expects or is - expected to use, the product. A product is a consumer product - regardless of whether the product has substantial commercial, - industrial or non-consumer uses, unless such uses represent the - only significant mode of use of the product. - - “Installation Information” for a User Product means any methods, - procedures, authorization keys, or other information required to - install and execute modified versions of a covered work in that - User Product from a modified version of its Corresponding Source. - The information must suffice to ensure that the continued - functioning of the modified object code is in no case prevented or - interfered with solely because modification has been made. - - If you convey an object code work under this section in, or with, - or specifically for use in, a User Product, and the conveying - occurs as part of a transaction in which the right of possession - and use of the User Product is transferred to the recipient in - perpetuity or for a fixed term (regardless of how the transaction - is characterized), the Corresponding Source conveyed under this - section must be accompanied by the Installation Information. But - this requirement does not apply if neither you nor any third party - retains the ability to install modified object code on the User - Product (for example, the work has been installed in ROM). - - The requirement to provide Installation Information does not - include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or installed - by the recipient, or for the User Product in which it has been - modified or installed. Access to a network may be denied when the - modification itself materially and adversely affects the operation - of the network or violates the rules and protocols for - communication across the network. - - Corresponding Source conveyed, and Installation Information - provided, in accord with this section must be in a format that is - publicly documented (and with an implementation available to the - public in source code form), and must require no special password - or key for unpacking, reading or copying. - - 7. Additional Terms. - - “Additional permissions” are terms that supplement the terms of - this License by making exceptions from one or more of its - conditions. Additional permissions that are applicable to the - entire Program shall be treated as though they were included in - this License, to the extent that they are valid under applicable - law. If additional permissions apply only to part of the Program, - that part may be used separately under those permissions, but the - entire Program remains governed by this License without regard to - the additional permissions. - - When you convey a copy of a covered work, you may at your option - remove any additional permissions from that copy, or from any part - of it. (Additional permissions may be written to require their own - removal in certain cases when you modify the work.) You may place - additional permissions on material, added by you to a covered work, - for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material - you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License with - terms: - - a. Disclaiming warranty or limiting liability differently from - the terms of sections 15 and 16 of this License; or - - b. Requiring preservation of specified reasonable legal notices - or author attributions in that material or in the Appropriate - Legal Notices displayed by works containing it; or - - c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked - in reasonable ways as different from the original version; or - - d. Limiting the use for publicity purposes of names of licensors - or authors of the material; or - - e. Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f. Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified - versions of it) with contractual assumptions of liability to - the recipient, for any liability that these contractual - assumptions directly impose on those licensors and authors. - - All other non-permissive additional terms are considered “further - restrictions” within the meaning of section 10. If the Program as - you received it, or any part of it, contains a notice stating that - it is governed by this License along with a term that is a further - restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or conveying - under this License, you may add to a covered work material governed - by the terms of that license document, provided that the further - restriction does not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you - must place, in the relevant source files, a statement of the - additional terms that apply to those files, or a notice indicating - where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in - the form of a separately written license, or stated as exceptions; - the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly - provided under this License. Any attempt otherwise to propagate or - modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under the - third paragraph of section 11). - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, you do not qualify to receive new licenses - for the same material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or - run a copy of the Program. Ancillary propagation of a covered work - occurring solely as a consequence of using peer-to-peer - transmission to receive a copy likewise does not require - acceptance. However, nothing other than this License grants you - permission to propagate or modify any covered work. These actions - infringe copyright if you do not accept this License. Therefore, - by modifying or propagating a covered work, you indicate your - acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically - receives a license from the original licensors, to run, modify and - propagate that work, subject to this License. You are not - responsible for enforcing compliance by third parties with this - License. - - An “entity transaction” is a transaction transferring control of an - organization, or substantially all assets of one, or subdividing an - organization, or merging organizations. If propagation of a - covered work results from an entity transaction, each party to that - transaction who receives a copy of the work also receives whatever - licenses to the work the party’s predecessor in interest had or - could give under the previous paragraph, plus a right to possession - of the Corresponding Source of the work from the predecessor in - interest, if the predecessor has it or can get it with reasonable - efforts. - - You may not impose any further restrictions on the exercise of the - rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for exercise - of rights granted under this License, and you may not initiate - litigation (including a cross-claim or counterclaim in a lawsuit) - alleging that any patent claim is infringed by making, using, - selling, offering for sale, or importing the Program or any portion - of it. - - 11. Patents. - - A “contributor” is a copyright holder who authorizes use under this - License of the Program or a work on which the Program is based. - The work thus licensed is called the contributor’s “contributor - version”. - - A contributor’s “essential patent claims” are all patent claims - owned or controlled by the contributor, whether already acquired or - hereafter acquired, that would be infringed by some manner, - permitted by this License, of making, using, or selling its - contributor version, but do not include claims that would be - infringed only as a consequence of further modification of the - contributor version. For purposes of this definition, “control” - includes the right to grant patent sublicenses in a manner - consistent with the requirements of this License. - - Each contributor grants you a non-exclusive, worldwide, - royalty-free patent license under the contributor’s essential - patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its contributor - version. - - In the following three paragraphs, a “patent license” is any - express agreement or commitment, however denominated, not to - enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To “grant” - such a patent license to a party means to make such an agreement or - commitment not to enforce a patent against the party. - - If you convey a covered work, knowingly relying on a patent - license, and the Corresponding Source of the work is not available - for anyone to copy, free of charge and under the terms of this - License, through a publicly available network server or other - readily accessible means, then you must either (1) cause the - Corresponding Source to be so available, or (2) arrange to deprive - yourself of the benefit of the patent license for this particular - work, or (3) arrange, in a manner consistent with the requirements - of this License, to extend the patent license to downstream - recipients. “Knowingly relying” means you have actual knowledge - that, but for the patent license, your conveying the covered work - in a country, or your recipient’s use of the covered work in a - country, would infringe one or more identifiable patents in that - country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or - arrangement, you convey, or propagate by procuring conveyance of, a - covered work, and grant a patent license to some of the parties - receiving the covered work authorizing them to use, propagate, - modify or convey a specific copy of the covered work, then the - patent license you grant is automatically extended to all - recipients of the covered work and works based on it. - - A patent license is “discriminatory” if it does not include within - the scope of its coverage, prohibits the exercise of, or is - conditioned on the non-exercise of one or more of the rights that - are specifically granted under this License. You may not convey a - covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under which - you make payment to the third party based on the extent of your - activity of conveying the work, and under which the third party - grants, to any of the parties who would receive the covered work - from you, a discriminatory patent license (a) in connection with - copies of the covered work conveyed by you (or copies made from - those copies), or (b) primarily for and in connection with specific - products or compilations that contain the covered work, unless you - entered into that arrangement, or that patent license was granted, - prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting - any implied license or other defenses to infringement that may - otherwise be available to you under applicable patent law. - - 12. No Surrender of Others’ Freedom. - - If conditions are imposed on you (whether by court order, agreement - or otherwise) that contradict the conditions of this License, they - do not excuse you from the conditions of this License. If you - cannot convey a covered work so as to satisfy simultaneously your - obligations under this License and any other pertinent obligations, - then as a consequence you may not convey it at all. For example, - if you agree to terms that obligate you to collect a royalty for - further conveying from those to whom you convey the Program, the - only way you could satisfy both those terms and this License would - be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have - permission to link or combine any covered work with a work licensed - under version 3 of the GNU Affero General Public License into a - single combined work, and to convey the resulting work. The terms - of this License will continue to apply to the part which is the - covered work, but the special requirements of the GNU Affero - General Public License, section 13, concerning interaction through - a network will apply to the combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. Such - new versions will be similar in spirit to the present version, but - may differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the - Program specifies that a certain numbered version of the GNU - General Public License “or any later version” applies to it, you - have the option of following the terms and conditions either of - that numbered version or of any later version published by the Free - Software Foundation. If the Program does not specify a version - number of the GNU General Public License, you may choose any - version ever published by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future - versions of the GNU General Public License can be used, that - proxy’s public statement of acceptance of a version permanently - authorizes you to choose that version for the Program. - - Later license versions may give you additional or different - permissions. However, no additional obligations are imposed on any - author or copyright holder as a result of your choosing to follow a - later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE - COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE - RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. - SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN - WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR - DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE - THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA - BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD - PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER - PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF - THE POSSIBILITY OF SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided - above cannot be given local legal effect according to their terms, - reviewing courts shall apply local law that most closely - approximates an absolute waiver of all civil liability in - connection with the Program, unless a warranty or assumption of - liability accompanies a copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS -=========================== - -How to Apply These Terms to Your New Programs -============================================= - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least the -“copyright” line and a pointer to where the full notice is found. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. - Copyright (C) YEAR NAME OF AUTHOR - - This program 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. - - This program 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 this program. If not, see . - - Also add information on how to contact you by electronic and paper -mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type ‘show w’. - This is free software, and you are welcome to redistribute it - under certain conditions; type ‘show c’ for details. - - The hypothetical commands ‘show w’ and ‘show c’ should show the -appropriate parts of the General Public License. Of course, your -program’s commands might be different; for a GUI interface, you would -use an “about box”. - - You should also get your employer (if you work as a programmer) or -school, if any, to sign a “copyright disclaimer” for the program, if -necessary. For more information on this, and how to apply and follow -the GNU GPL, see . - - The GNU General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Lesser General Public License instead of this License. But first, -please read . - - -File: dash.info, Node: Index, Prev: GPL, Up: Top - -Index -***** - -[index] -* Menu: - -* !cdr: Destructive operations. - (line 16) -* !cons: Destructive operations. - (line 8) -* -->: Threading macros. (line 35) -* ->: Threading macros. (line 9) -* ->>: Threading macros. (line 22) -* -all?: Predicates. (line 53) -* -andfn: Function combinators. - (line 184) -* -annotate: Maps. (line 86) -* -any?: Predicates. (line 41) -* -applify: Function combinators. - (line 63) -* -as->: Threading macros. (line 49) -* -butlast: Other list operations. - (line 405) -* -clone: Tree operations. (line 123) -* -common-prefix: Reductions. (line 242) -* -common-suffix: Reductions. (line 252) -* -compose: Function combinators. - (line 49) -* -concat: List to list. (line 23) -* -cons*: Other list operations. - (line 19) -* -cons-pair?: Predicates. (line 154) -* -const: Function combinators. - (line 128) -* -contains?: Predicates. (line 100) -* -copy: Maps. (line 151) -* -count: Reductions. (line 172) -* -cut: Function combinators. - (line 140) -* -cycle: Unfolding. (line 55) -* -difference: Set operations. (line 22) -* -distinct: Set operations. (line 73) -* -dotimes: Side effects. (line 80) -* -doto: Threading macros. (line 99) -* -drop: Sublist selection. (line 149) -* -drop-last: Sublist selection. (line 163) -* -drop-while: Sublist selection. (line 194) -* -each: Side effects. (line 8) -* -each-indexed: Side effects. (line 38) -* -each-r: Side effects. (line 52) -* -each-r-while: Side effects. (line 65) -* -each-while: Side effects. (line 24) -* -elem-index: Indexing. (line 9) -* -elem-indices: Indexing. (line 23) -* -every: Predicates. (line 23) -* -fifth-item: Other list operations. - (line 380) -* -filter: Sublist selection. (line 8) -* -find-index: Indexing. (line 35) -* -find-indices: Indexing. (line 73) -* -find-last-index: Indexing. (line 54) -* -first: Other list operations. - (line 300) -* -first-item: Other list operations. - (line 328) -* -fix: Other list operations. - (line 445) -* -fixfn: Function combinators. - (line 224) -* -flatten: List to list. (line 38) -* -flatten-n: List to list. (line 60) -* -flip: Function combinators. - (line 95) -* -fourth-item: Other list operations. - (line 367) -* -frequencies: Reductions. (line 310) -* -grade-down: Indexing. (line 103) -* -grade-up: Indexing. (line 93) -* -group-by: Partitioning. (line 205) -* -if-let: Binding. (line 34) -* -if-let*: Binding. (line 45) -* -inits: Reductions. (line 222) -* -insert-at: List to list. (line 114) -* -interleave: Other list operations. - (line 56) -* -interpose: Other list operations. - (line 46) -* -intersection: Set operations. (line 36) -* -iota: Other list operations. - (line 67) -* -is-infix?: Predicates. (line 140) -* -is-prefix?: Predicates. (line 116) -* -is-suffix?: Predicates. (line 128) -* -iterate: Unfolding. (line 9) -* -iteratefn: Function combinators. - (line 201) -* -juxt: Function combinators. - (line 37) -* -keep: List to list. (line 8) -* -lambda: Binding. (line 247) -* -last: Other list operations. - (line 318) -* -last-item: Other list operations. - (line 393) -* -let: Binding. (line 61) -* -let*: Binding. (line 227) -* -list: Other list operations. - (line 428) -* -map: Maps. (line 10) -* -map-first: Maps. (line 38) -* -map-indexed: Maps. (line 68) -* -map-last: Maps. (line 53) -* -map-when: Maps. (line 22) -* -mapcat: Maps. (line 140) -* -max: Reductions. (line 286) -* -max-by: Reductions. (line 296) -* -min: Reductions. (line 262) -* -min-by: Reductions. (line 272) -* -non-nil: Sublist selection. (line 95) -* -none?: Predicates. (line 73) -* -not: Function combinators. - (line 153) -* -on: Function combinators. - (line 75) -* -only-some?: Predicates. (line 85) -* -orfn: Function combinators. - (line 167) -* -pad: Other list operations. - (line 241) -* -partial: Function combinators. - (line 8) -* -partition: Partitioning. (line 90) -* -partition-after-item: Partitioning. (line 195) -* -partition-after-pred: Partitioning. (line 162) -* -partition-all: Partitioning. (line 102) -* -partition-all-in-steps: Partitioning. (line 126) -* -partition-before-item: Partitioning. (line 185) -* -partition-before-pred: Partitioning. (line 174) -* -partition-by: Partitioning. (line 138) -* -partition-by-header: Partitioning. (line 149) -* -partition-in-steps: Partitioning. (line 113) -* -permutations: Set operations. (line 60) -* -powerset: Set operations. (line 50) -* -prodfn: Function combinators. - (line 258) -* -product: Reductions. (line 201) -* -reduce: Reductions. (line 53) -* -reduce-from: Reductions. (line 8) -* -reduce-r: Reductions. (line 72) -* -reduce-r-from: Reductions. (line 26) -* -reductions: Reductions. (line 136) -* -reductions-from: Reductions. (line 100) -* -reductions-r: Reductions. (line 154) -* -reductions-r-from: Reductions. (line 118) -* -remove: Sublist selection. (line 26) -* -remove-at: List to list. (line 151) -* -remove-at-indices: List to list. (line 170) -* -remove-first: Sublist selection. (line 44) -* -remove-item: Sublist selection. (line 84) -* -remove-last: Sublist selection. (line 65) -* -repeat: Unfolding. (line 44) -* -replace: List to list. (line 72) -* -replace-at: List to list. (line 125) -* -replace-first: List to list. (line 86) -* -replace-last: List to list. (line 100) -* -rotate: Other list operations. - (line 8) -* -rotate-args: Function combinators. - (line 112) -* -rpartial: Function combinators. - (line 22) -* -running-product: Reductions. (line 211) -* -running-sum: Reductions. (line 190) -* -same-items?: Set operations. (line 88) -* -second-item: Other list operations. - (line 341) -* -select-by-indices: Sublist selection. (line 211) -* -select-column: Sublist selection. (line 241) -* -select-columns: Sublist selection. (line 222) -* -separate: Partitioning. (line 75) -* -setq: Binding. (line 270) -* -slice: Sublist selection. (line 105) -* -snoc: Other list operations. - (line 32) -* -some: Predicates. (line 8) -* -some-->: Threading macros. (line 86) -* -some->: Threading macros. (line 62) -* -some->>: Threading macros. (line 74) -* -sort: Other list operations. - (line 415) -* -splice: Maps. (line 102) -* -splice-list: Maps. (line 127) -* -split-at: Partitioning. (line 8) -* -split-on: Partitioning. (line 40) -* -split-when: Partitioning. (line 58) -* -split-with: Partitioning. (line 23) -* -sum: Reductions. (line 180) -* -table: Other list operations. - (line 256) -* -table-flat: Other list operations. - (line 275) -* -tails: Reductions. (line 232) -* -take: Sublist selection. (line 121) -* -take-last: Sublist selection. (line 135) -* -take-while: Sublist selection. (line 177) -* -third-item: Other list operations. - (line 354) -* -tree-map: Tree operations. (line 28) -* -tree-map-nodes: Tree operations. (line 39) -* -tree-mapreduce: Tree operations. (line 85) -* -tree-mapreduce-from: Tree operations. (line 104) -* -tree-reduce: Tree operations. (line 53) -* -tree-reduce-from: Tree operations. (line 70) -* -tree-seq: Tree operations. (line 8) -* -unfold: Unfolding. (line 25) -* -union: Set operations. (line 8) -* -unzip: Other list operations. - (line 215) -* -unzip-lists: Other list operations. - (line 196) -* -update-at: List to list. (line 137) -* -when-let: Binding. (line 9) -* -when-let*: Binding. (line 21) -* -zip: Other list operations. - (line 150) -* -zip-fill: Other list operations. - (line 176) -* -zip-lists: Other list operations. - (line 114) -* -zip-lists-fill: Other list operations. - (line 135) -* -zip-pair: Other list operations. - (line 98) -* -zip-with: Other list operations. - (line 80) -* dash-fontify-mode: Fontification of special variables. - (line 6) -* dash-register-info-lookup: Info symbol lookup. (line 6) -* global-dash-fontify-mode: Fontification of special variables. - (line 12) - - - -Tag Table: -Node: Top742 -Node: Installation2397 -Node: Using in a package3159 -Node: Fontification of special variables3504 -Node: Info symbol lookup4294 -Node: Functions4877 -Node: Maps6361 -Ref: -map6658 -Ref: -map-when7031 -Ref: -map-first7605 -Ref: -map-last8200 -Ref: -map-indexed8790 -Ref: -annotate9476 -Ref: -splice10080 -Ref: -splice-list11155 -Ref: -mapcat11614 -Ref: -copy11987 -Node: Sublist selection12175 -Ref: -filter12368 -Ref: -remove12921 -Ref: -remove-first13470 -Ref: -remove-last14318 -Ref: -remove-item15048 -Ref: -non-nil15448 -Ref: -slice15730 -Ref: -take16259 -Ref: -take-last16677 -Ref: -drop17114 -Ref: -drop-last17561 -Ref: -take-while17993 -Ref: -drop-while18620 -Ref: -select-by-indices19253 -Ref: -select-columns19764 -Ref: -select-column20467 -Node: List to list20930 -Ref: -keep21122 -Ref: -concat21698 -Ref: -flatten22226 -Ref: -flatten-n22988 -Ref: -replace23372 -Ref: -replace-first23833 -Ref: -replace-last24328 -Ref: -insert-at24816 -Ref: -replace-at25141 -Ref: -update-at25528 -Ref: -remove-at26069 -Ref: -remove-at-indices26696 -Node: Reductions27386 -Ref: -reduce-from27582 -Ref: -reduce-r-from28306 -Ref: -reduce29569 -Ref: -reduce-r30320 -Ref: -reductions-from31598 -Ref: -reductions-r-from32404 -Ref: -reductions33234 -Ref: -reductions-r33945 -Ref: -count34690 -Ref: -sum34920 -Ref: -running-sum35108 -Ref: -product35429 -Ref: -running-product35637 -Ref: -inits35978 -Ref: -tails36223 -Ref: -common-prefix36468 -Ref: -common-suffix36762 -Ref: -min37056 -Ref: -min-by37282 -Ref: -max37803 -Ref: -max-by38028 -Ref: -frequencies38554 -Node: Unfolding39169 -Ref: -iterate39410 -Ref: -unfold39857 -Ref: -repeat40662 -Ref: -cycle40946 -Node: Predicates41343 -Ref: -some41520 -Ref: -every41949 -Ref: -any?42663 -Ref: -all?43012 -Ref: -none?43754 -Ref: -only-some?44074 -Ref: -contains?44619 -Ref: -is-prefix?45125 -Ref: -is-suffix?45457 -Ref: -is-infix?45789 -Ref: -cons-pair?46149 -Node: Partitioning46480 -Ref: -split-at46668 -Ref: -split-with47332 -Ref: -split-on47972 -Ref: -split-when48643 -Ref: -separate49286 -Ref: -partition49820 -Ref: -partition-all50269 -Ref: -partition-in-steps50694 -Ref: -partition-all-in-steps51240 -Ref: -partition-by51754 -Ref: -partition-by-header52132 -Ref: -partition-after-pred52733 -Ref: -partition-before-pred53186 -Ref: -partition-before-item53571 -Ref: -partition-after-item53878 -Ref: -group-by54180 -Node: Indexing54613 -Ref: -elem-index54815 -Ref: -elem-indices55302 -Ref: -find-index55761 -Ref: -find-last-index56430 -Ref: -find-indices57081 -Ref: -grade-up57843 -Ref: -grade-down58250 -Node: Set operations58664 -Ref: -union58847 -Ref: -difference59277 -Ref: -intersection59705 -Ref: -powerset60134 -Ref: -permutations60411 -Ref: -distinct60849 -Ref: -same-items?61243 -Node: Other list operations61852 -Ref: -rotate62077 -Ref: -cons*62430 -Ref: -snoc62852 -Ref: -interpose63264 -Ref: -interleave63558 -Ref: -iota63924 -Ref: -zip-with64407 -Ref: -zip-pair65215 -Ref: -zip-lists65781 -Ref: -zip-lists-fill66579 -Ref: -zip67289 -Ref: -zip-fill68316 -Ref: -unzip-lists69230 -Ref: -unzip69853 -Ref: -pad70846 -Ref: -table71331 -Ref: -table-flat72117 -Ref: -first73122 -Ref: -last73655 -Ref: -first-item74001 -Ref: -second-item74413 -Ref: -third-item74830 -Ref: -fourth-item75205 -Ref: -fifth-item75583 -Ref: -last-item75958 -Ref: -butlast76319 -Ref: -sort76564 -Ref: -list77058 -Ref: -fix77627 -Node: Tree operations78116 -Ref: -tree-seq78312 -Ref: -tree-map79173 -Ref: -tree-map-nodes79613 -Ref: -tree-reduce80477 -Ref: -tree-reduce-from81359 -Ref: -tree-mapreduce81959 -Ref: -tree-mapreduce-from82818 -Ref: -clone84103 -Node: Threading macros84441 -Ref: ->84666 -Ref: ->>85154 -Ref: -->85657 -Ref: -as->86213 -Ref: -some->86667 -Ref: -some->>87052 -Ref: -some-->87499 -Ref: -doto88066 -Node: Binding88619 -Ref: -when-let88826 -Ref: -when-let*89287 -Ref: -if-let89816 -Ref: -if-let*90182 -Ref: -let90805 -Ref: -let*96895 -Ref: -lambda97832 -Ref: -setq98638 -Node: Side effects99439 -Ref: -each99633 -Ref: -each-while100160 -Ref: -each-indexed100780 -Ref: -each-r101372 -Ref: -each-r-while101814 -Ref: -dotimes102458 -Node: Destructive operations103011 -Ref: !cons103229 -Ref: !cdr103433 -Node: Function combinators103626 -Ref: -partial103830 -Ref: -rpartial104348 -Ref: -juxt104996 -Ref: -compose105448 -Ref: -applify106055 -Ref: -on106485 -Ref: -flip107257 -Ref: -rotate-args107781 -Ref: -const108410 -Ref: -cut108752 -Ref: -not109232 -Ref: -orfn109776 -Ref: -andfn110569 -Ref: -iteratefn111356 -Ref: -fixfn112058 -Ref: -prodfn113632 -Node: Development114783 -Node: Contribute115072 -Node: Contributors116084 -Node: FDL118177 -Node: GPL143497 -Node: Index181246 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/dash-20230502.1324/dir b/elpa/dash-20230502.1324/dir deleted file mode 100644 index 7d473f49..00000000 --- a/elpa/dash-20230502.1324/dir +++ /dev/null @@ -1,18 +0,0 @@ -This is the file .../info/dir, which contains the -topmost node of the Info hierarchy, called (dir)Top. -The first time you invoke Info you start off looking at this node. - -File: dir, Node: Top This is the top of the INFO tree - - This (the Directory node) gives a menu of major topics. - Typing "q" exits, "H" lists all Info commands, "d" returns here, - "h" gives a primer for first-timers, - "mEmacs" visits the Emacs manual, etc. - - In Emacs, you can click mouse button 2 on a menu item or cross reference - to select it. - -* Menu: - -Emacs -* Dash: (dash.info). A modern list library for GNU Emacs. diff --git a/elpa/dash-20230714.723/dash-autoloads.el b/elpa/dash-20230714.723/dash-autoloads.el new file mode 100644 index 00000000..6783a8d0 --- /dev/null +++ b/elpa/dash-20230714.723/dash-autoloads.el @@ -0,0 +1,87 @@ +;;; dash-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "dash" "dash.el" (0 0 0 0)) +;;; Generated autoloads from dash.el + +(autoload 'dash-fontify-mode "dash" "\ +Toggle fontification of Dash special variables. + +This is a minor mode. If called interactively, toggle the +`Dash-Fontify mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `dash-fontify-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +Dash-Fontify mode is a buffer-local minor mode intended for Emacs +Lisp buffers. Enabling it causes the special variables bound in +anaphoric Dash macros to be fontified. These anaphoras include +`it', `it-index', `acc', and `other'. In older Emacs versions +which do not dynamically detect macros, Dash-Fontify mode +additionally fontifies Dash macro calls. + +See also `dash-fontify-mode-lighter' and +`global-dash-fontify-mode'. + +\(fn &optional ARG)" t nil) + +(put 'global-dash-fontify-mode 'globalized-minor-mode t) + +(defvar global-dash-fontify-mode nil "\ +Non-nil if Global Dash-Fontify mode is enabled. +See the `global-dash-fontify-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-dash-fontify-mode'.") + +(custom-autoload 'global-dash-fontify-mode "dash" nil) + +(autoload 'global-dash-fontify-mode "dash" "\ +Toggle Dash-Fontify mode in all buffers. +With prefix ARG, enable Global Dash-Fontify mode if ARG is positive; +otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Dash-Fontify mode is enabled in all buffers where +`dash--turn-on-fontify-mode' would do it. + +See `dash-fontify-mode' for more information on Dash-Fontify mode. + +\(fn &optional ARG)" t nil) + +(autoload 'dash-register-info-lookup "dash" "\ +Register the Dash Info manual with `info-lookup-symbol'. +This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t nil) + +(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-")) + +;;;*** + +;;;### (autoloads nil nil ("dash-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; dash-autoloads.el ends here diff --git a/elpa/dash-20230714.723/dash-pkg.el b/elpa/dash-20230714.723/dash-pkg.el new file mode 100644 index 00000000..e2592b7c --- /dev/null +++ b/elpa/dash-20230714.723/dash-pkg.el @@ -0,0 +1,14 @@ +(define-package "dash" "20230714.723" "A modern list library for Emacs" + '((emacs "24")) + :commit "f46268c75cb7c18361d3cee942cd4dc14a03aef4" :authors + '(("Magnar Sveen" . "magnars@gmail.com")) + :maintainers + '(("Magnar Sveen" . "magnars@gmail.com")) + :maintainer + '("Magnar Sveen" . "magnars@gmail.com") + :keywords + '("extensions" "lisp") + :url "https://github.com/magnars/dash.el") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/dash-20230714.723/dash.el b/elpa/dash-20230714.723/dash.el new file mode 100644 index 00000000..d9007175 --- /dev/null +++ b/elpa/dash-20230714.723/dash.el @@ -0,0 +1,4134 @@ +;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2023 Free Software Foundation, Inc. + +;; Author: Magnar Sveen +;; Version: 2.19.1 +;; Package-Requires: ((emacs "24")) +;; Keywords: extensions, lisp +;; Homepage: https://github.com/magnars/dash.el + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; A modern list API for Emacs. +;; +;; See its overview at https://github.com/magnars/dash.el#functions. + +;;; Code: + +(eval-when-compile + ;; TODO: Emacs 24.3 first introduced `gv', so remove this and all + ;; calls to `defsetf' when support for earlier versions is dropped. + (unless (fboundp 'gv-define-setter) + (require 'cl)) + + ;; - 24.3 started complaining about unknown `declare' props. + ;; - 25 introduced `pure' and `side-effect-free'. + ;; - 30 introduced `important-return-value'. + (when (boundp 'defun-declarations-alist) + (dolist (prop '(important-return-value pure side-effect-free)) + (unless (assq prop defun-declarations-alist) + (push (list prop #'ignore) defun-declarations-alist))))) + +(defgroup dash () + "Customize group for Dash, a modern list library." + :group 'extensions + :group 'lisp + :prefix "dash-") + +(defmacro !cons (car cdr) + "Destructive: Set CDR to the cons of CAR and CDR." + (declare (debug (form symbolp))) + `(setq ,cdr (cons ,car ,cdr))) + +(defmacro !cdr (list) + "Destructive: Set LIST to the cdr of LIST." + (declare (debug (symbolp))) + `(setq ,list (cdr ,list))) + +(defmacro --each (list &rest body) + "Evaluate BODY for each element of LIST and return nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating BODY. +This is the anaphoric counterpart to `-each'." + (declare (debug (form body)) (indent 1)) + (let ((l (make-symbol "list")) + (i (make-symbol "i"))) + `(let ((,l ,list) + (,i 0)) + (while ,l + (let ((it (pop ,l)) (it-index ,i)) + (ignore it it-index) + ,@body) + (setq ,i (1+ ,i)))))) + +(defun -each (list fn) + "Call FN on each element of LIST. +Return nil; this function is intended for side effects. + +Its anaphoric counterpart is `--each'. + +For access to the current element's index in LIST, see +`-each-indexed'." + (declare (indent 1)) + (ignore (mapc fn list))) + +(defalias '--each-indexed '--each) + +(defun -each-indexed (list fn) + "Call FN on each index and element of LIST. +For each ITEM at INDEX in LIST, call (funcall FN INDEX ITEM). +Return nil; this function is intended for side effects. + +See also: `-map-indexed'." + (declare (indent 1)) + (--each list (funcall fn it-index it))) + +(defmacro --each-while (list pred &rest body) + "Evaluate BODY for each item in LIST, while PRED evaluates to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating PRED or BODY. Once +an element is reached for which PRED evaluates to nil, no further +BODY is evaluated. The return value is always nil. +This is the anaphoric counterpart to `-each-while'." + (declare (debug (form form body)) (indent 2)) + (let ((l (make-symbol "list")) + (i (make-symbol "i")) + (elt (make-symbol "elt"))) + `(let ((,l ,list) + (,i 0) + ,elt) + (while (when ,l + (setq ,elt (car-safe ,l)) + (let ((it ,elt) (it-index ,i)) + (ignore it it-index) + ,pred)) + (let ((it ,elt) (it-index ,i)) + (ignore it it-index) + ,@body) + (setq ,i (1+ ,i) ,l (cdr ,l)))))) + +(defun -each-while (list pred fn) + "Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil. +Once an ITEM is reached for which PRED returns nil, FN is no +longer called. Return nil; this function is intended for side +effects. + +Its anaphoric counterpart is `--each-while'." + (declare (indent 2)) + (--each-while list (funcall pred it) (funcall fn it))) + +(defmacro --each-r (list &rest body) + "Evaluate BODY for each element of LIST in reversed order. +Each element of LIST in turn, starting at its end, is bound to +`it' and its index within LIST to `it-index' before evaluating +BODY. The return value is always nil. +This is the anaphoric counterpart to `-each-r'." + (declare (debug (form body)) (indent 1)) + (let ((v (make-symbol "vector")) + (i (make-symbol "i"))) + ;; Implementation note: building a vector is considerably faster + ;; than building a reversed list (vector takes less memory, so + ;; there is less GC), plus `length' comes naturally. In-place + ;; `nreverse' would be faster still, but BODY would be able to see + ;; that, even if the modification was undone before we return. + `(let* ((,v (vconcat ,list)) + (,i (length ,v)) + it it-index) + (ignore it it-index) + (while (> ,i 0) + (setq ,i (1- ,i) it-index ,i it (aref ,v ,i)) + ,@body)))) + +(defun -each-r (list fn) + "Call FN on each element of LIST in reversed order. +Return nil; this function is intended for side effects. + +Its anaphoric counterpart is `--each-r'." + (--each-r list (funcall fn it))) + +(defmacro --each-r-while (list pred &rest body) + "Eval BODY for each item in reversed LIST, while PRED evals to non-nil. +Each element of LIST in turn, starting at its end, is bound to +`it' and its index within LIST to `it-index' before evaluating +PRED or BODY. Once an element is reached for which PRED +evaluates to nil, no further BODY is evaluated. The return value +is always nil. +This is the anaphoric counterpart to `-each-r-while'." + (declare (debug (form form body)) (indent 2)) + (let ((v (make-symbol "vector")) + (i (make-symbol "i")) + (elt (make-symbol "elt"))) + `(let* ((,v (vconcat ,list)) + (,i (length ,v)) + ,elt it it-index) + (ignore it it-index) + (while (when (> ,i 0) + (setq ,i (1- ,i) it-index ,i) + (setq ,elt (aref ,v ,i) it ,elt) + ,pred) + (setq it-index ,i it ,elt) + ,@body)))) + +(defun -each-r-while (list pred fn) + "Call FN on each ITEM in reversed LIST, while (PRED ITEM) is non-nil. +Once an ITEM is reached for which PRED returns nil, FN is no +longer called. Return nil; this function is intended for side +effects. + +Its anaphoric counterpart is `--each-r-while'." + (--each-r-while list (funcall pred it) (funcall fn it))) + +(defmacro --dotimes (num &rest body) + "Evaluate BODY NUM times, presumably for side effects. +BODY is evaluated with the local variable `it' temporarily bound +to successive integers running from 0, inclusive, to NUM, +exclusive. BODY is not evaluated if NUM is less than 1. +This is the anaphoric counterpart to `-dotimes'." + (declare (debug (form body)) (indent 1)) + (let ((n (make-symbol "num")) + (i (make-symbol "i"))) + `(let ((,n ,num) + (,i 0) + it) + (ignore it) + (while (< ,i ,n) + (setq it ,i ,i (1+ ,i)) + ,@body)))) + +(defun -dotimes (num fn) + "Call FN NUM times, presumably for side effects. +FN is called with a single argument on successive integers +running from 0, inclusive, to NUM, exclusive. FN is not called +if NUM is less than 1. + +This function's anaphoric counterpart is `--dotimes'." + (declare (indent 1)) + (--dotimes num (funcall fn it))) + +(defun -map (fn list) + "Apply FN to each item in LIST and return the list of results. + +This function's anaphoric counterpart is `--map'." + (declare (important-return-value t)) + (mapcar fn list)) + +(defmacro --map (form list) + "Eval FORM for each item in LIST and return the list of results. +Each element of LIST in turn is bound to `it' before evaluating +FORM. +This is the anaphoric counterpart to `-map'." + (declare (debug (def-form form))) + `(mapcar (lambda (it) (ignore it) ,form) ,list)) + +(defmacro --reduce-from (form init list) + "Accumulate a value by evaluating FORM across LIST. +This macro is like `--each' (which see), but it additionally +provides an accumulator variable `acc' which it successively +binds to the result of evaluating FORM for the current LIST +element before processing the next element. For the first +element, `acc' is initialized with the result of evaluating INIT. +The return value is the resulting value of `acc'. If LIST is +empty, FORM is not evaluated, and the return value is the result +of INIT. +This is the anaphoric counterpart to `-reduce-from'." + (declare (debug (form form form))) + `(let ((acc ,init)) + (--each ,list (setq acc ,form)) + acc)) + +(defun -reduce-from (fn init list) + "Reduce the function FN across LIST, starting with INIT. +Return the result of applying FN to INIT and the first element of +LIST, then applying FN to that result and the second element, +etc. If LIST is empty, return INIT without calling FN. + +This function's anaphoric counterpart is `--reduce-from'. + +For other folds, see also `-reduce' and `-reduce-r'." + (declare (important-return-value t)) + (--reduce-from (funcall fn acc it) init list)) + +(defmacro --reduce (form list) + "Accumulate a value by evaluating FORM across LIST. +This macro is like `--reduce-from' (which see), except the first +element of LIST is taken as INIT. Thus if LIST contains a single +item, it is returned without evaluating FORM. If LIST is empty, +FORM is evaluated with `it' and `acc' bound to nil. +This is the anaphoric counterpart to `-reduce'." + (declare (debug (form form))) + (let ((lv (make-symbol "list-value"))) + `(let ((,lv ,list)) + (if ,lv + (--reduce-from ,form (car ,lv) (cdr ,lv)) + ;; Explicit nil binding pacifies lexical "variable left uninitialized" + ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. + (let ((acc nil) (it nil)) + (ignore acc it) + ,form))))) + +(defun -reduce (fn list) + "Reduce the function FN across LIST. +Return the result of applying FN to the first two elements of +LIST, then applying FN to that result and the third element, etc. +If LIST contains a single element, return it without calling FN. +If LIST is empty, return the result of calling FN with no +arguments. + +This function's anaphoric counterpart is `--reduce'. + +For other folds, see also `-reduce-from' and `-reduce-r'." + (declare (important-return-value t)) + (if list + (-reduce-from fn (car list) (cdr list)) + (funcall fn))) + +(defmacro --reduce-r-from (form init list) + "Accumulate a value by evaluating FORM across LIST in reverse. +This macro is like `--reduce-from', except it starts from the end +of LIST. +This is the anaphoric counterpart to `-reduce-r-from'." + (declare (debug (form form form))) + `(let ((acc ,init)) + (--each-r ,list (setq acc ,form)) + acc)) + +(defun -reduce-r-from (fn init list) + "Reduce the function FN across LIST in reverse, starting with INIT. +Return the result of applying FN to the last element of LIST and +INIT, then applying FN to the second-to-last element and the +previous result of FN, etc. That is, the first argument of FN is +the current element, and its second argument the accumulated +value. If LIST is empty, return INIT without calling FN. + +This function is like `-reduce-from' but the operation associates +from the right rather than left. In other words, it starts from +the end of LIST and flips the arguments to FN. Conceptually, it +is like replacing the conses in LIST with applications of FN, and +its last link with INIT, and evaluating the resulting expression. + +This function's anaphoric counterpart is `--reduce-r-from'. + +For other folds, see also `-reduce-r' and `-reduce'." + (declare (important-return-value t)) + (--reduce-r-from (funcall fn it acc) init list)) + +(defmacro --reduce-r (form list) + "Accumulate a value by evaluating FORM across LIST in reverse order. +This macro is like `--reduce', except it starts from the end of +LIST. +This is the anaphoric counterpart to `-reduce-r'." + (declare (debug (form form))) + `(--reduce ,form (reverse ,list))) + +(defun -reduce-r (fn list) + "Reduce the function FN across LIST in reverse. +Return the result of applying FN to the last two elements of +LIST, then applying FN to the third-to-last element and the +previous result of FN, etc. That is, the first argument of FN is +the current element, and its second argument the accumulated +value. If LIST contains a single element, return it without +calling FN. If LIST is empty, return the result of calling FN +with no arguments. + +This function is like `-reduce' but the operation associates from +the right rather than left. In other words, it starts from the +end of LIST and flips the arguments to FN. Conceptually, it is +like replacing the conses in LIST with applications of FN, +ignoring its last link, and evaluating the resulting expression. + +This function's anaphoric counterpart is `--reduce-r'. + +For other folds, see also `-reduce-r-from' and `-reduce'." + (declare (important-return-value t)) + (if list + (--reduce-r (funcall fn it acc) list) + (funcall fn))) + +(defmacro --reductions-from (form init list) + "Return a list of FORM's intermediate reductions across LIST. +That is, a list of the intermediate values of the accumulator +when `--reduce-from' (which see) is called with the same +arguments. +This is the anaphoric counterpart to `-reductions-from'." + (declare (debug (form form form))) + `(nreverse + (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) + (list ,init) + ,list))) + +(defun -reductions-from (fn init list) + "Return a list of FN's intermediate reductions across LIST. +That is, a list of the intermediate values of the accumulator +when `-reduce-from' (which see) is called with the same +arguments. + +This function's anaphoric counterpart is `--reductions-from'. + +For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) + (--reductions-from (funcall fn acc it) init list)) + +(defmacro --reductions (form list) + "Return a list of FORM's intermediate reductions across LIST. +That is, a list of the intermediate values of the accumulator +when `--reduce' (which see) is called with the same arguments. +This is the anaphoric counterpart to `-reductions'." + (declare (debug (form form))) + (let ((lv (make-symbol "list-value"))) + `(let ((,lv ,list)) + (if ,lv + (--reductions-from ,form (car ,lv) (cdr ,lv)) + ;; Explicit nil binding pacifies lexical "variable left uninitialized" + ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. + (let ((acc nil) (it nil)) + (ignore acc it) + (list ,form)))))) + +(defun -reductions (fn list) + "Return a list of FN's intermediate reductions across LIST. +That is, a list of the intermediate values of the accumulator +when `-reduce' (which see) is called with the same arguments. + +This function's anaphoric counterpart is `--reductions'. + +For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) + (if list + (--reductions-from (funcall fn acc it) (car list) (cdr list)) + (list (funcall fn)))) + +(defmacro --reductions-r-from (form init list) + "Return a list of FORM's intermediate reductions across reversed LIST. +That is, a list of the intermediate values of the accumulator +when `--reduce-r-from' (which see) is called with the same +arguments. +This is the anaphoric counterpart to `-reductions-r-from'." + (declare (debug (form form form))) + `(--reduce-r-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) + (list ,init) + ,list)) + +(defun -reductions-r-from (fn init list) + "Return a list of FN's intermediate reductions across reversed LIST. +That is, a list of the intermediate values of the accumulator +when `-reduce-r-from' (which see) is called with the same +arguments. + +This function's anaphoric counterpart is `--reductions-r-from'. + +For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) + (--reductions-r-from (funcall fn it acc) init list)) + +(defmacro --reductions-r (form list) + "Return a list of FORM's intermediate reductions across reversed LIST. +That is, a list of the intermediate values of the accumulator +when `--reduce-re' (which see) is called with the same arguments. +This is the anaphoric counterpart to `-reductions-r'." + (declare (debug (form list))) + (let ((lv (make-symbol "list-value"))) + `(let ((,lv (reverse ,list))) + (if ,lv + (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc) + (list (car ,lv)) + (cdr ,lv)) + ;; Explicit nil binding pacifies lexical "variable left uninitialized" + ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. + (let ((acc nil) (it nil)) + (ignore acc it) + (list ,form)))))) + +(defun -reductions-r (fn list) + "Return a list of FN's intermediate reductions across reversed LIST. +That is, a list of the intermediate values of the accumulator +when `-reduce-r' (which see) is called with the same arguments. + +This function's anaphoric counterpart is `--reductions-r'. + +For other folds, see also `-reductions-r-from' and +`-reductions'." + (declare (important-return-value t)) + (if list + (--reductions-r (funcall fn it acc) list) + (list (funcall fn)))) + +(defmacro --filter (form list) + "Return a new list of the items in LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-filter'. +For the opposite operation, see also `--remove'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list (when ,form (push it ,r))) + (nreverse ,r)))) + +(defun -filter (pred list) + "Return a new list of the items in LIST for which PRED returns non-nil. + +Alias: `-select'. + +This function's anaphoric counterpart is `--filter'. + +For similar operations, see also `-keep' and `-remove'." + (declare (important-return-value t)) + (--filter (funcall pred it) list)) + +(defalias '-select '-filter) +(defalias '--select '--filter) + +(defmacro --remove (form list) + "Return a new list of the items in LIST for which FORM evals to nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-remove'. +For the opposite operation, see also `--filter'." + (declare (debug (form form))) + `(--filter (not ,form) ,list)) + +(defun -remove (pred list) + "Return a new list of the items in LIST for which PRED returns nil. + +Alias: `-reject'. + +This function's anaphoric counterpart is `--remove'. + +For similar operations, see also `-keep' and `-filter'." + (declare (important-return-value t)) + (--remove (funcall pred it) list)) + +(defalias '-reject '-remove) +(defalias '--reject '--remove) + +(defmacro --remove-first (form list) + "Remove the first item from LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. This is a +non-destructive operation, but only the front of LIST leading up +to the removed item is a copy; the rest is LIST's original tail. +If no item is removed, then the result is a complete copy. +This is the anaphoric counterpart to `-remove-first'." + (declare (debug (form form))) + (let ((front (make-symbol "front")) + (tail (make-symbol "tail"))) + `(let ((,tail ,list) ,front) + (--each-while ,tail (not ,form) + (push (pop ,tail) ,front)) + (if ,tail + (nconc (nreverse ,front) (cdr ,tail)) + (nreverse ,front))))) + +(defun -remove-first (pred list) + "Remove the first item from LIST for which PRED returns non-nil. +This is a non-destructive operation, but only the front of LIST +leading up to the removed item is a copy; the rest is LIST's +original tail. If no item is removed, then the result is a +complete copy. + +Alias: `-reject-first'. + +This function's anaphoric counterpart is `--remove-first'. + +See also `-map-first', `-remove-item', and `-remove-last'." + (declare (important-return-value t)) + (--remove-first (funcall pred it) list)) + +;; TODO: #'-quoting the macro upsets Emacs 24. +(defalias '-reject-first #'-remove-first) +(defalias '--reject-first '--remove-first) + +(defmacro --remove-last (form list) + "Remove the last item from LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' before evaluating +FORM. The result is a copy of LIST regardless of whether an +element is removed. +This is the anaphoric counterpart to `-remove-last'." + (declare (debug (form form))) + `(nreverse (--remove-first ,form (reverse ,list)))) + +(defun -remove-last (pred list) + "Remove the last item from LIST for which PRED returns non-nil. +The result is a copy of LIST regardless of whether an element is +removed. + +Alias: `-reject-last'. + +This function's anaphoric counterpart is `--remove-last'. + +See also `-map-last', `-remove-item', and `-remove-first'." + (declare (important-return-value t)) + (--remove-last (funcall pred it) list)) + +(defalias '-reject-last '-remove-last) +(defalias '--reject-last '--remove-last) + +(defalias '-remove-item #'remove + "Return a copy of LIST with all occurrences of ITEM removed. +The comparison is done with `equal'. +\n(fn ITEM LIST)") + +(defmacro --keep (form list) + "Eval FORM for each item in LIST and return the non-nil results. +Like `--filter', but returns the non-nil results of FORM instead +of the corresponding elements of LIST. Each element of LIST in +turn is bound to `it' and its index within LIST to `it-index' +before evaluating FORM. +This is the anaphoric counterpart to `-keep'." + (declare (debug (form form))) + (let ((r (make-symbol "result")) + (m (make-symbol "mapped"))) + `(let (,r) + (--each ,list (let ((,m ,form)) (when ,m (push ,m ,r)))) + (nreverse ,r)))) + +(defun -keep (fn list) + "Return a new list of the non-nil results of applying FN to each item in LIST. +Like `-filter', but returns the non-nil results of FN instead of +the corresponding elements of LIST. + +Its anaphoric counterpart is `--keep'." + (declare (important-return-value t)) + (--keep (funcall fn it) list)) + +(defun -non-nil (list) + "Return a copy of LIST with all nil items removed." + (declare (side-effect-free t)) + (--filter it list)) + +(defmacro --map-indexed (form list) + "Eval FORM for each item in LIST and return the list of results. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. This is like +`--map', but additionally makes `it-index' available to FORM. + +This is the anaphoric counterpart to `-map-indexed'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list + (push ,form ,r)) + (nreverse ,r)))) + +(defun -map-indexed (fn list) + "Apply FN to each index and item in LIST and return the list of results. +This is like `-map', but FN takes two arguments: the index of the +current element within LIST, and the element itself. + +This function's anaphoric counterpart is `--map-indexed'. + +For a side-effecting variant, see also `-each-indexed'." + (declare (important-return-value t)) + (--map-indexed (funcall fn it-index it) list)) + +(defmacro --map-when (pred rep list) + "Anaphoric form of `-map-when'." + (declare (debug (form form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list (!cons (if ,pred ,rep it) ,r)) + (nreverse ,r)))) + +(defun -map-when (pred rep list) + "Use PRED to conditionally apply REP to each item in LIST. +Return a copy of LIST where the items for which PRED returns nil +are unchanged, and the rest are mapped through the REP function. + +Alias: `-replace-where' + +See also: `-update-at'" + (declare (important-return-value t)) + (--map-when (funcall pred it) (funcall rep it) list)) + +(defalias '-replace-where '-map-when) +(defalias '--replace-where '--map-when) + +(defun -map-first (pred rep list) + "Use PRED to determine the first item in LIST to call REP on. +Return a copy of LIST where the first item for which PRED returns +non-nil is replaced with the result of calling REP on that item. + +See also: `-map-when', `-replace-first'" + (declare (important-return-value t)) + (let (front) + (while (and list (not (funcall pred (car list)))) + (push (car list) front) + (!cdr list)) + (if list + (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list))) + (nreverse front)))) + +(defmacro --map-first (pred rep list) + "Anaphoric form of `-map-first'." + (declare (debug (def-form def-form form))) + `(-map-first (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,rep) + ,list)) + +(defun -map-last (pred rep list) + "Use PRED to determine the last item in LIST to call REP on. +Return a copy of LIST where the last item for which PRED returns +non-nil is replaced with the result of calling REP on that item. + +See also: `-map-when', `-replace-last'" + (declare (important-return-value t)) + (nreverse (-map-first pred rep (reverse list)))) + +(defmacro --map-last (pred rep list) + "Anaphoric form of `-map-last'." + (declare (debug (def-form def-form form))) + `(-map-last (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,rep) + ,list)) + +(defun -replace (old new list) + "Replace all OLD items in LIST with NEW. + +Elements are compared using `equal'. + +See also: `-replace-at'" + (declare (pure t) (side-effect-free t)) + (--map-when (equal it old) new list)) + +(defun -replace-first (old new list) + "Replace the first occurrence of OLD with NEW in LIST. + +Elements are compared using `equal'. + +See also: `-map-first'" + (declare (pure t) (side-effect-free t)) + (--map-first (equal old it) new list)) + +(defun -replace-last (old new list) + "Replace the last occurrence of OLD with NEW in LIST. + +Elements are compared using `equal'. + +See also: `-map-last'" + (declare (pure t) (side-effect-free t)) + (--map-last (equal old it) new list)) + +(defmacro --mapcat (form list) + "Anaphoric form of `-mapcat'." + (declare (debug (form form))) + `(apply #'append (--map ,form ,list))) + +(defun -mapcat (fn list) + "Return the concatenation of the result of mapping FN over LIST. +Thus function FN should return a list." + (declare (important-return-value t)) + (--mapcat (funcall fn it) list)) + +(defmacro --iterate (form init n) + "Anaphoric version of `-iterate'." + (declare (debug (form form form))) + (let ((res (make-symbol "result")) + (len (make-symbol "n"))) + `(let ((,len ,n)) + (when (> ,len 0) + (let* ((it ,init) + (,res (list it))) + (dotimes (_ (1- ,len)) + (push (setq it ,form) ,res)) + (nreverse ,res)))))) + +(defun -iterate (fun init n) + "Return a list of iterated applications of FUN to INIT. + +This means a list of the form: + + (INIT (FUN INIT) (FUN (FUN INIT)) ...) + +N is the length of the returned list." + (declare (important-return-value t)) + (--iterate (funcall fun it) init n)) + +(defun -flatten (l) + "Take a nested list L and return its contents as a single, flat list. + +Note that because nil represents a list of zero elements (an +empty list), any mention of nil in L will disappear after +flattening. If you need to preserve nils, consider `-flatten-n' +or map them to some unique symbol and then map them back. + +Conses of two atoms are considered \"terminals\", that is, they +aren't flattened further. + +See also: `-flatten-n'" + (declare (pure t) (side-effect-free t)) + (if (and (listp l) (listp (cdr l))) + (-mapcat '-flatten l) + (list l))) + +(defun -flatten-n (num list) + "Flatten NUM levels of a nested LIST. + +See also: `-flatten'" + (declare (pure t) (side-effect-free t)) + (dotimes (_ num) + (setq list (apply #'append (mapcar #'-list list)))) + list) + +(defalias '-concat #'append + "Concatenate all the arguments and make the result a list. +The result is a list whose elements are the elements of all the arguments. +Each argument may be a list, vector or string. + +All arguments except the last argument are copied. The last argument +is just used as the tail of the new list. + +\(fn &rest SEQUENCES)") + +(defalias '-copy #'copy-sequence + "Create a shallow copy of LIST. + +\(fn LIST)") + +(defmacro --splice (pred form list) + "Splice lists generated by FORM in place of items satisfying PRED in LIST. + +Evaluate PRED for each element of LIST in turn bound to `it'. +Whenever the result of PRED is nil, leave that `it' is-is. +Otherwise, evaluate FORM with the same `it' binding still in +place. The result should be a (possibly empty) list of items to +splice in place of `it' in LIST. + +This can be useful as an alternative to the `,@' construct in a +`\\=`' structure, in case you need to splice several lists at +marked positions (for example with keywords). + +This is the anaphoric counterpart to `-splice'." + (declare (debug (form form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list + (if ,pred + (--each ,form (push it ,r)) + (push it ,r))) + (nreverse ,r)))) + +(defun -splice (pred fun list) + "Splice lists generated by FUN in place of items satisfying PRED in LIST. + +Call PRED on each element of LIST. Whenever the result of PRED +is nil, leave that `it' as-is. Otherwise, call FUN on the same +`it' that satisfied PRED. The result should be a (possibly +empty) list of items to splice in place of `it' in LIST. + +This can be useful as an alternative to the `,@' construct in a +`\\=`' structure, in case you need to splice several lists at +marked positions (for example with keywords). + +This function's anaphoric counterpart is `--splice'. + +See also: `-splice-list', `-insert-at'." + (declare (important-return-value t)) + (--splice (funcall pred it) (funcall fun it) list)) + +(defun -splice-list (pred new-list list) + "Splice NEW-LIST in place of elements matching PRED in LIST. + +See also: `-splice', `-insert-at'" + (declare (important-return-value t)) + (-splice pred (lambda (_) new-list) list)) + +(defmacro --splice-list (pred new-list list) + "Anaphoric form of `-splice-list'." + (declare (debug (def-form form form))) + `(-splice-list (lambda (it) (ignore it) ,pred) ,new-list ,list)) + +(defun -cons* (&rest args) + "Make a new list from the elements of ARGS. +The last 2 elements of ARGS are used as the final cons of the +result, so if the final element of ARGS is not a list, the result +is a dotted list. With no ARGS, return nil." + (declare (side-effect-free t)) + (let* ((len (length args)) + (tail (nthcdr (- len 2) args)) + (last (cdr tail))) + (if (null last) + (car args) + (setcdr tail (car last)) + args))) + +(defun -snoc (list elem &rest elements) + "Append ELEM to the end of the list. + +This is like `cons', but operates on the end of list. + +If any ELEMENTS are given, append them to the list as well." + (declare (side-effect-free t)) + (-concat list (list elem) elements)) + +(defmacro --first (form list) + "Return the first item in LIST for which FORM evals to non-nil. +Return nil if no such element is found. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-first'." + (declare (debug (form form))) + (let ((n (make-symbol "needle"))) + `(let (,n) + (--each-while ,list (or (not ,form) + (ignore (setq ,n it)))) + ,n))) + +(defun -first (pred list) + "Return the first item in LIST for which PRED returns non-nil. +Return nil if no such element is found. + +To get the first item in the list no questions asked, +use `-first-item'. + +Alias: `-find'. + +This function's anaphoric counterpart is `--first'." + (declare (important-return-value t)) + (--first (funcall pred it) list)) + +(defalias '-find #'-first) +(defalias '--find '--first) + +(defmacro --some (form list) + "Return non-nil if FORM evals to non-nil for at least one item in LIST. +If so, return the first such result of FORM. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-some'." + (declare (debug (form form))) + (let ((n (make-symbol "needle"))) + `(let (,n) + (--each-while ,list (not (setq ,n ,form))) + ,n))) + +(defun -some (pred list) + "Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil. + +Alias: `-any'. + +This function's anaphoric counterpart is `--some'." + (declare (important-return-value t)) + (--some (funcall pred it) list)) + +(defalias '-any '-some) +(defalias '--any '--some) + +(defmacro --every (form list) + "Return non-nil if FORM evals to non-nil for all items in LIST. +If so, return the last such result of FORM. Otherwise, once an +item is reached for which FORM yields nil, return nil without +evaluating FORM for any further LIST elements. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. + +This macro is like `--every-p', but on success returns the last +non-nil result of FORM instead of just t. + +This is the anaphoric counterpart to `-every'." + (declare (debug (form form))) + (let ((a (make-symbol "all"))) + `(let ((,a t)) + (--each-while ,list (setq ,a ,form)) + ,a))) + +(defun -every (pred list) + "Return non-nil if PRED returns non-nil for all items in LIST. +If so, return the last such result of PRED. Otherwise, once an +item is reached for which PRED returns nil, return nil without +calling PRED on any further LIST elements. + +This function is like `-every-p', but on success returns the last +non-nil result of PRED instead of just t. + +This function's anaphoric counterpart is `--every'." + (declare (important-return-value t)) + (--every (funcall pred it) list)) + +(defmacro --last (form list) + "Anaphoric form of `-last'." + (declare (debug (form form))) + (let ((n (make-symbol "needle"))) + `(let (,n) + (--each ,list + (when ,form (setq ,n it))) + ,n))) + +(defun -last (pred list) + "Return the last x in LIST where (PRED x) is non-nil, else nil." + (declare (important-return-value t)) + (--last (funcall pred it) list)) + +(defalias '-first-item #'car + "Return the first item of LIST, or nil on an empty list. + +See also: `-second-item', `-last-item', etc. + +\(fn LIST)") + +;; Ensure that calls to `-first-item' are compiled to a single opcode, +;; just like `car'. +(put '-first-item 'byte-opcode 'byte-car) +(put '-first-item 'byte-compile 'byte-compile-one-arg) +(put '-first-item 'pure t) +(put '-first-item 'side-effect-free t) + +(defalias '-second-item #'cadr + "Return the second item of LIST, or nil if LIST is too short. + +See also: `-first-item', `-third-item', etc. + +\(fn LIST)") + +(put '-second-item 'pure t) +(put '-second-item 'side-effect-free t) + +(defalias '-third-item + (if (fboundp 'caddr) + #'caddr + (lambda (list) (car (cddr list)))) + "Return the third item of LIST, or nil if LIST is too short. + +See also: `-second-item', `-fourth-item', etc. + +\(fn LIST)") + +(put '-third-item 'pure t) +(put '-third-item 'side-effect-free t) + +(defalias '-fourth-item + (if (fboundp 'cadddr) + #'cadddr + (lambda (list) (cadr (cddr list)))) + "Return the fourth item of LIST, or nil if LIST is too short. + +See also: `-third-item', `-fifth-item', etc. + +\(fn LIST)") + +(put '-fourth-item 'pure t) +(put '-fourth-item 'side-effect-free t) + +(defun -fifth-item (list) + "Return the fifth item of LIST, or nil if LIST is too short. + +See also: `-fourth-item', `-last-item', etc." + (declare (pure t) (side-effect-free t)) + (car (cddr (cddr list)))) + +(defun -last-item (list) + "Return the last item of LIST, or nil on an empty list. + +See also: `-first-item', etc." + (declare (pure t) (side-effect-free t)) + (car (last list))) + +;; Use `with-no-warnings' to suppress unbound `-last-item' or +;; undefined `gv--defsetter' warnings arising from both +;; `gv-define-setter' and `defsetf' in certain Emacs versions. +(with-no-warnings + (if (fboundp 'gv-define-setter) + (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val)) + (defsetf -last-item (x) (val) `(setcar (last ,x) ,val)))) + +(defun -butlast (list) + "Return a list of all items in list except for the last." + ;; no alias as we don't want magic optional argument + (declare (pure t) (side-effect-free t)) + (butlast list)) + +(defmacro --count (pred list) + "Anaphoric form of `-count'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let ((,r 0)) + (--each ,list (when ,pred (setq ,r (1+ ,r)))) + ,r))) + +(defun -count (pred list) + "Counts the number of items in LIST where (PRED item) is non-nil." + (declare (important-return-value t)) + (--count (funcall pred it) list)) + +(defun ---truthy? (obj) + "Return OBJ as a boolean value (t or nil)." + (declare (pure t) (side-effect-free error-free)) + (and obj t)) + +(defmacro --any? (form list) + "Anaphoric form of `-any?'." + (declare (debug (form form))) + `(and (--some ,form ,list) t)) + +(defun -any? (pred list) + "Return t if (PRED X) is non-nil for any X in LIST, else nil. + +Alias: `-any-p', `-some?', `-some-p'" + (declare (important-return-value t)) + (--any? (funcall pred it) list)) + +(defalias '-some? '-any?) +(defalias '--some? '--any?) +(defalias '-any-p '-any?) +(defalias '--any-p '--any?) +(defalias '-some-p '-any?) +(defalias '--some-p '--any?) + +(defmacro --all? (form list) + "Return t if FORM evals to non-nil for all items in LIST. +Otherwise, once an item is reached for which FORM yields nil, +return nil without evaluating FORM for any further LIST elements. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. + +The similar macro `--every' is more widely useful, since it +returns the last non-nil result of FORM instead of just t on +success. + +Alias: `--all-p', `--every-p', `--every?'. + +This is the anaphoric counterpart to `-all?'." + (declare (debug (form form))) + `(and (--every ,form ,list) t)) + +(defun -all? (pred list) + "Return t if (PRED X) is non-nil for all X in LIST, else nil. +In the latter case, stop after the first X for which (PRED X) is +nil, without calling PRED on any subsequent elements of LIST. + +The similar function `-every' is more widely useful, since it +returns the last non-nil result of PRED instead of just t on +success. + +Alias: `-all-p', `-every-p', `-every?'. + +This function's anaphoric counterpart is `--all?'." + (declare (important-return-value t)) + (--all? (funcall pred it) list)) + +(defalias '-every? '-all?) +(defalias '--every? '--all?) +(defalias '-all-p '-all?) +(defalias '--all-p '--all?) +(defalias '-every-p '-all?) +(defalias '--every-p '--all?) + +(defmacro --none? (form list) + "Anaphoric form of `-none?'." + (declare (debug (form form))) + `(--all? (not ,form) ,list)) + +(defun -none? (pred list) + "Return t if (PRED X) is nil for all X in LIST, else nil. + +Alias: `-none-p'" + (declare (important-return-value t)) + (--none? (funcall pred it) list)) + +(defalias '-none-p '-none?) +(defalias '--none-p '--none?) + +(defmacro --only-some? (form list) + "Anaphoric form of `-only-some?'." + (declare (debug (form form))) + (let ((y (make-symbol "yes")) + (n (make-symbol "no"))) + `(let (,y ,n) + (--each-while ,list (not (and ,y ,n)) + (if ,form (setq ,y t) (setq ,n t))) + (---truthy? (and ,y ,n))))) + +(defun -only-some? (pred list) + "Return t if different LIST items both satisfy and do not satisfy PRED. +That is, if PRED returns both nil for at least one item, and +non-nil for at least one other item in LIST. Return nil if all +items satisfy the predicate or none of them do. + +Alias: `-only-some-p'" + (declare (important-return-value t)) + (--only-some? (funcall pred it) list)) + +(defalias '-only-some-p '-only-some?) +(defalias '--only-some-p '--only-some?) + +(defun -slice (list from &optional to step) + "Return copy of LIST, starting from index FROM to index TO. + +FROM or TO may be negative. These values are then interpreted +modulo the length of the list. + +If STEP is a number, only each STEPth item in the resulting +section is returned. Defaults to 1." + (declare (side-effect-free t)) + (let ((length (length list)) + (new-list nil)) + ;; to defaults to the end of the list + (setq to (or to length)) + (setq step (or step 1)) + ;; handle negative indices + (when (< from 0) + (setq from (mod from length))) + (when (< to 0) + (setq to (mod to length))) + + ;; iterate through the list, keeping the elements we want + (--each-while list (< it-index to) + (when (and (>= it-index from) + (= (mod (- from it-index) step) 0)) + (push it new-list))) + (nreverse new-list))) + +(defmacro --take-while (form list) + "Take successive items from LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. Return a new +list of the successive elements from the start of LIST for which +FORM evaluates to non-nil. +This is the anaphoric counterpart to `-take-while'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each-while ,list ,form (push it ,r)) + (nreverse ,r)))) + +(defun -take-while (pred list) + "Take successive items from LIST for which PRED returns non-nil. +PRED is a function of one argument. Return a new list of the +successive elements from the start of LIST for which PRED returns +non-nil. + +This function's anaphoric counterpart is `--take-while'. + +For another variant, see also `-drop-while'." + (declare (important-return-value t)) + (--take-while (funcall pred it) list)) + +(defmacro --drop-while (form list) + "Drop successive items from LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. Return the +tail (not a copy) of LIST starting from its first element for +which FORM evaluates to nil. +This is the anaphoric counterpart to `-drop-while'." + (declare (debug (form form))) + (let ((l (make-symbol "list"))) + `(let ((,l ,list)) + (--each-while ,l ,form (pop ,l)) + ,l))) + +(defun -drop-while (pred list) + "Drop successive items from LIST for which PRED returns non-nil. +PRED is a function of one argument. Return the tail (not a copy) +of LIST starting from its first element for which PRED returns +nil. + +This function's anaphoric counterpart is `--drop-while'. + +For another variant, see also `-take-while'." + (declare (important-return-value t)) + (--drop-while (funcall pred it) list)) + +(defun -take (n list) + "Return a copy of the first N items in LIST. +Return a copy of LIST if it contains N items or fewer. +Return nil if N is zero or less. + +See also: `-take-last'." + (declare (side-effect-free t)) + (--take-while (< it-index n) list)) + +(defun -take-last (n list) + "Return a copy of the last N items of LIST in order. +Return a copy of LIST if it contains N items or fewer. +Return nil if N is zero or less. + +See also: `-take'." + (declare (side-effect-free t)) + (copy-sequence (last list n))) + +(defalias '-drop #'nthcdr + "Return the tail (not a copy) of LIST without the first N items. +Return nil if LIST contains N items or fewer. +Return LIST if N is zero or less. + +For another variant, see also `-drop-last'. +\n(fn N LIST)") + +(defun -drop-last (n list) + "Return a copy of LIST without its last N items. +Return a copy of LIST if N is zero or less. +Return nil if LIST contains N items or fewer. + +See also: `-drop'." + (declare (side-effect-free t)) + (nbutlast (copy-sequence list) n)) + +(defun -split-at (n list) + "Split LIST into two sublists after the Nth element. +The result is a list of two elements (TAKE DROP) where TAKE is a +new list of the first N elements of LIST, and DROP is the +remaining elements of LIST (not a copy). TAKE and DROP are like +the results of `-take' and `-drop', respectively, but the split +is done in a single list traversal." + (declare (side-effect-free t)) + (let (result) + (--each-while list (< it-index n) + (push (pop list) result)) + (list (nreverse result) list))) + +(defun -rotate (n list) + "Rotate LIST N places to the right (left if N is negative). +The time complexity is O(n)." + (declare (pure t) (side-effect-free t)) + (cond ((null list) ()) + ((zerop n) (copy-sequence list)) + ((let* ((len (length list)) + (n-mod-len (mod n len)) + (new-tail-len (- len n-mod-len))) + (append (nthcdr new-tail-len list) (-take new-tail-len list)))))) + +(defun -insert-at (n x list) + "Return a list with X inserted into LIST at position N. + +See also: `-splice', `-splice-list'" + (declare (pure t) (side-effect-free t)) + (let ((split-list (-split-at n list))) + (nconc (car split-list) (cons x (cadr split-list))))) + +(defun -replace-at (n x list) + "Return a list with element at Nth position in LIST replaced with X. + +See also: `-replace'" + (declare (pure t) (side-effect-free t)) + (let ((split-list (-split-at n list))) + (nconc (car split-list) (cons x (cdr (cadr split-list)))))) + +(defun -update-at (n func list) + "Use FUNC to update the Nth element of LIST. +Return a copy of LIST where the Nth element is replaced with the +result of calling FUNC on it. + +See also: `-map-when'" + (declare (important-return-value t)) + (let ((split-list (-split-at n list))) + (nconc (car split-list) + (cons (funcall func (car (cadr split-list))) + (cdr (cadr split-list)))))) + +(defmacro --update-at (n form list) + "Anaphoric version of `-update-at'." + (declare (debug (form def-form form))) + `(-update-at ,n (lambda (it) (ignore it) ,form) ,list)) + +(defun -remove-at (n list) + "Return LIST with its element at index N removed. +That is, remove any element selected as (nth N LIST) from LIST +and return the result. + +This is a non-destructive operation: parts of LIST (but not +necessarily all of it) are copied as needed to avoid +destructively modifying it. + +See also: `-remove-at-indices', `-remove'." + (declare (pure t) (side-effect-free t)) + (if (zerop n) + (cdr list) + (--remove-first (= it-index n) list))) + +(defun -remove-at-indices (indices list) + "Return LIST with its elements at INDICES removed. +That is, for each index I in INDICES, remove any element selected +as (nth I LIST) from LIST. + +This is a non-destructive operation: parts of LIST (but not +necessarily all of it) are copied as needed to avoid +destructively modifying it. + +See also: `-remove-at', `-remove'." + (declare (pure t) (side-effect-free t)) + (setq indices (--drop-while (< it 0) (-sort #'< indices))) + (let ((i (pop indices)) res) + (--each-while list i + (pop list) + (if (/= it-index i) + (push it res) + (while (and indices (= (car indices) i)) + (pop indices)) + (setq i (pop indices)))) + (nconc (nreverse res) list))) + +(defmacro --split-with (pred list) + "Anaphoric form of `-split-with'." + (declare (debug (form form))) + (let ((l (make-symbol "list")) + (r (make-symbol "result")) + (c (make-symbol "continue"))) + `(let ((,l ,list) + (,r nil) + (,c t)) + (while (and ,l ,c) + (let ((it (car ,l))) + (if (not ,pred) + (setq ,c nil) + (!cons it ,r) + (!cdr ,l)))) + (list (nreverse ,r) ,l)))) + +(defun -split-with (pred list) + "Split LIST into a prefix satisfying PRED, and the rest. +The first sublist is the prefix of LIST with successive elements +satisfying PRED, and the second sublist is the remaining elements +that do not. The result is like performing + + ((-take-while PRED LIST) (-drop-while PRED LIST)) + +but in no more than a single pass through LIST." + (declare (important-return-value t)) + (--split-with (funcall pred it) list)) + +(defmacro -split-on (item list) + "Split the LIST each time ITEM is found. + +Unlike `-partition-by', the ITEM is discarded from the results. +Empty lists are also removed from the result. + +Comparison is done by `equal'. + +See also `-split-when'" + (declare (debug (def-form form))) + `(-split-when (lambda (it) (equal it ,item)) ,list)) + +(defmacro --split-when (form list) + "Anaphoric version of `-split-when'." + (declare (debug (def-form form))) + `(-split-when (lambda (it) (ignore it) ,form) ,list)) + +(defun -split-when (fn list) + "Split the LIST on each element where FN returns non-nil. + +Unlike `-partition-by', the \"matched\" element is discarded from +the results. Empty lists are also removed from the result. + +This function can be thought of as a generalization of +`split-string'." + (declare (important-return-value t)) + (let (r s) + (while list + (if (not (funcall fn (car list))) + (push (car list) s) + (when s (push (nreverse s) r)) + (setq s nil)) + (!cdr list)) + (when s (push (nreverse s) r)) + (nreverse r))) + +(defmacro --separate (form list) + "Anaphoric form of `-separate'." + (declare (debug (form form))) + (let ((y (make-symbol "yes")) + (n (make-symbol "no"))) + `(let (,y ,n) + (--each ,list (if ,form (!cons it ,y) (!cons it ,n))) + (list (nreverse ,y) (nreverse ,n))))) + +(defun -separate (pred list) + "Split LIST into two sublists based on whether items satisfy PRED. +The result is like performing + + ((-filter PRED LIST) (-remove PRED LIST)) + +but in a single pass through LIST." + (declare (important-return-value t)) + (--separate (funcall pred it) list)) + +(defun dash--partition-all-in-steps-reversed (n step list) + "Like `-partition-all-in-steps', but the result is reversed." + (when (< step 1) + (signal 'wrong-type-argument + `("Step size < 1 results in juicy infinite loops" ,step))) + (let (result) + (while list + (push (-take n list) result) + (setq list (nthcdr step list))) + result)) + +(defun -partition-all-in-steps (n step list) + "Partition LIST into sublists of length N that are STEP items apart. +Adjacent groups may overlap if N exceeds the STEP stride. +Trailing groups may contain less than N items." + (declare (pure t) (side-effect-free t)) + (nreverse (dash--partition-all-in-steps-reversed n step list))) + +(defun -partition-in-steps (n step list) + "Partition LIST into sublists of length N that are STEP items apart. +Like `-partition-all-in-steps', but if there are not enough items +to make the last group N-sized, those items are discarded." + (declare (pure t) (side-effect-free t)) + (let ((result (dash--partition-all-in-steps-reversed n step list))) + (while (and result (< (length (car result)) n)) + (pop result)) + (nreverse result))) + +(defun -partition-all (n list) + "Return a new list with the items in LIST grouped into N-sized sublists. +The last group may contain less than N items." + (declare (pure t) (side-effect-free t)) + (-partition-all-in-steps n n list)) + +(defun -partition (n list) + "Return a new list with the items in LIST grouped into N-sized sublists. +If there are not enough items to make the last group N-sized, +those items are discarded." + (declare (pure t) (side-effect-free t)) + (-partition-in-steps n n list)) + +(defmacro --partition-by (form list) + "Anaphoric form of `-partition-by'." + (declare (debug (form form))) + (let ((r (make-symbol "result")) + (s (make-symbol "sublist")) + (v (make-symbol "value")) + (n (make-symbol "new-value")) + (l (make-symbol "list"))) + `(let ((,l ,list)) + (when ,l + (let* ((,r nil) + (it (car ,l)) + (,s (list it)) + (,v ,form) + (,l (cdr ,l))) + (while ,l + (let* ((it (car ,l)) + (,n ,form)) + (unless (equal ,v ,n) + (!cons (nreverse ,s) ,r) + (setq ,s nil) + (setq ,v ,n)) + (!cons it ,s) + (!cdr ,l))) + (!cons (nreverse ,s) ,r) + (nreverse ,r)))))) + +(defun -partition-by (fn list) + "Apply FN to each item in LIST, splitting it each time FN returns a new value." + (declare (important-return-value t)) + (--partition-by (funcall fn it) list)) + +(defmacro --partition-by-header (form list) + "Anaphoric form of `-partition-by-header'." + (declare (debug (form form))) + (let ((r (make-symbol "result")) + (s (make-symbol "sublist")) + (h (make-symbol "header-value")) + (b (make-symbol "seen-body?")) + (n (make-symbol "new-value")) + (l (make-symbol "list"))) + `(let ((,l ,list)) + (when ,l + (let* ((,r nil) + (it (car ,l)) + (,s (list it)) + (,h ,form) + (,b nil) + (,l (cdr ,l))) + (while ,l + (let* ((it (car ,l)) + (,n ,form)) + (if (equal ,h ,n) + (when ,b + (!cons (nreverse ,s) ,r) + (setq ,s nil) + (setq ,b nil)) + (setq ,b t)) + (!cons it ,s) + (!cdr ,l))) + (!cons (nreverse ,s) ,r) + (nreverse ,r)))))) + +(defun -partition-by-header (fn list) + "Apply FN to the first item in LIST. That is the header +value. Apply FN to each item in LIST, splitting it each time FN +returns the header value, but only after seeing at least one +other value (the body)." + (declare (important-return-value t)) + (--partition-by-header (funcall fn it) list)) + +(defmacro --partition-after-pred (form list) + "Partition LIST after each element for which FORM evaluates to non-nil. +Each element of LIST in turn is bound to `it' before evaluating +FORM. + +This is the anaphoric counterpart to `-partition-after-pred'." + (let ((l (make-symbol "list")) + (r (make-symbol "result")) + (s (make-symbol "sublist"))) + `(let ((,l ,list) ,r ,s) + (when ,l + (--each ,l + (push it ,s) + (when ,form + (push (nreverse ,s) ,r) + (setq ,s ()))) + (when ,s + (push (nreverse ,s) ,r)) + (nreverse ,r))))) + +(defun -partition-after-pred (pred list) + "Partition LIST after each element for which PRED returns non-nil. + +This function's anaphoric counterpart is `--partition-after-pred'." + (declare (important-return-value t)) + (--partition-after-pred (funcall pred it) list)) + +(defun -partition-before-pred (pred list) + "Partition directly before each time PRED is true on an element of LIST." + (declare (important-return-value t)) + (nreverse (-map #'reverse + (-partition-after-pred pred (reverse list))))) + +(defun -partition-after-item (item list) + "Partition directly after each time ITEM appears in LIST." + (declare (pure t) (side-effect-free t)) + (-partition-after-pred (lambda (ele) (equal ele item)) + list)) + +(defun -partition-before-item (item list) + "Partition directly before each time ITEM appears in LIST." + (declare (pure t) (side-effect-free t)) + (-partition-before-pred (lambda (ele) (equal ele item)) + list)) + +(defmacro --group-by (form list) + "Anaphoric form of `-group-by'." + (declare (debug t)) + (let ((n (make-symbol "n")) + (k (make-symbol "k")) + (grp (make-symbol "grp"))) + `(nreverse + (-map + (lambda (,n) + (cons (car ,n) + (nreverse (cdr ,n)))) + (--reduce-from + (let* ((,k (,@form)) + (,grp (assoc ,k acc))) + (if ,grp + (setcdr ,grp (cons it (cdr ,grp))) + (push + (list ,k it) + acc)) + acc) + nil ,list))))) + +(defun -group-by (fn list) + "Separate LIST into an alist whose keys are FN applied to the +elements of LIST. Keys are compared by `equal'." + (declare (important-return-value t)) + (--group-by (funcall fn it) list)) + +(defun -interpose (sep list) + "Return a new list of all elements in LIST separated by SEP." + (declare (side-effect-free t)) + (let (result) + (when list + (!cons (car list) result) + (!cdr list)) + (while list + (setq result (cons (car list) (cons sep result))) + (!cdr list)) + (nreverse result))) + +(defun -interleave (&rest lists) + "Return a new list of the first item in each list, then the second etc." + (declare (side-effect-free t)) + (when lists + (let (result) + (while (-none? 'null lists) + (--each lists (!cons (car it) result)) + (setq lists (-map 'cdr lists))) + (nreverse result)))) + +(defmacro --zip-with (form list1 list2) + "Zip LIST1 and LIST2 into a new list according to FORM. +That is, evaluate FORM for each item pair from the two lists, and +return the list of results. The result is as long as the shorter +list. + +Each element of LIST1 and each element of LIST2 in turn are bound +pairwise to `it' and `other', respectively, and their index +within the list to `it-index', before evaluating FORM. + +This is the anaphoric counterpart to `-zip-with'." + (declare (debug (form form form))) + (let ((r (make-symbol "result")) + (l2 (make-symbol "list2"))) + `(let ((,l2 ,list2) ,r) + (--each-while ,list1 ,l2 + (let ((other (pop ,l2))) + (ignore other) + (push ,form ,r))) + (nreverse ,r)))) + +(defun -zip-with (fn list1 list2) + "Zip LIST1 and LIST2 into a new list using the function FN. +That is, apply FN pairwise taking as first argument the next +element of LIST1 and as second argument the next element of LIST2 +at the corresponding position. The result is as long as the +shorter list. + +This function's anaphoric counterpart is `--zip-with'. + +For other zips, see also `-zip-lists' and `-zip-fill'." + (declare (important-return-value t)) + (--zip-with (funcall fn it other) list1 list2)) + +(defun -zip-lists (&rest lists) + "Zip LISTS together. + +Group the head of each list, followed by the second element of +each list, and so on. The number of returned groupings is equal +to the length of the shortest input list, and the length of each +grouping is equal to the number of input LISTS. + +The return value is always a list of proper lists, in contrast to +`-zip' which returns a list of dotted pairs when only two input +LISTS are provided. + +See also: `-zip-pair'." + (declare (pure t) (side-effect-free t)) + (when lists + (let (results) + (while (--every it lists) + (push (mapcar #'car lists) results) + (setq lists (mapcar #'cdr lists))) + (nreverse results)))) + +(defun -zip-lists-fill (fill-value &rest lists) + "Zip LISTS together, padding shorter lists with FILL-VALUE. +This is like `-zip-lists' (which see), except it retains all +elements at positions beyond the end of the shortest list. The +number of returned groupings is equal to the length of the +longest input list, and the length of each grouping is equal to +the number of input LISTS." + (declare (pure t) (side-effect-free t)) + (when lists + (let (results) + (while (--some it lists) + (push (--map (if it (car it) fill-value) lists) results) + (setq lists (mapcar #'cdr lists))) + (nreverse results)))) + +(defun -unzip-lists (lists) + "Unzip LISTS. + +This works just like `-zip-lists' (which see), but takes a list +of lists instead of a variable number of arguments, such that + + (-unzip-lists (-zip-lists ARGS...)) + +is identity (given that the lists comprising ARGS are of the same +length)." + (declare (pure t) (side-effect-free t)) + (apply #'-zip-lists lists)) + +(defalias 'dash--length= + (if (fboundp 'length=) + #'length= + (lambda (list length) + (cond ((< length 0) nil) + ((zerop length) (null list)) + ((let ((last (nthcdr (1- length) list))) + (and last (null (cdr last)))))))) + "Return non-nil if LIST is of LENGTH. +This is a compatibility shim for `length=' in Emacs 28. +\n(fn LIST LENGTH)") + +(defun dash--zip-lists-or-pair (_form &rest lists) + "Return a form equivalent to applying `-zip' to LISTS. +This `compiler-macro' warns about discouraged `-zip' usage and +delegates to `-zip-lists' or `-zip-pair' depending on the number +of LISTS." + (if (not (dash--length= lists 2)) + (cons #'-zip-lists lists) + (let ((pair (cons #'-zip-pair lists)) + (msg "Use -zip-pair instead of -zip to get a list of pairs")) + (if (fboundp 'macroexp-warn-and-return) + (macroexp-warn-and-return msg pair) + (message msg) + pair)))) + +(defun -zip (&rest lists) + "Zip LISTS together. + +Group the head of each list, followed by the second element of +each list, and so on. The number of returned groupings is equal +to the length of the shortest input list, and the number of items +in each grouping is equal to the number of input LISTS. + +If only two LISTS are provided as arguments, return the groupings +as a list of dotted pairs. Otherwise, return the groupings as a +list of proper lists. + +Since the return value changes form depending on the number of +arguments, it is generally recommended to use `-zip-lists' +instead, or `-zip-pair' if a list of dotted pairs is desired. + +See also: `-unzip'." + (declare (compiler-macro dash--zip-lists-or-pair) + (pure t) (side-effect-free t)) + ;; For backward compatibility, return a list of dotted pairs if two + ;; arguments were provided. + (apply (if (dash--length= lists 2) #'-zip-pair #'-zip-lists) lists)) + +(defun -zip-pair (&rest lists) + "Zip LIST1 and LIST2 together. + +Make a pair with the head of each list, followed by a pair with +the second element of each list, and so on. The number of pairs +returned is equal to the length of the shorter input list. + +See also: `-zip-lists'." + (declare (advertised-calling-convention (list1 list2) "2.20.0") + (pure t) (side-effect-free t)) + (if (dash--length= lists 2) + (--zip-with (cons it other) (car lists) (cadr lists)) + (apply #'-zip-lists lists))) + +(defun -zip-fill (fill-value &rest lists) + "Zip LISTS together, padding shorter lists with FILL-VALUE. +This is like `-zip' (which see), except it retains all elements +at positions beyond the end of the shortest list. The number of +returned groupings is equal to the length of the longest input +list, and the length of each grouping is equal to the number of +input LISTS. + +Since the return value changes form depending on the number of +arguments, it is generally recommended to use `-zip-lists-fill' +instead, unless a list of dotted pairs is explicitly desired." + (declare (pure t) (side-effect-free t)) + (cond ((null lists) ()) + ((dash--length= lists 2) + (let ((list1 (car lists)) + (list2 (cadr lists)) + results) + (while (or list1 list2) + (push (cons (if list1 (pop list1) fill-value) + (if list2 (pop list2) fill-value)) + results)) + (nreverse results))) + ((apply #'-zip-lists-fill fill-value lists)))) + +(defun -unzip (lists) + "Unzip LISTS. + +This works just like `-zip' (which see), but takes a list of +lists instead of a variable number of arguments, such that + + (-unzip (-zip L1 L2 L3 ...)) + +is identity (given that the lists are of the same length, and +that `-zip' is not called with two arguments, because of the +caveat described in its docstring). + +Note in particular that calling `-unzip' on a list of two lists +will return a list of dotted pairs. + +Since the return value changes form depending on the number of +LISTS, it is generally recommended to use `-unzip-lists' instead." + (declare (pure t) (side-effect-free t)) + (apply #'-zip lists)) + +(defun -cycle (list) + "Return an infinite circular copy of LIST. +The returned list cycles through the elements of LIST and repeats +from the beginning." + (declare (pure t) (side-effect-free t)) + ;; Also works with sequences that aren't lists. + (let ((newlist (append list ()))) + (nconc newlist newlist))) + +(defun -pad (fill-value &rest lists) + "Pad each of LISTS with FILL-VALUE until they all have equal lengths. + +Ensure all LISTS are as long as the longest one by repeatedly +appending FILL-VALUE to the shorter lists, and return the +resulting LISTS." + (declare (pure t) (side-effect-free t)) + (let* ((lens (mapcar #'length lists)) + (maxlen (apply #'max 0 lens))) + (--map (append it (make-list (- maxlen (pop lens)) fill-value)) lists))) + +(defmacro --annotate (form list) + "Pair each item in LIST with the result of evaluating FORM. + +Return an alist of (RESULT . ITEM), where each ITEM is the +corresponding element of LIST, and RESULT is the value obtained +by evaluating FORM with ITEM bound to `it'. + +This is the anaphoric counterpart to `-annotate'." + (declare (debug (form form))) + `(--map (cons ,form it) ,list)) + +(defun -annotate (fn list) + "Pair each item in LIST with the result of passing it to FN. + +Return an alist of (RESULT . ITEM), where each ITEM is the +corresponding element of LIST, and RESULT is the value obtained +by calling FN on ITEM. + +This function's anaphoric counterpart is `--annotate'." + (declare (important-return-value t)) + (--annotate (funcall fn it) list)) + +(defun dash--table-carry (lists restore-lists &optional re) + "Helper for `-table' and `-table-flat'. + +If a list overflows, carry to the right and reset the list." + (while (not (or (car lists) + (equal lists '(nil)))) + (setcar lists (car restore-lists)) + (pop (cadr lists)) + (!cdr lists) + (!cdr restore-lists) + (when re + (push (nreverse (car re)) (cadr re)) + (setcar re nil) + (!cdr re)))) + +(defun -table (fn &rest lists) + "Compute outer product of LISTS using function FN. + +The function FN should have the same arity as the number of +supplied lists. + +The outer product is computed by applying fn to all possible +combinations created by taking one element from each list in +order. The dimension of the result is (length lists). + +See also: `-table-flat'" + (declare (important-return-value t)) + (let ((restore-lists (copy-sequence lists)) + (last-list (last lists)) + (re (make-list (length lists) nil))) + (while (car last-list) + (let ((item (apply fn (-map 'car lists)))) + (push item (car re)) + (setcar lists (cdar lists)) ;; silence byte compiler + (dash--table-carry lists restore-lists re))) + (nreverse (car (last re))))) + +(defun -table-flat (fn &rest lists) + "Compute flat outer product of LISTS using function FN. + +The function FN should have the same arity as the number of +supplied lists. + +The outer product is computed by applying fn to all possible +combinations created by taking one element from each list in +order. The results are flattened, ignoring the tensor structure +of the result. This is equivalent to calling: + + (-flatten-n (1- (length lists)) (apply \\='-table fn lists)) + +but the implementation here is much more efficient. + +See also: `-flatten-n', `-table'" + (declare (important-return-value t)) + (let ((restore-lists (copy-sequence lists)) + (last-list (last lists)) + re) + (while (car last-list) + (let ((item (apply fn (-map 'car lists)))) + (push item re) + (setcar lists (cdar lists)) ;; silence byte compiler + (dash--table-carry lists restore-lists))) + (nreverse re))) + +(defmacro --find-index (form list) + "Return the first index in LIST for which FORM evals to non-nil. +Return nil if no such index is found. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-index'." + (declare (debug (form form))) + `(--some (and ,form it-index) ,list)) + +(defun -find-index (pred list) + "Return the index of the first item satisfying PRED in LIST. +Return nil if no such item is found. + +PRED is called with one argument, the current list element, until +it returns non-nil, at which point the search terminates. + +This function's anaphoric counterpart is `--find-index'. + +See also: `-first', `-find-last-index'." + (declare (important-return-value t)) + (--find-index (funcall pred it) list)) + +(defun -elem-index (elem list) + "Return the first index of ELEM in LIST. +That is, the index within LIST of the first element that is +`equal' to ELEM. Return nil if there is no such element. + +See also: `-find-index'." + (declare (pure t) (side-effect-free t)) + (--find-index (equal elem it) list)) + +(defmacro --find-indices (form list) + "Return the list of indices in LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-indices'." + (declare (debug (form form))) + `(--keep (and ,form it-index) ,list)) + +(defun -find-indices (pred list) + "Return the list of indices in LIST satisfying PRED. + +Each element of LIST in turn is passed to PRED. If the result is +non-nil, the index of that element in LIST is included in the +result. The returned indices are in ascending order, i.e., in +the same order as they appear in LIST. + +This function's anaphoric counterpart is `--find-indices'. + +See also: `-find-index', `-elem-indices'." + (declare (important-return-value t)) + (--find-indices (funcall pred it) list)) + +(defun -elem-indices (elem list) + "Return the list of indices at which ELEM appears in LIST. +That is, the indices of all elements of LIST `equal' to ELEM, in +the same ascending order as they appear in LIST." + (declare (pure t) (side-effect-free t)) + (--find-indices (equal elem it) list)) + +(defmacro --find-last-index (form list) + "Return the last index in LIST for which FORM evals to non-nil. +Return nil if no such index is found. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-last-index'." + (declare (debug (form form))) + (let ((i (make-symbol "index"))) + `(let (,i) + (--each ,list + (when ,form (setq ,i it-index))) + ,i))) + +(defun -find-last-index (pred list) + "Return the index of the last item satisfying PRED in LIST. +Return nil if no such item is found. + +Predicate PRED is called with one argument each time, namely the +current list element. + +This function's anaphoric counterpart is `--find-last-index'. + +See also: `-last', `-find-index'." + (declare (important-return-value t)) + (--find-last-index (funcall pred it) list)) + +(defun -select-by-indices (indices list) + "Return a list whose elements are elements from LIST selected +as `(nth i list)` for all i from INDICES." + (declare (pure t) (side-effect-free t)) + (let (r) + (--each indices + (!cons (nth it list) r)) + (nreverse r))) + +(defun -select-columns (columns table) + "Select COLUMNS from TABLE. + +TABLE is a list of lists where each element represents one row. +It is assumed each row has the same length. + +Each row is transformed such that only the specified COLUMNS are +selected. + +See also: `-select-column', `-select-by-indices'" + (declare (pure t) (side-effect-free t)) + (--map (-select-by-indices columns it) table)) + +(defun -select-column (column table) + "Select COLUMN from TABLE. + +TABLE is a list of lists where each element represents one row. +It is assumed each row has the same length. + +The single selected column is returned as a list. + +See also: `-select-columns', `-select-by-indices'" + (declare (pure t) (side-effect-free t)) + (--mapcat (-select-by-indices (list column) it) table)) + +(defmacro -> (x &optional form &rest more) + "Thread the expr through the forms. Insert X as the second item +in the first form, making a list of it if it is not a list +already. If there are more forms, insert the first form as the +second item in second form, etc." + (declare (debug (form &rest [&or symbolp (sexp &rest form)]))) + (cond + ((null form) x) + ((null more) (if (listp form) + `(,(car form) ,x ,@(cdr form)) + (list form x))) + (:else `(-> (-> ,x ,form) ,@more)))) + +(defmacro ->> (x &optional form &rest more) + "Thread the expr through the forms. Insert X as the last item +in the first form, making a list of it if it is not a list +already. If there are more forms, insert the first form as the +last item in second form, etc." + (declare (debug ->)) + (cond + ((null form) x) + ((null more) (if (listp form) + `(,@form ,x) + (list form x))) + (:else `(->> (->> ,x ,form) ,@more)))) + +(defmacro --> (x &rest forms) + "Starting with the value of X, thread each expression through FORMS. + +Insert X at the position signified by the symbol `it' in the first +form. If there are more forms, insert the first form at the position +signified by `it' in in second form, etc." + (declare (debug (form body))) + `(-as-> ,x it ,@forms)) + +(defmacro -as-> (value variable &rest forms) + "Starting with VALUE, thread VARIABLE through FORMS. + +In the first form, bind VARIABLE to VALUE. In the second form, bind +VARIABLE to the result of the first form, and so forth." + (declare (debug (form symbolp body))) + (if (null forms) + `,value + `(let ((,variable ,value)) + (-as-> ,(if (symbolp (car forms)) + (list (car forms) variable) + (car forms)) + ,variable + ,@(cdr forms))))) + +(defmacro -some-> (x &optional form &rest more) + "When expr is non-nil, thread it through the first form (via `->'), +and when that result is non-nil, through the next form, etc." + (declare (debug ->) + (indent 1)) + (if (null form) x + (let ((result (make-symbol "result"))) + `(-some-> (-when-let (,result ,x) + (-> ,result ,form)) + ,@more)))) + +(defmacro -some->> (x &optional form &rest more) + "When expr is non-nil, thread it through the first form (via `->>'), +and when that result is non-nil, through the next form, etc." + (declare (debug ->) + (indent 1)) + (if (null form) x + (let ((result (make-symbol "result"))) + `(-some->> (-when-let (,result ,x) + (->> ,result ,form)) + ,@more)))) + +(defmacro -some--> (expr &rest forms) + "Thread EXPR through FORMS via `-->', while the result is non-nil. +When EXPR evaluates to non-nil, thread the result through the +first of FORMS, and when that result is non-nil, thread it +through the next form, etc." + (declare (debug (form &rest &or symbolp consp)) (indent 1)) + (if (null forms) expr + (let ((result (make-symbol "result"))) + `(-some--> (-when-let (,result ,expr) + (--> ,result ,(car forms))) + ,@(cdr forms))))) + +(defmacro -doto (init &rest forms) + "Evaluate INIT and pass it as argument to FORMS with `->'. +The RESULT of evaluating INIT is threaded through each of FORMS +individually using `->', which see. The return value is RESULT, +which FORMS may have modified by side effect." + (declare (debug (form &rest &or symbolp consp)) (indent 1)) + (let ((retval (make-symbol "result"))) + `(let ((,retval ,init)) + ,@(mapcar (lambda (form) `(-> ,retval ,form)) forms) + ,retval))) + +(defmacro --doto (init &rest forms) + "Anaphoric form of `-doto'. +This just evaluates INIT, binds the result to `it', evaluates +FORMS, and returns the final value of `it'. +Note: `it' need not be used in each form." + (declare (debug (form body)) (indent 1)) + `(let ((it ,init)) + ,@forms + it)) + +(defun -grade-up (comparator list) + "Grade elements of LIST using COMPARATOR relation. +This yields a permutation vector such that applying this +permutation to LIST sorts it in ascending order." + (declare (important-return-value t)) + (->> (--map-indexed (cons it it-index) list) + (-sort (lambda (it other) (funcall comparator (car it) (car other)))) + (mapcar #'cdr))) + +(defun -grade-down (comparator list) + "Grade elements of LIST using COMPARATOR relation. +This yields a permutation vector such that applying this +permutation to LIST sorts it in descending order." + (declare (important-return-value t)) + (->> (--map-indexed (cons it it-index) list) + (-sort (lambda (it other) (funcall comparator (car other) (car it)))) + (mapcar #'cdr))) + +(defvar dash--source-counter 0 + "Monotonic counter for generated symbols.") + +(defun dash--match-make-source-symbol () + "Generate a new dash-source symbol. + +All returned symbols are guaranteed to be unique." + (prog1 (make-symbol (format "--dash-source-%d--" dash--source-counter)) + (setq dash--source-counter (1+ dash--source-counter)))) + +(defun dash--match-ignore-place-p (symbol) + "Return non-nil if SYMBOL is a symbol and starts with _." + (and (symbolp symbol) + (eq (aref (symbol-name symbol) 0) ?_))) + +(defun dash--match-cons-skip-cdr (skip-cdr source) + "Helper function generating idiomatic shifting code." + (cond + ((= skip-cdr 0) + `(pop ,source)) + (t + `(prog1 ,(dash--match-cons-get-car skip-cdr source) + (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source)))))) + +(defun dash--match-cons-get-car (skip-cdr source) + "Helper function generating idiomatic code to get nth car." + (cond + ((= skip-cdr 0) + `(car ,source)) + ((= skip-cdr 1) + `(cadr ,source)) + (t + `(nth ,skip-cdr ,source)))) + +(defun dash--match-cons-get-cdr (skip-cdr source) + "Helper function generating idiomatic code to get nth cdr." + (cond + ((= skip-cdr 0) + source) + ((= skip-cdr 1) + `(cdr ,source)) + (t + `(nthcdr ,skip-cdr ,source)))) + +(defun dash--match-cons (match-form source) + "Setup a cons matching environment and call the real matcher." + (let ((s (dash--match-make-source-symbol)) + (n 0) + (m match-form)) + (while (and (consp m) + (dash--match-ignore-place-p (car m))) + (setq n (1+ n)) (!cdr m)) + (cond + ;; when we only have one pattern in the list, we don't have to + ;; create a temporary binding (--dash-source--) for the source + ;; and just use the input directly + ((and (consp m) + (not (cdr m))) + (dash--match (car m) (dash--match-cons-get-car n source))) + ;; handle other special types + ((> n 0) + (dash--match m (dash--match-cons-get-cdr n source))) + ;; this is the only entry-point for dash--match-cons-1, that's + ;; why we can't simply use the above branch, it would produce + ;; infinite recursion + (t + (cons (list s source) (dash--match-cons-1 match-form s)))))) + +(defun dash--get-expand-function (type) + "Get expand function name for TYPE." + (intern-soft (format "dash-expand:%s" type))) + +(defun dash--match-cons-1 (match-form source &optional props) + "Match MATCH-FORM against SOURCE. + +MATCH-FORM is a proper or improper list. Each element of +MATCH-FORM is either a symbol, which gets bound to the respective +value in source or another match form which gets destructured +recursively. + +If the cdr of last cons cell in the list is nil, matching stops +there. + +SOURCE is a proper or improper list." + (let ((skip-cdr (or (plist-get props :skip-cdr) 0))) + (cond + ((consp match-form) + (cond + ((cdr match-form) + (cond + ((and (symbolp (car match-form)) + (functionp (dash--get-expand-function (car match-form)))) + (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source))) + ((dash--match-ignore-place-p (car match-form)) + (dash--match-cons-1 (cdr match-form) source + (plist-put props :skip-cdr (1+ skip-cdr)))) + (t + (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source)) + (dash--match-cons-1 (cdr match-form) source))))) + (t ;; Last matching place, no need for shift + (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source))))) + ((eq match-form nil) + nil) + (t ;; Handle improper lists. Last matching place, no need for shift + (dash--match match-form (dash--match-cons-get-cdr skip-cdr source)))))) + +(defun dash--match-vector (match-form source) + "Setup a vector matching environment and call the real matcher." + (let ((s (dash--match-make-source-symbol))) + (cond + ;; don't bind `s' if we only have one sub-pattern + ((= (length match-form) 1) + (dash--match (aref match-form 0) `(aref ,source 0))) + ;; if the source is a symbol, we don't need to re-bind it + ((symbolp source) + (dash--match-vector-1 match-form source)) + ;; don't bind `s' if we only have one sub-pattern which is not ignored + ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form)) + (ignored-places-n (length (-remove 'null ignored-places)))) + (when (= ignored-places-n (1- (length match-form))) + (let ((n (-find-index 'null ignored-places))) + (dash--match (aref match-form n) `(aref ,source ,n)))))) + (t + (cons (list s source) (dash--match-vector-1 match-form s)))))) + +(defun dash--match-vector-1 (match-form source) + "Match MATCH-FORM against SOURCE. + +MATCH-FORM is a vector. Each element of MATCH-FORM is either a +symbol, which gets bound to the respective value in source or +another match form which gets destructured recursively. + +If second-from-last place in MATCH-FORM is the symbol &rest, the +next element of the MATCH-FORM is matched against the tail of +SOURCE, starting at index of the &rest symbol. This is +conceptually the same as the (head . tail) match for improper +lists, where dot plays the role of &rest. + +SOURCE is a vector. + +If the MATCH-FORM vector is shorter than SOURCE vector, only +the (length MATCH-FORM) places are bound, the rest of the SOURCE +is discarded." + (let ((i 0) + (l (length match-form)) + (re)) + (while (< i l) + (let ((m (aref match-form i))) + (push (cond + ((and (symbolp m) + (eq m '&rest)) + (prog1 (dash--match + (aref match-form (1+ i)) + `(substring ,source ,i)) + (setq i l))) + ((and (symbolp m) + ;; do not match symbols starting with _ + (not (eq (aref (symbol-name m) 0) ?_))) + (list (list m `(aref ,source ,i)))) + ((not (symbolp m)) + (dash--match m `(aref ,source ,i)))) + re) + (setq i (1+ i)))) + (-flatten-n 1 (nreverse re)))) + +(defun dash--match-kv-normalize-match-form (pattern) + "Normalize kv PATTERN. + +This method normalizes PATTERN to the format expected by +`dash--match-kv'. See `-let' for the specification." + (let ((normalized (list (car pattern))) + (skip nil) + (fill-placeholder (make-symbol "--dash-fill-placeholder--"))) + (-each (-zip-fill fill-placeholder (cdr pattern) (cddr pattern)) + (lambda (pair) + (let ((current (car pair)) + (next (cdr pair))) + (if skip + (setq skip nil) + (if (or (eq fill-placeholder next) + (not (or (and (symbolp next) + (not (keywordp next)) + (not (eq next t)) + (not (eq next nil))) + (and (consp next) + (not (eq (car next) 'quote))) + (vectorp next)))) + (progn + (cond + ((keywordp current) + (push current normalized) + (push (intern (substring (symbol-name current) 1)) normalized)) + ((stringp current) + (push current normalized) + (push (intern current) normalized)) + ((and (consp current) + (eq (car current) 'quote)) + (push current normalized) + (push (cadr current) normalized)) + (t (error "-let: found key `%s' in kv destructuring but its pattern `%s' is invalid and can not be derived from the key" current next))) + (setq skip nil)) + (push current normalized) + (push next normalized) + (setq skip t)))))) + (nreverse normalized))) + +(defun dash--match-kv (match-form source) + "Setup a kv matching environment and call the real matcher. + +kv can be any key-value store, such as plist, alist or hash-table." + (let ((s (dash--match-make-source-symbol))) + (cond + ;; don't bind `s' if we only have one sub-pattern (&type key val) + ((= (length match-form) 3) + (dash--match-kv-1 (cdr match-form) source (car match-form))) + ;; if the source is a symbol, we don't need to re-bind it + ((symbolp source) + (dash--match-kv-1 (cdr match-form) source (car match-form))) + (t + (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form))))))) + +(defun dash-expand:&hash (key source) + "Generate extracting KEY from SOURCE for &hash destructuring." + `(gethash ,key ,source)) + +(defun dash-expand:&plist (key source) + "Generate extracting KEY from SOURCE for &plist destructuring." + `(plist-get ,source ,key)) + +(defun dash-expand:&alist (key source) + "Generate extracting KEY from SOURCE for &alist destructuring." + `(cdr (assoc ,key ,source))) + +(defun dash-expand:&hash? (key source) + "Generate extracting KEY from SOURCE for &hash? destructuring. +Similar to &hash but check whether the map is not nil." + (let ((src (make-symbol "src"))) + `(let ((,src ,source)) + (when ,src (gethash ,key ,src))))) + +(defalias 'dash-expand:&keys 'dash-expand:&plist) + +(defun dash--match-kv-1 (match-form source type) + "Match MATCH-FORM against SOURCE of type TYPE. + +MATCH-FORM is a proper list of the form (key1 place1 ... keyN +placeN). Each placeK is either a symbol, which gets bound to the +value of keyK retrieved from the key-value store, or another +match form which gets destructured recursively. + +SOURCE is a key-value store of type TYPE, which can be a plist, +an alist or a hash table. + +TYPE is a token specifying the type of the key-value store. +Valid values are &plist, &alist and &hash." + (-flatten-n 1 (-map + (lambda (kv) + (let* ((k (car kv)) + (v (cadr kv)) + (getter + (funcall (dash--get-expand-function type) k source))) + (cond + ((symbolp v) + (list (list v getter))) + (t (dash--match v getter))))) + (-partition 2 match-form)))) + +(defun dash--match-symbol (match-form source) + "Bind a symbol. + +This works just like `let', there is no destructuring." + (list (list match-form source))) + +(defun dash--match (match-form source) + "Match MATCH-FORM against SOURCE. + +This function tests the MATCH-FORM and dispatches to specific +matchers based on the type of the expression. + +Key-value stores are disambiguated by placing a token &plist, +&alist or &hash as a first item in the MATCH-FORM." + (cond + ((and (symbolp match-form) + ;; Don't bind things like &keys as if they were vars (#395). + (not (functionp (dash--get-expand-function match-form)))) + (dash--match-symbol match-form source)) + ((consp match-form) + (cond + ;; Handle the "x &as" bindings first. + ((and (consp (cdr match-form)) + (symbolp (car match-form)) + (eq '&as (cadr match-form))) + (let ((s (car match-form))) + (cons (list s source) + (dash--match (cddr match-form) s)))) + ((functionp (dash--get-expand-function (car match-form))) + (dash--match-kv (dash--match-kv-normalize-match-form match-form) source)) + (t (dash--match-cons match-form source)))) + ((vectorp match-form) + ;; We support the &as binding in vectors too + (cond + ((and (> (length match-form) 2) + (symbolp (aref match-form 0)) + (eq '&as (aref match-form 1))) + (let ((s (aref match-form 0))) + (cons (list s source) + (dash--match (substring match-form 2) s)))) + (t (dash--match-vector match-form source)))))) + +(defun dash--normalize-let-varlist (varlist) + "Normalize VARLIST so that every binding is a list. + +`let' allows specifying a binding which is not a list but simply +the place which is then automatically bound to nil, such that all +three of the following are identical and evaluate to nil. + + (let (a) a) + (let ((a)) a) + (let ((a nil)) a) + +This function normalizes all of these to the last form." + (--map (if (consp it) it (list it nil)) varlist)) + +(defmacro -let* (varlist &rest body) + "Bind variables according to VARLIST then eval BODY. + +VARLIST is a list of lists of the form (PATTERN SOURCE). Each +PATTERN is matched against the SOURCE structurally. SOURCE is +only evaluated once for each PATTERN. + +Each SOURCE can refer to the symbols already bound by this +VARLIST. This is useful if you want to destructure SOURCE +recursively but also want to name the intermediate structures. + +See `-let' for the list of all possible patterns." + (declare (debug ((&rest [&or (sexp form) sexp]) body)) + (indent 1)) + (let* ((varlist (dash--normalize-let-varlist varlist)) + (bindings (--mapcat (dash--match (car it) (cadr it)) varlist))) + `(let* ,bindings + ,@body))) + +(defmacro -let (varlist &rest body) + "Bind variables according to VARLIST then eval BODY. + +VARLIST is a list of lists of the form (PATTERN SOURCE). Each +PATTERN is matched against the SOURCE \"structurally\". SOURCE +is only evaluated once for each PATTERN. Each PATTERN is matched +recursively, and can therefore contain sub-patterns which are +matched against corresponding sub-expressions of SOURCE. + +All the SOURCEs are evalled before any symbols are +bound (i.e. \"in parallel\"). + +If VARLIST only contains one (PATTERN SOURCE) element, you can +optionally specify it using a vector and discarding the +outer-most parens. Thus + + (-let ((PATTERN SOURCE)) ...) + +becomes + + (-let [PATTERN SOURCE] ...). + +`-let' uses a convention of not binding places (symbols) starting +with _ whenever it's possible. You can use this to skip over +entries you don't care about. However, this is not *always* +possible (as a result of implementation) and these symbols might +get bound to undefined values. + +Following is the overview of supported patterns. Remember that +patterns can be matched recursively, so every a, b, aK in the +following can be a matching construct and not necessarily a +symbol/variable. + +Symbol: + + a - bind the SOURCE to A. This is just like regular `let'. + +Conses and lists: + + (a) - bind `car' of cons/list to A + + (a . b) - bind car of cons to A and `cdr' to B + + (a b) - bind car of list to A and `cadr' to B + + (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3... + + (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST. + +Vectors: + + [a] - bind 0th element of a non-list sequence to A (works with + vectors, strings, bit arrays...) + + [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to + A1, 2nd to A2, ... + If the PATTERN is shorter than SOURCE, the values at + places not in PATTERN are ignored. + If the PATTERN is longer than SOURCE, an `error' is + thrown. + + [a1 a2 a3 ... &rest rest] - as above, but bind the rest of + the sequence to REST. This is + conceptually the same as improper list + matching (a1 a2 ... aN . rest) + +Key/value stores: + + (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE plist to aK. If the + value is not found, aK is nil. + Uses `plist-get' to fetch values. + + (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE alist to aK. If the + value is not found, aK is nil. + Uses `assoc' to fetch values. + + (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE hash table to aK. If the + value is not found, aK is nil. + Uses `gethash' to fetch values. + +Further, special keyword &keys supports \"inline\" matching of +plist-like key-value pairs, similarly to &keys keyword of +`cl-defun'. + + (a1 a2 ... aN &keys key1 b1 ... keyN bK) + +This binds N values from the list to a1 ... aN, then interprets +the cdr as a plist (see key/value matching above). + +A shorthand notation for kv-destructuring exists which allows the +patterns be optionally left out and derived from the key name in +the following fashion: + +- a key :foo is converted into `foo' pattern, +- a key \\='bar is converted into `bar' pattern, +- a key \"baz\" is converted into `baz' pattern. + +That is, the entire value under the key is bound to the derived +variable without any further destructuring. + +This is possible only when the form following the key is not a +valid pattern (i.e. not a symbol, a cons cell or a vector). +Otherwise the matching proceeds as usual and in case of an +invalid spec fails with an error. + +Thus the patterns are normalized as follows: + + ;; derive all the missing patterns + (&plist :foo \\='bar \"baz\") => (&plist :foo foo \\='bar bar \"baz\" baz) + + ;; we can specify some but not others + (&plist :foo \\='bar explicit-bar) => (&plist :foo foo \\='bar explicit-bar) + + ;; nothing happens, we store :foo in x + (&plist :foo x) => (&plist :foo x) + + ;; nothing happens, we match recursively + (&plist :foo (a b c)) => (&plist :foo (a b c)) + +You can name the source using the syntax SYMBOL &as PATTERN. +This syntax works with lists (proper or improper), vectors and +all types of maps. + + (list &as a b c) (list 1 2 3) + +binds A to 1, B to 2, C to 3 and LIST to (1 2 3). + +Similarly: + + (bounds &as beg . end) (cons 1 2) + +binds BEG to 1, END to 2 and BOUNDS to (1 . 2). + + (items &as first . rest) (list 1 2 3) + +binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3) + + [vect &as _ b c] [1 2 3] + +binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual). + + (plist &as &plist :b b) (list :a 1 :b 2 :c 3) + +binds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and &hash. + +This is especially useful when we want to capture the result of a +computation and destructure at the same time. Consider the +form (function-returning-complex-structure) returning a list of +two vectors with two items each. We want to capture this entire +result and pass it to another computation, but at the same time +we want to get the second item from each vector. We can achieve +it with pattern + + (result &as [_ a] [_ b]) (function-returning-complex-structure) + +Note: Clojure programmers may know this feature as the \":as +binding\". The difference is that we put the &as at the front +because we need to support improper list binding." + (declare (debug ([&or (&rest [&or (sexp form) sexp]) + (vector [&rest [sexp form]])] + body)) + (indent 1)) + (if (vectorp varlist) + `(let* ,(dash--match (aref varlist 0) (aref varlist 1)) + ,@body) + (let* ((varlist (dash--normalize-let-varlist varlist)) + (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist)) + (new-varlist (--zip-with (list (car it) (car other)) + varlist inputs))) + `(let ,inputs + (-let* ,new-varlist ,@body))))) + +(defmacro -lambda (match-form &rest body) + "Return a lambda which destructures its input as MATCH-FORM and executes BODY. + +Note that you have to enclose the MATCH-FORM in a pair of parens, +such that: + + (-lambda (x) body) + (-lambda (x y ...) body) + +has the usual semantics of `lambda'. Furthermore, these get +translated into normal `lambda', so there is no performance +penalty. + +See `-let' for a description of the destructuring mechanism." + (declare (doc-string 2) (indent defun) + (debug (&define sexp + [&optional stringp] + [&optional ("interactive" interactive)] + def-body))) + (cond + ((nlistp match-form) + (signal 'wrong-type-argument (list #'listp match-form))) + ;; No destructuring, so just return regular `lambda' for speed. + ((-all? #'symbolp match-form) + `(lambda ,match-form ,@body)) + ((let ((inputs (--map-indexed + (list it (make-symbol (format "input%d" it-index))) + match-form))) + ;; TODO: because inputs to the `lambda' are evaluated only once, + ;; `-let*' need not create the extra bindings to ensure that. + ;; We should find a way to optimize that. Not critical however. + `(lambda ,(mapcar #'cadr inputs) + (-let* ,inputs ,@body)))))) + +(defmacro -setq (&rest forms) + "Bind each MATCH-FORM to the value of its VAL. + +MATCH-FORM destructuring is done according to the rules of `-let'. + +This macro allows you to bind multiple variables by destructuring +the value, so for example: + + (-setq (a b) x + (&plist :c c) plist) + +expands roughly speaking to the following code + + (setq a (car x) + b (cadr x) + c (plist-get plist :c)) + +Care is taken to only evaluate each VAL once so that in case of +multiple assignments it does not cause unexpected side effects. + +\(fn [MATCH-FORM VAL]...)" + (declare (debug (&rest sexp form)) + (indent 1)) + (when (= (mod (length forms) 2) 1) + (signal 'wrong-number-of-arguments (list '-setq (1+ (length forms))))) + (let* ((forms-and-sources + ;; First get all the necessary mappings with all the + ;; intermediate bindings. + (-map (lambda (x) (dash--match (car x) (cadr x))) + (-partition 2 forms))) + ;; To preserve the logic of dynamic scoping we must ensure + ;; that we `setq' the variables outside of the `let*' form + ;; which holds the destructured intermediate values. For + ;; this we generate for each variable a placeholder which is + ;; bound to (lexically) the result of the destructuring. + ;; Then outside of the helper `let*' form we bind all the + ;; original variables to their respective placeholders. + ;; TODO: There is a lot of room for possible optimization, + ;; for start playing with `special-variable-p' to eliminate + ;; unnecessary re-binding. + (variables-to-placeholders + (-mapcat + (lambda (bindings) + (-map + (lambda (binding) + (let ((var (car binding))) + (list var (make-symbol (concat "--dash-binding-" (symbol-name var) "--"))))) + (--filter (not (string-prefix-p "--" (symbol-name (car it)))) bindings))) + forms-and-sources))) + `(let ,(-map 'cadr variables-to-placeholders) + (let* ,(-flatten-n 1 forms-and-sources) + (setq ,@(-flatten (-map 'reverse variables-to-placeholders)))) + (setq ,@(-flatten variables-to-placeholders))))) + +(defmacro -if-let* (vars-vals then &rest else) + "If all VALS evaluate to true, bind them to their corresponding +VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list +of (VAR VAL) pairs. + +Note: binding is done according to `-let*'. VALS are evaluated +sequentially, and evaluation stops after the first nil VAL is +encountered." + (declare (debug ((&rest (sexp form)) form body)) + (indent 2)) + (->> vars-vals + (--mapcat (dash--match (car it) (cadr it))) + (--reduce-r-from + (let ((var (car it)) + (val (cadr it))) + `(let ((,var ,val)) + (if ,var ,acc ,@else))) + then))) + +(defmacro -if-let (var-val then &rest else) + "If VAL evaluates to non-nil, bind it to VAR and do THEN, +otherwise do ELSE. + +Note: binding is done according to `-let'. + +\(fn (VAR VAL) THEN &rest ELSE)" + (declare (debug ((sexp form) form body)) + (indent 2)) + `(-if-let* (,var-val) ,then ,@else)) + +(defmacro --if-let (val then &rest else) + "If VAL evaluates to non-nil, bind it to symbol `it' and do THEN, +otherwise do ELSE." + (declare (debug (form form body)) + (indent 2)) + `(-if-let (it ,val) ,then ,@else)) + +(defmacro -when-let* (vars-vals &rest body) + "If all VALS evaluate to true, bind them to their corresponding +VARS and execute body. VARS-VALS should be a list of (VAR VAL) +pairs. + +Note: binding is done according to `-let*'. VALS are evaluated +sequentially, and evaluation stops after the first nil VAL is +encountered." + (declare (debug ((&rest (sexp form)) body)) + (indent 1)) + `(-if-let* ,vars-vals (progn ,@body))) + +(defmacro -when-let (var-val &rest body) + "If VAL evaluates to non-nil, bind it to VAR and execute body. + +Note: binding is done according to `-let'. + +\(fn (VAR VAL) &rest BODY)" + (declare (debug ((sexp form) body)) + (indent 1)) + `(-if-let ,var-val (progn ,@body))) + +(defmacro --when-let (val &rest body) + "If VAL evaluates to non-nil, bind it to symbol `it' and +execute body." + (declare (debug (form body)) + (indent 1)) + `(--if-let ,val (progn ,@body))) + +;; TODO: Get rid of this dynamic variable, passing it as an argument +;; instead? +(defvar -compare-fn nil + "Tests for equality use this function, or `equal' if this is nil. + +As a dynamic variable, this should be temporarily bound around +the relevant operation, rather than permanently modified. For +example: + + (let ((-compare-fn #\\='=)) + (-union \\='(1 2 3) \\='(2 3 4)))") + +(defun dash--member-fn () + "Return the flavor of `member' that goes best with `-compare-fn'." + (declare (side-effect-free error-free)) + (let ((cmp -compare-fn)) + (cond ((memq cmp '(nil equal)) #'member) + ((eq cmp #'eq) #'memq) + ((eq cmp #'eql) #'memql) + ((lambda (elt list) + (while (and list (not (funcall cmp elt (car list)))) + (pop list)) + list))))) + +(defun dash--assoc-fn () + "Return the flavor of `assoc' that goes best with `-compare-fn'." + (declare (side-effect-free error-free)) + (let ((cmp -compare-fn)) + (cond ((memq cmp '(nil equal)) #'assoc) + ((eq cmp #'eq) #'assq) + ;; Since Emacs 26, `assoc' accepts a custom `testfn'. + ;; Version testing would be simpler here, but feature + ;; testing gets more brownie points, I guess. + ((condition-case nil + (with-no-warnings (assoc nil () #'eql)) + (wrong-number-of-arguments t)) + (lambda (key alist) + (--first (and (consp it) (funcall cmp (car it) key)) alist))) + ((with-no-warnings + (lambda (key alist) + (assoc key alist cmp))))))) + +(defun dash--hash-test-fn () + "Return the hash table test function corresponding to `-compare-fn'. +Return nil if `-compare-fn' is not a known test function." + (declare (side-effect-free error-free)) + ;; In theory this could also recognize values that are custom + ;; `hash-table-test's, but too often the :test name is different + ;; from the equality function, so it doesn't seem worthwhile. + (car (memq (or -compare-fn #'equal) '(equal eq eql)))) + +(defvar dash--short-list-length 32 + "Maximum list length considered short, for optimizations. +For example, the speedup afforded by hash table lookup may start +to outweigh its runtime and memory overhead for problem sizes +greater than this value. See also the discussion in PR #305.") + +(defun -distinct (list) + "Return a copy of LIST with all duplicate elements removed. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil. + +Alias: `-uniq'." + (declare (important-return-value t)) + (let (test len) + (cond ((null list) ()) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the list is long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (--filter (unless (gethash it ht) (puthash it t ht)) list))) + ((let ((member (dash--member-fn)) uniq) + (--each list (unless (funcall member it uniq) (push it uniq))) + (nreverse uniq)))))) + +(defalias '-uniq #'-distinct) + +(defun dash--size+ (size1 size2) + "Return the sum of nonnegative fixnums SIZE1 and SIZE2. +Return `most-positive-fixnum' on overflow. This ensures the +result is a valid size, particularly for allocating hash tables, +even in the presence of bignum support." + (declare (side-effect-free t)) + (if (< size1 (- most-positive-fixnum size2)) + (+ size1 size2) + most-positive-fixnum)) + +(defun -union (list1 list2) + "Return a new list of distinct elements appearing in either LIST1 or LIST2. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let ((lists (list list1 list2)) test len union) + (cond ((null (or list1 list2))) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the lists are long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (dash--size+ (length list1) (length list2))) + dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (dolist (l lists) + (--each l (unless (gethash it ht) + (puthash it t ht) + (push it union)))))) + ((let ((member (dash--member-fn))) + (dolist (l lists) + (--each l (unless (funcall member it union) (push it union))))))) + (nreverse union))) + +(defun -intersection (list1 list2) + "Return a new list of distinct elements appearing in both LIST1 and LIST2. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let (test len) + (cond ((null (and list1 list2)) ()) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and either list is long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list2)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (--each list2 (puthash it t ht)) + ;; Remove visited elements to avoid duplicates. + (--filter (when (gethash it ht) (remhash it ht) t) list1))) + ((let ((member (dash--member-fn)) intersection) + (--each list1 (and (funcall member it list2) + (not (funcall member it intersection)) + (push it intersection))) + (nreverse intersection)))))) + +(defun -difference (list1 list2) + "Return a new list with the distinct members of LIST1 that are not in LIST2. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let (test len1 len2) + (cond ((null list1) ()) + ((null list2) (-distinct list1)) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the subtrahend is long enough. + ((and (setq test (dash--hash-test-fn)) + (setq len1 (length list1)) + (setq len2 (length list2)) + (> (max len1 len2) dash--short-list-length)) + (let ((ht1 (make-hash-table :test test :size len1)) + (ht2 (make-hash-table :test test :size len2))) + (--each list2 (puthash it t ht2)) + ;; Avoid duplicates by tracking visited items in `ht1'. + (--filter (unless (or (gethash it ht2) (gethash it ht1)) + (puthash it t ht1)) + list1))) + ((let ((member (dash--member-fn)) difference) + (--each list1 + (unless (or (funcall member it list2) + (funcall member it difference)) + (push it difference))) + (nreverse difference)))))) + +(defun -powerset (list) + "Return the power set of LIST." + (declare (pure t) (side-effect-free t)) + (if (null list) (list ()) + (let ((last (-powerset (cdr list)))) + (nconc (mapcar (lambda (x) (cons (car list) x)) last) + last)))) + +(defun -frequencies (list) + "Count the occurrences of each distinct element of LIST. + +Return an alist of (ELEMENT . N), where each ELEMENT occurs N +times in LIST. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil. + +See also `-count' and `-group-by'." + (declare (important-return-value t)) + (let (test len freqs) + (cond ((null list)) + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + ;; Share structure between hash table and returned list. + ;; This affords a single pass that preserves the input + ;; order, conses less garbage, and is faster than a + ;; second traversal (e.g., with `maphash'). + (--each list + (let ((freq (gethash it ht))) + (if freq + (setcdr freq (1+ (cdr freq))) + (push (puthash it (cons it 1) ht) freqs)))))) + ((let ((assoc (dash--assoc-fn))) + (--each list + (let ((freq (funcall assoc it freqs))) + (if freq + (setcdr freq (1+ (cdr freq))) + (push (cons it 1) freqs))))))) + (nreverse freqs))) + +(defun dash--numbers<= (nums) + "Return non-nil if NUMS is a list of non-decreasing numbers." + (declare (pure t) (side-effect-free t)) + (or (null nums) + (let ((prev (pop nums))) + (and (numberp prev) + (--every (and (numberp it) (<= prev (setq prev it))) nums))))) + +(defun dash--next-lex-perm (array n) + "Update ARRAY of N numbers with its next lexicographic permutation. +Return nil if there is no such successor. N should be nonzero. + +This implements the salient steps of Algorithm L (Lexicographic +permutation generation) as described in DE Knuth's The Art of +Computer Programming, Volume 4A / Combinatorial Algorithms, +Part I, Addison-Wesley, 2011, § 7.2.1.2, p. 319." + (setq n (1- n)) + (let* ((l n) + (j (1- n)) + (al (aref array n)) + (aj al)) + ;; L2. [Find j]. + ;; Decrement j until a[j] < a[j+1]. + (while (and (<= 0 j) + (<= aj (setq aj (aref array j)))) + (setq j (1- j))) + ;; Terminate algorithm if j not found. + (when (>= j 0) + ;; L3. [Increase a[j]]. + ;; Decrement l until a[j] < a[l]. + (while (>= aj al) + (setq l (1- l) al (aref array l))) + ;; Swap a[j] and a[l]. + (aset array j al) + (aset array l aj) + ;; L4. [Reverse a[j+1]...a[n]]. + (setq l n) + (while (< (setq j (1+ j)) l) + (setq aj (aref array j)) + (aset array j (aref array l)) + (aset array l aj) + (setq l (1- l))) + array))) + +(defun dash--lex-perms (vec &optional original) + "Return a list of permutations of VEC in lexicographic order. +Specifically, return only the successors of VEC in lexicographic +order. Each returned permutation is a list. VEC should comprise +one or more numbers, and may be destructively modified. + +If ORIGINAL is a vector, then VEC is interpreted as a set of +indices into ORIGINAL. In this case, the indices are permuted, +and the resulting index permutations are used to dereference +elements of ORIGINAL." + (let ((len (length vec)) perms) + (while vec + (push (if original + (--map (aref original it) vec) + (append vec ())) + perms) + (setq vec (dash--next-lex-perm vec len))) + (nreverse perms))) + +(defun dash--uniq-perms (list) + "Return a list of permutations of LIST. +LIST is treated as if all its elements are distinct." + (let* ((vec (vconcat list)) + (idxs (copy-sequence vec))) + ;; Just construct a vector of the list's indices and permute that. + (dotimes (i (length idxs)) + (aset idxs i i)) + (dash--lex-perms idxs vec))) + +(defun dash--multi-perms (list freqs) + "Return a list of permutations of the multiset LIST. +FREQS should be an alist describing the frequency of each element +in LIST, as returned by `-frequencies'." + (let (;; Distinct items in `list', aka the cars of `freqs'. + (uniq (make-vector (length freqs) nil)) + ;; Indices into `uniq'. + (idxs (make-vector (length list) nil)) + ;; Current index into `idxs'. + (i 0)) + (--each freqs + (aset uniq it-index (car it)) + ;; Populate `idxs' with as many copies of each `it-index' as + ;; there are corresponding duplicates. + (dotimes (_ (cdr it)) + (aset idxs i it-index) + (setq i (1+ i)))) + (dash--lex-perms idxs uniq))) + +(defun -permutations (list) + "Return the distinct permutations of LIST. + +Duplicate elements of LIST are determined by `equal', or by +`-compare-fn' if that is non-nil." + (declare (important-return-value t)) + (cond ((null list) (list ())) + ;; Optimization: a traversal of `list' is faster than the + ;; round trip via `dash--uniq-perms' or `dash--multi-perms'. + ((dash--numbers<= list) + (dash--lex-perms (vconcat list))) + ((let ((freqs (-frequencies list))) + ;; Is each element distinct? + (unless (--every (= (cdr it) 1) freqs) + (dash--multi-perms list freqs)))) + ((dash--uniq-perms list)))) + +(defun -inits (list) + "Return all prefixes of LIST." + (declare (pure t) (side-effect-free t)) + (let ((res (list list))) + (setq list (reverse list)) + (while list + (push (reverse (!cdr list)) res)) + res)) + +(defun -tails (list) + "Return all suffixes of LIST." + (declare (pure t) (side-effect-free t)) + (-reductions-r-from #'cons nil list)) + +(defun -common-prefix (&rest lists) + "Return the longest common prefix of LISTS." + (declare (pure t) (side-effect-free t)) + (--reduce (--take-while (and acc (equal (pop acc) it)) it) + lists)) + +(defun -common-suffix (&rest lists) + "Return the longest common suffix of LISTS." + (declare (pure t) (side-effect-free t)) + (nreverse (apply #'-common-prefix (mapcar #'reverse lists)))) + +(defun -contains? (list element) + "Return non-nil if LIST contains ELEMENT. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil. As with `member', the return value is +actually the tail of LIST whose car is ELEMENT. + +Alias: `-contains-p'." + (declare (important-return-value t)) + (funcall (dash--member-fn) element list)) + +(defalias '-contains-p #'-contains?) + +(defun -same-items? (list1 list2) + "Return non-nil if LIST1 and LIST2 have the same distinct elements. + +The order of the elements in the lists does not matter. The +lists may be of different lengths, i.e., contain duplicate +elements. The test for equality is done with `equal', or with +`-compare-fn' if that is non-nil. + +Alias: `-same-items-p'." + (declare (important-return-value t)) + (let (test len1 len2) + (cond ((null (or list1 list2))) + ((null (and list1 list2)) nil) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and either list is long enough. + ((and (setq test (dash--hash-test-fn)) + (setq len1 (length list1)) + (setq len2 (length list2)) + (> (max len1 len2) dash--short-list-length)) + (let ((ht1 (make-hash-table :test test :size len1)) + (ht2 (make-hash-table :test test :size len2))) + (--each list1 (puthash it t ht1)) + ;; Move visited elements from `ht1' to `ht2'. This way, + ;; if visiting all of `list2' leaves `ht1' empty, then + ;; all elements from both lists have been accounted for. + (and (--every (cond ((gethash it ht1) + (remhash it ht1) + (puthash it t ht2)) + ((gethash it ht2))) + list2) + (zerop (hash-table-count ht1))))) + ((let ((member (dash--member-fn))) + (and (--all? (funcall member it list2) list1) + (--all? (funcall member it list1) list2))))))) + +(defalias '-same-items-p #'-same-items?) + +(defun -is-prefix? (prefix list) + "Return non-nil if PREFIX is a prefix of LIST. + +Alias: `-is-prefix-p'." + (declare (pure t) (side-effect-free t)) + (--each-while list (and (equal (car prefix) it) + (!cdr prefix))) + (null prefix)) + +(defun -is-suffix? (suffix list) + "Return non-nil if SUFFIX is a suffix of LIST. + +Alias: `-is-suffix-p'." + (declare (pure t) (side-effect-free t)) + (equal suffix (last list (length suffix)))) + +(defun -is-infix? (infix list) + "Return non-nil if INFIX is infix of LIST. + +This operation runs in O(n^2) time + +Alias: `-is-infix-p'" + (declare (pure t) (side-effect-free t)) + (let (done) + (while (and (not done) list) + (setq done (-is-prefix? infix list)) + (!cdr list)) + done)) + +(defalias '-is-prefix-p '-is-prefix?) +(defalias '-is-suffix-p '-is-suffix?) +(defalias '-is-infix-p '-is-infix?) + +(defun -sort (comparator list) + "Sort LIST, stably, comparing elements using COMPARATOR. +Return the sorted list. LIST is NOT modified by side effects. +COMPARATOR is called with two elements of LIST, and should return non-nil +if the first element should sort before the second." + (declare (important-return-value t)) + (sort (copy-sequence list) comparator)) + +(defmacro --sort (form list) + "Anaphoric form of `-sort'." + (declare (debug (def-form form))) + `(-sort (lambda (it other) (ignore it other) ,form) ,list)) + +(defun -list (&optional arg &rest args) + "Ensure ARG is a list. +If ARG is already a list, return it as is (not a copy). +Otherwise, return a new list with ARG as its only element. + +Another supported calling convention is (-list &rest ARGS). +In this case, if ARG is not a list, a new list with all of +ARGS as elements is returned. This use is supported for +backward compatibility and is otherwise deprecated." + (declare (advertised-calling-convention (arg) "2.18.0") + (pure t) (side-effect-free error-free)) + (if (listp arg) arg (cons arg args))) + +(defun -repeat (n x) + "Return a new list of length N with each element being X. +Return nil if N is less than 1." + (declare (side-effect-free t)) + (and (>= n 0) (make-list n x))) + +(defun -sum (list) + "Return the sum of LIST." + (declare (pure t) (side-effect-free t)) + (apply #'+ list)) + +(defun -running-sum (list) + "Return a list with running sums of items in LIST. +LIST must be non-empty." + (declare (pure t) (side-effect-free t)) + (or list (signal 'wrong-type-argument (list #'consp list))) + (-reductions #'+ list)) + +(defun -product (list) + "Return the product of LIST." + (declare (pure t) (side-effect-free t)) + (apply #'* list)) + +(defun -running-product (list) + "Return a list with running products of items in LIST. +LIST must be non-empty." + (declare (pure t) (side-effect-free t)) + (or list (signal 'wrong-type-argument (list #'consp list))) + (-reductions #'* list)) + +(defun -max (list) + "Return the largest value from LIST of numbers or markers." + (declare (pure t) (side-effect-free t)) + (apply #'max list)) + +(defun -min (list) + "Return the smallest value from LIST of numbers or markers." + (declare (pure t) (side-effect-free t)) + (apply #'min list)) + +(defun -max-by (comparator list) + "Take a comparison function COMPARATOR and a LIST and return +the greatest element of the list by the comparison function. + +See also combinator `-on' which can transform the values before +comparing them." + (declare (important-return-value t)) + (--reduce (if (funcall comparator it acc) it acc) list)) + +(defun -min-by (comparator list) + "Take a comparison function COMPARATOR and a LIST and return +the least element of the list by the comparison function. + +See also combinator `-on' which can transform the values before +comparing them." + (declare (important-return-value t)) + (--reduce (if (funcall comparator it acc) acc it) list)) + +(defmacro --max-by (form list) + "Anaphoric version of `-max-by'. + +The items for the comparator form are exposed as \"it\" and \"other\"." + (declare (debug (def-form form))) + `(-max-by (lambda (it other) (ignore it other) ,form) ,list)) + +(defmacro --min-by (form list) + "Anaphoric version of `-min-by'. + +The items for the comparator form are exposed as \"it\" and \"other\"." + (declare (debug (def-form form))) + `(-min-by (lambda (it other) (ignore it other) ,form) ,list)) + +(defun -iota (count &optional start step) + "Return a list containing COUNT numbers. +Starts from START and adds STEP each time. The default START is +zero, the default STEP is 1. +This function takes its name from the corresponding primitive in +the APL language." + (declare (side-effect-free t)) + (unless (natnump count) + (signal 'wrong-type-argument (list #'natnump count))) + (or start (setq start 0)) + (or step (setq step 1)) + (if (zerop step) + (make-list count start) + (--iterate (+ it step) start count))) + +(defun -fix (fn list) + "Compute the (least) fixpoint of FN with initial input LIST. + +FN is called at least once, results are compared with `equal'." + (declare (important-return-value t)) + (let ((re (funcall fn list))) + (while (not (equal list re)) + (setq list re) + (setq re (funcall fn re))) + re)) + +(defmacro --fix (form list) + "Anaphoric form of `-fix'." + (declare (debug (def-form form))) + `(-fix (lambda (it) (ignore it) ,form) ,list)) + +(defun -unfold (fun seed) + "Build a list from SEED using FUN. + +This is \"dual\" operation to `-reduce-r': while -reduce-r +consumes a list to produce a single value, `-unfold' takes a +seed value and builds a (potentially infinite!) list. + +FUN should return nil to stop the generating process, or a +cons (A . B), where A will be prepended to the result and B is +the new seed." + (declare (important-return-value t)) + (let ((last (funcall fun seed)) r) + (while last + (push (car last) r) + (setq last (funcall fun (cdr last)))) + (nreverse r))) + +(defmacro --unfold (form seed) + "Anaphoric version of `-unfold'." + (declare (debug (def-form form))) + `(-unfold (lambda (it) (ignore it) ,form) ,seed)) + +(defun -cons-pair? (obj) + "Return non-nil if OBJ is a true cons pair. +That is, a cons (A . B) where B is not a list. + +Alias: `-cons-pair-p'." + (declare (pure t) (side-effect-free error-free)) + (nlistp (cdr-safe obj))) + +(defalias '-cons-pair-p '-cons-pair?) + +(defun -cons-to-list (con) + "Convert a cons pair to a list with `car' and `cdr' of the pair respectively." + (declare (pure t) (side-effect-free t)) + (list (car con) (cdr con))) + +(defun -value-to-list (val) + "Convert a value to a list. + +If the value is a cons pair, make a list with two elements, `car' +and `cdr' of the pair respectively. + +If the value is anything else, wrap it in a list." + (declare (pure t) (side-effect-free t)) + (if (-cons-pair? val) (-cons-to-list val) (list val))) + +(defun -tree-mapreduce-from (fn folder init-value tree) + "Apply FN to each element of TREE, and make a list of the results. +If elements of TREE are lists themselves, apply FN recursively to +elements of these nested lists. + +Then reduce the resulting lists using FOLDER and initial value +INIT-VALUE. See `-reduce-r-from'. + +This is the same as calling `-tree-reduce-from' after `-tree-map' +but is twice as fast as it only traverse the structure once." + (declare (important-return-value t)) + (cond + ((null tree) ()) + ((-cons-pair? tree) (funcall fn tree)) + ((consp tree) + (-reduce-r-from + folder init-value + (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) + ((funcall fn tree)))) + +(defmacro --tree-mapreduce-from (form folder init-value tree) + "Anaphoric form of `-tree-mapreduce-from'." + (declare (debug (def-form def-form form form))) + `(-tree-mapreduce-from (lambda (it) (ignore it) ,form) + (lambda (it acc) (ignore it acc) ,folder) + ,init-value + ,tree)) + +(defun -tree-mapreduce (fn folder tree) + "Apply FN to each element of TREE, and make a list of the results. +If elements of TREE are lists themselves, apply FN recursively to +elements of these nested lists. + +Then reduce the resulting lists using FOLDER and initial value +INIT-VALUE. See `-reduce-r-from'. + +This is the same as calling `-tree-reduce' after `-tree-map' +but is twice as fast as it only traverse the structure once." + (declare (important-return-value t)) + (cond + ((null tree) ()) + ((-cons-pair? tree) (funcall fn tree)) + ((consp tree) + (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) + ((funcall fn tree)))) + +(defmacro --tree-mapreduce (form folder tree) + "Anaphoric form of `-tree-mapreduce'." + (declare (debug (def-form def-form form))) + `(-tree-mapreduce (lambda (it) (ignore it) ,form) + (lambda (it acc) (ignore it acc) ,folder) + ,tree)) + +(defun -tree-map (fn tree) + "Apply FN to each element of TREE while preserving the tree structure." + (declare (important-return-value t)) + (cond + ((null tree) ()) + ((-cons-pair? tree) (funcall fn tree)) + ((consp tree) + (mapcar (lambda (x) (-tree-map fn x)) tree)) + ((funcall fn tree)))) + +(defmacro --tree-map (form tree) + "Anaphoric form of `-tree-map'." + (declare (debug (def-form form))) + `(-tree-map (lambda (it) (ignore it) ,form) ,tree)) + +(defun -tree-reduce-from (fn init-value tree) + "Use FN to reduce elements of list TREE. +If elements of TREE are lists themselves, apply the reduction recursively. + +FN is first applied to INIT-VALUE and first element of the list, +then on this result and second element from the list etc. + +The initial value is ignored on cons pairs as they always contain +two elements." + (declare (important-return-value t)) + (cond + ((null tree) ()) + ((-cons-pair? tree) tree) + ((consp tree) + (-reduce-r-from + fn init-value + (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) + (tree))) + +(defmacro --tree-reduce-from (form init-value tree) + "Anaphoric form of `-tree-reduce-from'." + (declare (debug (def-form form form))) + `(-tree-reduce-from (lambda (it acc) (ignore it acc) ,form) + ,init-value ,tree)) + +(defun -tree-reduce (fn tree) + "Use FN to reduce elements of list TREE. +If elements of TREE are lists themselves, apply the reduction recursively. + +FN is first applied to first element of the list and second +element, then on this result and third element from the list etc. + +See `-reduce-r' for how exactly are lists of zero or one element handled." + (declare (important-return-value t)) + (cond + ((null tree) ()) + ((-cons-pair? tree) tree) + ((consp tree) + (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) + (tree))) + +(defmacro --tree-reduce (form tree) + "Anaphoric form of `-tree-reduce'." + (declare (debug (def-form form))) + `(-tree-reduce (lambda (it acc) (ignore it acc) ,form) ,tree)) + +(defun -tree-map-nodes (pred fun tree) + "Call FUN on each node of TREE that satisfies PRED. + +If PRED returns nil, continue descending down this node. If PRED +returns non-nil, apply FUN to this node and do not descend +further." + (cond ((funcall pred tree) (funcall fun tree)) + ((and (listp tree) (listp (cdr tree))) + (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)) + (tree))) + +(defmacro --tree-map-nodes (pred form tree) + "Anaphoric form of `-tree-map-nodes'." + (declare (debug (def-form def-form form))) + `(-tree-map-nodes (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,form) + ,tree)) + +(defun -tree-seq (branch children tree) + "Return a sequence of the nodes in TREE, in depth-first search order. + +BRANCH is a predicate of one argument that returns non-nil if the +passed argument is a branch, that is, a node that can have children. + +CHILDREN is a function of one argument that returns the children +of the passed branch node. + +Non-branch nodes are simply copied." + (declare (important-return-value t)) + (cons tree + (and (funcall branch tree) + (-mapcat (lambda (x) (-tree-seq branch children x)) + (funcall children tree))))) + +(defmacro --tree-seq (branch children tree) + "Anaphoric form of `-tree-seq'." + (declare (debug (def-form def-form form))) + `(-tree-seq (lambda (it) (ignore it) ,branch) + (lambda (it) (ignore it) ,children) + ,tree)) + +(defun -clone (list) + "Create a deep copy of LIST. +The new list has the same elements and structure but all cons are +replaced with new ones. This is useful when you need to clone a +structure such as plist or alist." + (declare (side-effect-free t)) + (-tree-map #'identity list)) + +;;; Combinators + +(defalias '-partial #'apply-partially) + +(defun -rpartial (fn &rest args) + "Return a function that is a partial application of FN to ARGS. +ARGS is a list of the last N arguments to pass to FN. The result +is a new function which does the same as FN, except that the last +N arguments are fixed at the values with which this function was +called. This is like `-partial', except the arguments are fixed +starting from the right rather than the left." + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest args-before) (apply fn (append args-before args)))) + +(defun -juxt (&rest fns) + "Return a function that is the juxtaposition of FNS. +The returned function takes a variable number of ARGS, applies +each of FNS in turn to ARGS, and returns the list of results." + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns))) + +(defun -compose (&rest fns) + "Compose FNS into a single composite function. +Return a function that takes a variable number of ARGS, applies +the last function in FNS to ARGS, and returns the result of +calling each remaining function on the result of the previous +function, right-to-left. If no FNS are given, return a variadic +`identity' function." + (declare (pure t) (side-effect-free error-free)) + (let* ((fns (nreverse fns)) + (head (car fns)) + (tail (cdr fns))) + (cond (tail + (lambda (&rest args) + (--reduce-from (funcall it acc) (apply head args) tail))) + (fns head) + ((lambda (&optional arg &rest _) arg))))) + +(defun -applify (fn) + "Return a function that applies FN to a single list of args. +This changes the arity of FN from taking N distinct arguments to +taking 1 argument which is a list of N arguments." + (declare (pure t) (side-effect-free error-free)) + (lambda (args) (apply fn args))) + +(defun -on (op trans) + "Return a function that calls TRANS on each arg and OP on the results. +The returned function takes a variable number of arguments, calls +the function TRANS on each one in turn, and then passes those +results as the list of arguments to OP, in the same order. + +For example, the following pairs of expressions are morally +equivalent: + + (funcall (-on #\\='+ #\\='1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3)) + (funcall (-on #\\='+ #\\='1+)) = (+)" + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest args) + ;; This unrolling seems to be a relatively cheap way to keep the + ;; overhead of `mapcar' + `apply' in check. + (cond ((cddr args) + (apply op (mapcar trans args))) + ((cdr args) + (funcall op (funcall trans (car args)) (funcall trans (cadr args)))) + (args + (funcall op (funcall trans (car args)))) + ((funcall op))))) + +(defun -flip (fn) + "Return a function that calls FN with its arguments reversed. +The returned function takes the same number of arguments as FN. + +For example, the following two expressions are morally +equivalent: + + (funcall (-flip #\\='-) 1 2) = (- 2 1) + +See also: `-rotate-args'." + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest args) ;; Open-code for speed. + (cond ((cddr args) (apply fn (nreverse args))) + ((cdr args) (funcall fn (cadr args) (car args))) + (args (funcall fn (car args))) + ((funcall fn))))) + +(defun -rotate-args (n fn) + "Return a function that calls FN with args rotated N places to the right. +The returned function takes the same number of arguments as FN, +rotates the list of arguments N places to the right (left if N is +negative) just like `-rotate', and applies FN to the result. + +See also: `-flip'." + (declare (pure t) (side-effect-free t)) + (if (zerop n) + fn + (let ((even (= (% n 2) 0))) + (lambda (&rest args) + (cond ((cddr args) ;; Open-code for speed. + (apply fn (-rotate n args))) + ((cdr args) + (let ((fst (car args)) + (snd (cadr args))) + (funcall fn (if even fst snd) (if even snd fst)))) + (args + (funcall fn (car args))) + ((funcall fn))))))) + +(defun -const (c) + "Return a function that returns C ignoring any additional arguments. + +In types: a -> b -> a" + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest _) c)) + +(defmacro -cut (&rest params) + "Take n-ary function and n arguments and specialize some of them. +Arguments denoted by <> will be left unspecialized. + +See SRFI-26 for detailed description." + (declare (debug (&optional sexp &rest &or "<>" form))) + (let* ((i 0) + (args (--keep (when (eq it '<>) + (setq i (1+ i)) + (make-symbol (format "D%d" i))) + params))) + `(lambda ,args + ,(let ((body (--map (if (eq it '<>) (pop args) it) params))) + (if (eq (car params) '<>) + (cons #'funcall body) + body))))) + +(defun -not (pred) + "Return a predicate that negates the result of PRED. +The returned predicate passes its arguments to PRED. If PRED +returns nil, the result is non-nil; otherwise the result is nil. + +See also: `-andfn' and `-orfn'." + (declare (pure t) (side-effect-free error-free)) + (lambda (&rest args) (not (apply pred args)))) + +(defun -orfn (&rest preds) + "Return a predicate that returns the first non-nil result of PREDS. +The returned predicate takes a variable number of arguments, +passes them to each predicate in PREDS in turn until one of them +returns non-nil, and returns that non-nil result without calling +the remaining PREDS. If all PREDS return nil, or if no PREDS are +given, the returned predicate returns nil. + +See also: `-andfn' and `-not'." + (declare (pure t) (side-effect-free error-free)) + ;; Open-code for speed. + (cond ((cdr preds) (lambda (&rest args) (--some (apply it args) preds))) + (preds (car preds)) + (#'ignore))) + +(defun -andfn (&rest preds) + "Return a predicate that returns non-nil if all PREDS do so. +The returned predicate P takes a variable number of arguments and +passes them to each predicate in PREDS in turn. If any one of +PREDS returns nil, P also returns nil without calling the +remaining PREDS. If all PREDS return non-nil, P returns the last +such value. If no PREDS are given, P always returns non-nil. + +See also: `-orfn' and `-not'." + (declare (pure t) (side-effect-free error-free)) + ;; Open-code for speed. + (cond ((cdr preds) (lambda (&rest args) (--every (apply it args) preds))) + (preds (car preds)) + ;; As a `pure' function, this runtime check may generate + ;; backward-incompatible bytecode for `(-andfn)' at compile-time, + ;; but I doubt that's a problem in practice (famous last words). + ((fboundp 'always) #'always) + ((lambda (&rest _) t)))) + +(defun -iteratefn (fn n) + "Return a function FN composed N times with itself. + +FN is a unary function. If you need to use a function of higher +arity, use `-applify' first to turn it into a unary function. + +With n = 0, this acts as identity function. + +In types: (a -> a) -> Int -> a -> a. + +This function satisfies the following law: + + (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." + (declare (pure t) (side-effect-free error-free)) + (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) + +(defun -counter (&optional beg end inc) + "Return a closure that counts from BEG to END, with increment INC. + +The closure will return the next value in the counting sequence +each time it is called, and nil after END is reached. BEG +defaults to 0, INC defaults to 1, and if END is nil, the counter +will increment indefinitely. + +The closure accepts any number of arguments, which are discarded." + (declare (pure t) (side-effect-free error-free)) + (let ((inc (or inc 1)) + (n (or beg 0))) + (lambda (&rest _) + (when (or (not end) (< n end)) + (prog1 n + (setq n (+ n inc))))))) + +(defvar -fixfn-max-iterations 1000 + "The default maximum number of iterations performed by `-fixfn' + unless otherwise specified.") + +(defun -fixfn (fn &optional equal-test halt-test) + "Return a function that computes the (least) fixpoint of FN. + +FN must be a unary function. The returned lambda takes a single +argument, X, the initial value for the fixpoint iteration. The +iteration halts when either of the following conditions is satisfied: + + 1. Iteration converges to the fixpoint, with equality being + tested using EQUAL-TEST. If EQUAL-TEST is not specified, + `equal' is used. For functions over the floating point + numbers, it may be necessary to provide an appropriate + approximate comparison test. + + 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a + simple counter that returns t after `-fixfn-max-iterations', + to guard against infinite iteration. Otherwise, HALT-TEST + must be a function that accepts a single argument, the + current value of X, and returns non-nil as long as iteration + should continue. In this way, a more sophisticated + convergence test may be supplied by the caller. + +The return value of the lambda is either the fixpoint or, if +iteration halted before converging, a cons with car `halted' and +cdr the final output from HALT-TEST. + +In types: (a -> a) -> a -> a." + (declare (important-return-value t)) + (let ((eqfn (or equal-test 'equal)) + (haltfn (or halt-test + (-not + (-counter 0 -fixfn-max-iterations))))) + (lambda (x) + (let ((re (funcall fn x)) + (halt? (funcall haltfn x))) + (while (and (not halt?) (not (funcall eqfn x re))) + (setq x re + re (funcall fn re) + halt? (funcall haltfn re))) + (if halt? (cons 'halted halt?) + re))))) + +(defun -prodfn (&rest fns) + "Return a function that applies each of FNS to each of a list of arguments. + +Takes a list of N functions and returns a function that takes a +list of length N, applying Ith function to Ith element of the +input list. Returns a list of length N. + +In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + +This function satisfies the following laws: + + (-compose (-prodfn f g ...) + (-prodfn f\\=' g\\=' ...)) + = (-prodfn (-compose f f\\=') + (-compose g g\\=') + ...) + + (-prodfn f g ...) + = (-juxt (-compose f (-partial #\\='nth 0)) + (-compose g (-partial #\\='nth 1)) + ...) + + (-compose (-prodfn f g ...) + (-juxt f\\=' g\\=' ...)) + = (-juxt (-compose f f\\=') + (-compose g g\\=') + ...) + + (-compose (-partial #\\='nth n) + (-prod f1 f2 ...)) + = (-compose fn (-partial #\\='nth n))" + (declare (pure t) (side-effect-free t)) + (lambda (x) (--zip-with (funcall it other) fns x))) + +;;; Font lock + +(defvar dash--keywords + `(;; TODO: Do not fontify the following automatic variables + ;; globally; detect and limit to their local anaphoric scope. + (,(rx symbol-start (| "acc" "it" "it-index" "other") symbol-end) + 0 font-lock-variable-name-face) + ;; Macros in dev/examples.el. Based on `lisp-mode-symbol-regexp'. + (,(rx ?\( (group (| "defexamples" "def-example-group")) symbol-end + (+ (in "\t ")) + (group (* (| (syntax word) (syntax symbol) (: ?\\ nonl))))) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face)) + ;; Symbols in dev/examples.el. + ,(rx symbol-start (| "=>" "~>" "!!>") symbol-end) + ;; Elisp macro fontification was static prior to Emacs 25. + ,@(when (< emacs-major-version 25) + (let ((macs '("!cdr" + "!cons" + "-->" + "--all-p" + "--all?" + "--annotate" + "--any" + "--any-p" + "--any?" + "--count" + "--dotimes" + "--doto" + "--drop-while" + "--each" + "--each-indexed" + "--each-r" + "--each-r-while" + "--each-while" + "--every" + "--every-p" + "--every?" + "--filter" + "--find" + "--find-index" + "--find-indices" + "--find-last-index" + "--first" + "--fix" + "--group-by" + "--if-let" + "--iterate" + "--keep" + "--last" + "--map" + "--map-first" + "--map-indexed" + "--map-last" + "--map-when" + "--mapcat" + "--max-by" + "--min-by" + "--none-p" + "--none?" + "--only-some-p" + "--only-some?" + "--partition-after-pred" + "--partition-by" + "--partition-by-header" + "--reduce" + "--reduce-from" + "--reduce-r" + "--reduce-r-from" + "--reductions" + "--reductions-from" + "--reductions-r" + "--reductions-r-from" + "--reject" + "--reject-first" + "--reject-last" + "--remove" + "--remove-first" + "--remove-last" + "--replace-where" + "--select" + "--separate" + "--some" + "--some-p" + "--some?" + "--sort" + "--splice" + "--splice-list" + "--split-when" + "--split-with" + "--take-while" + "--tree-map" + "--tree-map-nodes" + "--tree-mapreduce" + "--tree-mapreduce-from" + "--tree-reduce" + "--tree-reduce-from" + "--tree-seq" + "--unfold" + "--update-at" + "--when-let" + "--zip-with" + "->" + "->>" + "-as->" + "-cut" + "-doto" + "-if-let" + "-if-let*" + "-lambda" + "-let" + "-let*" + "-setq" + "-some-->" + "-some->" + "-some->>" + "-split-on" + "-when-let" + "-when-let*"))) + `((,(concat "(" (regexp-opt macs 'symbols)) . 1))))) + "Font lock keywords for `dash-fontify-mode'.") + +(defcustom dash-fontify-mode-lighter nil + "Mode line lighter for `dash-fontify-mode'. +Either a string to display in the mode line when +`dash-fontify-mode' is on, or nil to display +nothing (the default)." + :package-version '(dash . "2.18.0") + :type '(choice (string :tag "Lighter" :value " Dash") + (const :tag "Nothing" nil))) + +;;;###autoload +(define-minor-mode dash-fontify-mode + "Toggle fontification of Dash special variables. + +Dash-Fontify mode is a buffer-local minor mode intended for Emacs +Lisp buffers. Enabling it causes the special variables bound in +anaphoric Dash macros to be fontified. These anaphoras include +`it', `it-index', `acc', and `other'. In older Emacs versions +which do not dynamically detect macros, Dash-Fontify mode +additionally fontifies Dash macro calls. + +See also `dash-fontify-mode-lighter' and +`global-dash-fontify-mode'." + :lighter dash-fontify-mode-lighter + (if dash-fontify-mode + (font-lock-add-keywords nil dash--keywords t) + (font-lock-remove-keywords nil dash--keywords)) + (cond ((fboundp 'font-lock-flush) ;; Added in Emacs 25. + (font-lock-flush)) + ;; `font-lock-fontify-buffer' unconditionally enables + ;; `font-lock-mode' and is marked `interactive-only' in later + ;; Emacs versions which have `font-lock-flush', so we guard + ;; and pacify as needed, respectively. + (font-lock-mode + (with-no-warnings + (font-lock-fontify-buffer))))) + +(defun dash--turn-on-fontify-mode () + "Enable `dash-fontify-mode' if in an Emacs Lisp buffer." + (when (derived-mode-p #'emacs-lisp-mode) + (dash-fontify-mode))) + +;;;###autoload +(define-globalized-minor-mode global-dash-fontify-mode + dash-fontify-mode dash--turn-on-fontify-mode) + +(defcustom dash-enable-fontlock nil + "If non-nil, fontify Dash macro calls and special variables." + :set (lambda (sym val) + (set-default sym val) + (global-dash-fontify-mode (if val 1 0))) + :type 'boolean) + +(make-obsolete-variable + 'dash-enable-fontlock #'global-dash-fontify-mode "2.18.0") + +(define-obsolete-function-alias + 'dash-enable-font-lock #'global-dash-fontify-mode "2.18.0") + +;;; Info + +(defvar dash--info-doc-spec '("(dash) Index" nil "^ -+ .*: " "\\( \\|$\\)") + "The Dash :doc-spec entry for `info-lookup-alist'. +It is based on that for `emacs-lisp-mode'.") + +(defun dash--info-elisp-docs () + "Return the `emacs-lisp-mode' symbol docs from `info-lookup-alist'. +Specifically, return the cons containing their +`info-lookup->doc-spec' so that we can modify it." + (defvar info-lookup-alist) + (nthcdr 3 (assq #'emacs-lisp-mode (cdr (assq 'symbol info-lookup-alist))))) + +;;;###autoload +(defun dash-register-info-lookup () + "Register the Dash Info manual with `info-lookup-symbol'. +This allows Dash symbols to be looked up with \\[info-lookup-symbol]." + (interactive) + (require 'info-look) + (let ((docs (dash--info-elisp-docs))) + (setcar docs (append (car docs) (list dash--info-doc-spec))) + (info-lookup-reset))) + +(defun dash-unload-function () + "Remove Dash from `info-lookup-alist'. +Used by `unload-feature', which see." + (let ((docs (and (featurep 'info-look) + (dash--info-elisp-docs)))) + (when (member dash--info-doc-spec (car docs)) + (setcar docs (remove dash--info-doc-spec (car docs))) + (info-lookup-reset))) + nil) + +(provide 'dash) +;;; dash.el ends here diff --git a/elpa/dash-20230714.723/dash.info b/elpa/dash-20230714.723/dash.info new file mode 100644 index 00000000..a99d3237 --- /dev/null +++ b/elpa/dash-20230714.723/dash.info @@ -0,0 +1,4948 @@ +This is dash.info, produced by makeinfo version 6.7 from dash.texi. + +This manual is for Dash version 2.19.1. + + Copyright © 2012–2023 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with the Invariant Sections being “GNU General Public + License,” and no Front-Cover Texts or Back-Cover Texts. A copy of + the license is included in the section entitled “GNU Free + Documentation License”. +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Dash: (dash.info). A modern list library for GNU Emacs. +END-INFO-DIR-ENTRY + + +File: dash.info, Node: Top, Next: Installation, Up: (dir) + +Dash +**** + +This manual is for Dash version 2.19.1. + + Copyright © 2012–2023 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with the Invariant Sections being “GNU General Public + License,” and no Front-Cover Texts or Back-Cover Texts. A copy of + the license is included in the section entitled “GNU Free + Documentation License”. + +* Menu: + +* Installation:: Installing and configuring Dash. +* Functions:: Dash API reference. +* Development:: Contributing to Dash development. + +Appendices + +* FDL:: The license for this documentation. +* GPL:: Conditions for copying and changing Dash. +* Index:: Index including functions and macros. + + — The Detailed Node Listing — + +Installation + +* Using in a package:: Listing Dash as a package dependency. +* Fontification of special variables:: Font Lock of anaphoric macro variables. +* Info symbol lookup:: Looking up Dash symbols in this manual. + +Functions + +* Maps:: +* Sublist selection:: +* List to list:: +* Reductions:: +* Unfolding:: +* Predicates:: +* Partitioning:: +* Indexing:: +* Set operations:: +* Other list operations:: +* Tree operations:: +* Threading macros:: +* Binding:: +* Side effects:: +* Destructive operations:: +* Function combinators:: + +Development + +* Contribute:: How to contribute. +* Contributors:: List of contributors. + + +File: dash.info, Node: Installation, Next: Functions, Prev: Top, Up: Top + +1 Installation +************** + +Dash is available on GNU ELPA (https://elpa.gnu.org/), GNU-devel ELPA +(https://elpa.gnu.org/devel/), and MELPA (https://melpa.org/), and can +be installed with the standard command ‘package-install’ (*note +(emacs)Package Installation::). + +‘M-x package-install dash ’ + Install the Dash library. + + Alternatively, you can just dump ‘dash.el’ in your ‘load-path’ +somewhere (*note (emacs)Lisp Libraries::). + +* Menu: + +* Using in a package:: Listing Dash as a package dependency. +* Fontification of special variables:: Font Lock of anaphoric macro variables. +* Info symbol lookup:: Looking up Dash symbols in this manual. + + +File: dash.info, Node: Using in a package, Next: Fontification of special variables, Up: Installation + +1.1 Using in a package +====================== + +If you use Dash in your own package, be sure to list it as a dependency +in the library’s headers as follows (*note (elisp)Library Headers::). + + ;; Package-Requires: ((dash "2.19.1")) + + +File: dash.info, Node: Fontification of special variables, Next: Info symbol lookup, Prev: Using in a package, Up: Installation + +1.2 Fontification of special variables +====================================== + +The autoloaded minor mode ‘dash-fontify-mode’ is provided for optional +fontification of anaphoric Dash variables (‘it’, ‘acc’, etc.) in Emacs +Lisp buffers using search-based Font Lock (*note (emacs)Font Lock::). +In older Emacs versions which do not dynamically detect macros, the +minor mode also fontifies calls to Dash macros. + + To automatically enable the minor mode in all Emacs Lisp buffers, +just call its autoloaded global counterpart ‘global-dash-fontify-mode’, +either interactively or from your ‘user-init-file’: + + (global-dash-fontify-mode) + + +File: dash.info, Node: Info symbol lookup, Prev: Fontification of special variables, Up: Installation + +1.3 Info symbol lookup +====================== + +While editing Elisp files, you can use ‘C-h S’ (‘info-lookup-symbol’) to +look up Elisp symbols in the relevant Info manuals (*note (emacs)Info +Lookup::). To enable the same for Dash symbols, use the command +‘dash-register-info-lookup’. It can be called directly when needed, or +automatically from your ‘user-init-file’. For example: + + (with-eval-after-load 'info-look + (dash-register-info-lookup)) + + +File: dash.info, Node: Functions, Next: Development, Prev: Installation, Up: Top + +2 Functions +*********** + +This chapter contains reference documentation for the Dash API +(Application Programming Interface). The names of all public functions +defined in the library are prefixed with a dash character (‘-’). + + The library also provides anaphoric macro versions of functions where +that makes sense. The names of these macros are prefixed with two +dashes (‘--’) instead of one. + + For instance, while the function ‘-map’ applies a function to each +element of a list, its anaphoric counterpart ‘--map’ evaluates a form +with the local variable ‘it’ temporarily bound to the current list +element instead. + + ;; Normal version. + (-map (lambda (n) (* n n)) '(1 2 3 4)) + ⇒ (1 4 9 16) + + ;; Anaphoric version. + (--map (* it it) '(1 2 3 4)) + ⇒ (1 4 9 16) + + The normal version can, of course, also be written as in the +following example, which demonstrates the utility of both versions. + + (defun my-square (n) + "Return N multiplied by itself." + (* n n)) + + (-map #'my-square '(1 2 3 4)) + ⇒ (1 4 9 16) + +* Menu: + +* Maps:: +* Sublist selection:: +* List to list:: +* Reductions:: +* Unfolding:: +* Predicates:: +* Partitioning:: +* Indexing:: +* Set operations:: +* Other list operations:: +* Tree operations:: +* Threading macros:: +* Binding:: +* Side effects:: +* Destructive operations:: +* Function combinators:: + + +File: dash.info, Node: Maps, Next: Sublist selection, Up: Functions + +2.1 Maps +======== + +Functions in this category take a transforming function, which is then +applied sequentially to each or selected elements of the input list. +The results are collected in order and returned as a new list. + + -- Function: -map (fn list) + Apply FN to each item in LIST and return the list of results. + + This function’s anaphoric counterpart is ‘--map’. + + (-map (lambda (num) (* num num)) '(1 2 3 4)) + ⇒ (1 4 9 16) + (-map #'1+ '(1 2 3 4)) + ⇒ (2 3 4 5) + (--map (* it it) '(1 2 3 4)) + ⇒ (1 4 9 16) + + -- Function: -map-when (pred rep list) + Use PRED to conditionally apply REP to each item in LIST. Return a + copy of LIST where the items for which PRED returns ‘nil’ are + unchanged, and the rest are mapped through the REP function. + + Alias: ‘-replace-where’ + + See also: ‘-update-at’ (*note -update-at::) + + (-map-when 'even? 'square '(1 2 3 4)) + ⇒ (1 4 3 16) + (--map-when (> it 2) (* it it) '(1 2 3 4)) + ⇒ (1 2 9 16) + (--map-when (= it 2) 17 '(1 2 3 4)) + ⇒ (1 17 3 4) + + -- Function: -map-first (pred rep list) + Use PRED to determine the first item in LIST to call REP on. + Return a copy of LIST where the first item for which PRED returns + non-‘nil’ is replaced with the result of calling REP on that item. + + See also: ‘-map-when’ (*note -map-when::), ‘-replace-first’ (*note + -replace-first::) + + (-map-first 'even? 'square '(1 2 3 4)) + ⇒ (1 4 3 4) + (--map-first (> it 2) (* it it) '(1 2 3 4)) + ⇒ (1 2 9 4) + (--map-first (= it 2) 17 '(1 2 3 2)) + ⇒ (1 17 3 2) + + -- Function: -map-last (pred rep list) + Use PRED to determine the last item in LIST to call REP on. Return + a copy of LIST where the last item for which PRED returns non-‘nil’ + is replaced with the result of calling REP on that item. + + See also: ‘-map-when’ (*note -map-when::), ‘-replace-last’ (*note + -replace-last::) + + (-map-last 'even? 'square '(1 2 3 4)) + ⇒ (1 2 3 16) + (--map-last (> it 2) (* it it) '(1 2 3 4)) + ⇒ (1 2 3 16) + (--map-last (= it 2) 17 '(1 2 3 2)) + ⇒ (1 2 3 17) + + -- Function: -map-indexed (fn list) + Apply FN to each index and item in LIST and return the list of + results. This is like ‘-map’ (*note -map::), but FN takes two + arguments: the index of the current element within LIST, and the + element itself. + + This function’s anaphoric counterpart is ‘--map-indexed’. + + For a side-effecting variant, see also ‘-each-indexed’ (*note + -each-indexed::). + + (-map-indexed (lambda (index item) (- item index)) '(1 2 3 4)) + ⇒ (1 1 1 1) + (--map-indexed (- it it-index) '(1 2 3 4)) + ⇒ (1 1 1 1) + (-map-indexed #'* '(1 2 3 4)) + ⇒ (0 2 6 12) + + -- Function: -annotate (fn list) + Pair each item in LIST with the result of passing it to FN. + + Return an alist of (RESULT . ITEM), where each ITEM is the + corresponding element of LIST, and RESULT is the value obtained by + calling FN on ITEM. + + This function’s anaphoric counterpart is ‘--annotate’. + + (-annotate #'1+ '(1 2 3)) + ⇒ ((2 . 1) (3 . 2) (4 . 3)) + (-annotate #'length '((f o o) (bar baz))) + ⇒ ((3 f o o) (2 bar baz)) + (--annotate (> it 1) '(0 1 2 3)) + ⇒ ((nil . 0) (nil . 1) (t . 2) (t . 3)) + + -- Function: -splice (pred fun list) + Splice lists generated by FUN in place of items satisfying PRED in + LIST. + + Call PRED on each element of LIST. Whenever the result of PRED is + ‘nil’, leave that ‘it’ as-is. Otherwise, call FUN on the same ‘it’ + that satisfied PRED. The result should be a (possibly empty) list + of items to splice in place of ‘it’ in LIST. + + This can be useful as an alternative to the ‘,@’ construct in a ‘`’ + structure, in case you need to splice several lists at marked + positions (for example with keywords). + + This function’s anaphoric counterpart is ‘--splice’. + + See also: ‘-splice-list’ (*note -splice-list::), ‘-insert-at’ + (*note -insert-at::). + + (-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2)) + ⇒ (a 1 1 b 2 2) + (--splice t (list it it) '(1 2 3 4)) + ⇒ (1 1 2 2 3 3 4 4) + (--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar))) + ⇒ ((foo) (magical) (code) (bar)) + + -- Function: -splice-list (pred new-list list) + Splice NEW-LIST in place of elements matching PRED in LIST. + + See also: ‘-splice’ (*note -splice::), ‘-insert-at’ (*note + -insert-at::) + + (-splice-list 'keywordp '(a b c) '(1 :foo 2)) + ⇒ (1 a b c 2) + (-splice-list 'keywordp nil '(1 :foo 2)) + ⇒ (1 2) + (--splice-list (keywordp it) '(a b c) '(1 :foo 2)) + ⇒ (1 a b c 2) + + -- Function: -mapcat (fn list) + Return the concatenation of the result of mapping FN over LIST. + Thus function FN should return a list. + + (-mapcat 'list '(1 2 3)) + ⇒ (1 2 3) + (-mapcat (lambda (item) (list 0 item)) '(1 2 3)) + ⇒ (0 1 0 2 0 3) + (--mapcat (list 0 it) '(1 2 3)) + ⇒ (0 1 0 2 0 3) + + -- Function: -copy (list) + Create a shallow copy of LIST. + + (-copy '(1 2 3)) + ⇒ (1 2 3) + (let ((a '(1 2 3))) (eq a (-copy a))) + ⇒ nil + + +File: dash.info, Node: Sublist selection, Next: List to list, Prev: Maps, Up: Functions + +2.2 Sublist selection +===================== + +Functions returning a sublist of the original list. + + -- Function: -filter (pred list) + Return a new list of the items in LIST for which PRED returns + non-‘nil’. + + Alias: ‘-select’. + + This function’s anaphoric counterpart is ‘--filter’. + + For similar operations, see also ‘-keep’ (*note -keep::) and + ‘-remove’ (*note -remove::). + + (-filter (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) + ⇒ (2 4) + (-filter #'natnump '(-2 -1 0 1 2)) + ⇒ (0 1 2) + (--filter (= 0 (% it 2)) '(1 2 3 4)) + ⇒ (2 4) + + -- Function: -remove (pred list) + Return a new list of the items in LIST for which PRED returns + ‘nil’. + + Alias: ‘-reject’. + + This function’s anaphoric counterpart is ‘--remove’. + + For similar operations, see also ‘-keep’ (*note -keep::) and + ‘-filter’ (*note -filter::). + + (-remove (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) + ⇒ (1 3) + (-remove #'natnump '(-2 -1 0 1 2)) + ⇒ (-2 -1) + (--remove (= 0 (% it 2)) '(1 2 3 4)) + ⇒ (1 3) + + -- Function: -remove-first (pred list) + Remove the first item from LIST for which PRED returns non-‘nil’. + This is a non-destructive operation, but only the front of LIST + leading up to the removed item is a copy; the rest is LIST’s + original tail. If no item is removed, then the result is a + complete copy. + + Alias: ‘-reject-first’. + + This function’s anaphoric counterpart is ‘--remove-first’. + + See also ‘-map-first’ (*note -map-first::), ‘-remove-item’ (*note + -remove-item::), and ‘-remove-last’ (*note -remove-last::). + + (-remove-first #'natnump '(-2 -1 0 1 2)) + ⇒ (-2 -1 1 2) + (-remove-first #'stringp '(1 2 "first" "second")) + ⇒ (1 2 "second") + (--remove-first (> it 3) '(1 2 3 4 5 6)) + ⇒ (1 2 3 5 6) + + -- Function: -remove-last (pred list) + Remove the last item from LIST for which PRED returns non-‘nil’. + The result is a copy of LIST regardless of whether an element is + removed. + + Alias: ‘-reject-last’. + + This function’s anaphoric counterpart is ‘--remove-last’. + + See also ‘-map-last’ (*note -map-last::), ‘-remove-item’ (*note + -remove-item::), and ‘-remove-first’ (*note -remove-first::). + + (-remove-last #'natnump '(1 3 5 4 7 8 10 -11)) + ⇒ (1 3 5 4 7 8 -11) + (-remove-last #'stringp '(1 2 "last" "second")) + ⇒ (1 2 "last") + (--remove-last (> it 3) '(1 2 3 4 5 6 7 8 9 10)) + ⇒ (1 2 3 4 5 6 7 8 9) + + -- Function: -remove-item (item list) + Return a copy of LIST with all occurrences of ITEM removed. The + comparison is done with ‘equal’. + + (-remove-item 3 '(1 2 3 2 3 4 5 3)) + ⇒ (1 2 2 4 5) + (-remove-item 'foo '(foo bar baz foo)) + ⇒ (bar baz) + (-remove-item "bob" '("alice" "bob" "eve" "bob")) + ⇒ ("alice" "eve") + + -- Function: -non-nil (list) + Return a copy of LIST with all ‘nil’ items removed. + + (-non-nil '(nil 1 nil 2 nil nil 3 4 nil 5 nil)) + ⇒ (1 2 3 4 5) + (-non-nil '((nil))) + ⇒ ((nil)) + (-non-nil ()) + ⇒ () + + -- Function: -slice (list from &optional to step) + Return copy of LIST, starting from index FROM to index TO. + + FROM or TO may be negative. These values are then interpreted + modulo the length of the list. + + If STEP is a number, only each STEPth item in the resulting section + is returned. Defaults to 1. + + (-slice '(1 2 3 4 5) 1) + ⇒ (2 3 4 5) + (-slice '(1 2 3 4 5) 0 3) + ⇒ (1 2 3) + (-slice '(1 2 3 4 5 6 7 8 9) 1 -1 2) + ⇒ (2 4 6 8) + + -- Function: -take (n list) + Return a copy of the first N items in LIST. Return a copy of LIST + if it contains N items or fewer. Return ‘nil’ if N is zero or + less. + + See also: ‘-take-last’ (*note -take-last::). + + (-take 3 '(1 2 3 4 5)) + ⇒ (1 2 3) + (-take 17 '(1 2 3 4 5)) + ⇒ (1 2 3 4 5) + (-take 0 '(1 2 3 4 5)) + ⇒ () + + -- Function: -take-last (n list) + Return a copy of the last N items of LIST in order. Return a copy + of LIST if it contains N items or fewer. Return ‘nil’ if N is zero + or less. + + See also: ‘-take’ (*note -take::). + + (-take-last 3 '(1 2 3 4 5)) + ⇒ (3 4 5) + (-take-last 17 '(1 2 3 4 5)) + ⇒ (1 2 3 4 5) + (-take-last 1 '(1 2 3 4 5)) + ⇒ (5) + + -- Function: -drop (n list) + Return the tail (not a copy) of LIST without the first N items. + Return ‘nil’ if LIST contains N items or fewer. Return LIST if N + is zero or less. + + For another variant, see also ‘-drop-last’ (*note -drop-last::). + + (-drop 3 '(1 2 3 4 5)) + ⇒ (4 5) + (-drop 17 '(1 2 3 4 5)) + ⇒ () + (-drop 0 '(1 2 3 4 5)) + ⇒ (1 2 3 4 5) + + -- Function: -drop-last (n list) + Return a copy of LIST without its last N items. Return a copy of + LIST if N is zero or less. Return ‘nil’ if LIST contains N items + or fewer. + + See also: ‘-drop’ (*note -drop::). + + (-drop-last 3 '(1 2 3 4 5)) + ⇒ (1 2) + (-drop-last 17 '(1 2 3 4 5)) + ⇒ () + (-drop-last 0 '(1 2 3 4 5)) + ⇒ (1 2 3 4 5) + + -- Function: -take-while (pred list) + Take successive items from LIST for which PRED returns non-‘nil’. + PRED is a function of one argument. Return a new list of the + successive elements from the start of LIST for which PRED returns + non-‘nil’. + + This function’s anaphoric counterpart is ‘--take-while’. + + For another variant, see also ‘-drop-while’ (*note -drop-while::). + + (-take-while #'even? '(1 2 3 4)) + ⇒ () + (-take-while #'even? '(2 4 5 6)) + ⇒ (2 4) + (--take-while (< it 4) '(1 2 3 4 3 2 1)) + ⇒ (1 2 3) + + -- Function: -drop-while (pred list) + Drop successive items from LIST for which PRED returns non-‘nil’. + PRED is a function of one argument. Return the tail (not a copy) + of LIST starting from its first element for which PRED returns + ‘nil’. + + This function’s anaphoric counterpart is ‘--drop-while’. + + For another variant, see also ‘-take-while’ (*note -take-while::). + + (-drop-while #'even? '(1 2 3 4)) + ⇒ (1 2 3 4) + (-drop-while #'even? '(2 4 5 6)) + ⇒ (5 6) + (--drop-while (< it 4) '(1 2 3 4 3 2 1)) + ⇒ (4 3 2 1) + + -- Function: -select-by-indices (indices list) + Return a list whose elements are elements from LIST selected as + ‘(nth i list)‘ for all i from INDICES. + + (-select-by-indices '(4 10 2 3 6) '("v" "e" "l" "o" "c" "i" "r" "a" "p" "t" "o" "r")) + ⇒ ("c" "o" "l" "o" "r") + (-select-by-indices '(2 1 0) '("a" "b" "c")) + ⇒ ("c" "b" "a") + (-select-by-indices '(0 1 2 0 1 3 3 1) '("f" "a" "r" "l")) + ⇒ ("f" "a" "r" "f" "a" "l" "l" "a") + + -- Function: -select-columns (columns table) + Select COLUMNS from TABLE. + + TABLE is a list of lists where each element represents one row. It + is assumed each row has the same length. + + Each row is transformed such that only the specified COLUMNS are + selected. + + See also: ‘-select-column’ (*note -select-column::), + ‘-select-by-indices’ (*note -select-by-indices::) + + (-select-columns '(0 2) '((1 2 3) (a b c) (:a :b :c))) + ⇒ ((1 3) (a c) (:a :c)) + (-select-columns '(1) '((1 2 3) (a b c) (:a :b :c))) + ⇒ ((2) (b) (:b)) + (-select-columns nil '((1 2 3) (a b c) (:a :b :c))) + ⇒ (nil nil nil) + + -- Function: -select-column (column table) + Select COLUMN from TABLE. + + TABLE is a list of lists where each element represents one row. It + is assumed each row has the same length. + + The single selected column is returned as a list. + + See also: ‘-select-columns’ (*note -select-columns::), + ‘-select-by-indices’ (*note -select-by-indices::) + + (-select-column 1 '((1 2 3) (a b c) (:a :b :c))) + ⇒ (2 b :b) + + +File: dash.info, Node: List to list, Next: Reductions, Prev: Sublist selection, Up: Functions + +2.3 List to list +================ + +Functions returning a modified copy of the input list. + + -- Function: -keep (fn list) + Return a new list of the non-‘nil’ results of applying FN to each + item in LIST. Like ‘-filter’ (*note -filter::), but returns the + non-‘nil’ results of FN instead of the corresponding elements of + LIST. + + Its anaphoric counterpart is ‘--keep’. + + (-keep #'cdr '((1 2 3) (4 5) (6))) + ⇒ ((2 3) (5)) + (-keep (lambda (n) (and (> n 3) (* 10 n))) '(1 2 3 4 5 6)) + ⇒ (40 50 60) + (--keep (and (> it 3) (* 10 it)) '(1 2 3 4 5 6)) + ⇒ (40 50 60) + + -- Function: -concat (&rest sequences) + Concatenate all the arguments and make the result a list. The + result is a list whose elements are the elements of all the + arguments. Each argument may be a list, vector or string. + + All arguments except the last argument are copied. The last + argument is just used as the tail of the new list. + + (-concat '(1)) + ⇒ (1) + (-concat '(1) '(2)) + ⇒ (1 2) + (-concat '(1) '(2 3) '(4)) + ⇒ (1 2 3 4) + + -- Function: -flatten (l) + Take a nested list L and return its contents as a single, flat + list. + + Note that because ‘nil’ represents a list of zero elements (an + empty list), any mention of ‘nil’ in L will disappear after + flattening. If you need to preserve nils, consider ‘-flatten-n’ + (*note -flatten-n::) or map them to some unique symbol and then map + them back. + + Conses of two atoms are considered "terminals", that is, they + aren’t flattened further. + + See also: ‘-flatten-n’ (*note -flatten-n::) + + (-flatten '((1))) + ⇒ (1) + (-flatten '((1 (2 3) (((4 (5))))))) + ⇒ (1 2 3 4 5) + (-flatten '(1 2 (3 . 4))) + ⇒ (1 2 (3 . 4)) + + -- Function: -flatten-n (num list) + Flatten NUM levels of a nested LIST. + + See also: ‘-flatten’ (*note -flatten::) + + (-flatten-n 1 '((1 2) ((3 4) ((5 6))))) + ⇒ (1 2 (3 4) ((5 6))) + (-flatten-n 2 '((1 2) ((3 4) ((5 6))))) + ⇒ (1 2 3 4 (5 6)) + (-flatten-n 3 '((1 2) ((3 4) ((5 6))))) + ⇒ (1 2 3 4 5 6) + + -- Function: -replace (old new list) + Replace all OLD items in LIST with NEW. + + Elements are compared using ‘equal’. + + See also: ‘-replace-at’ (*note -replace-at::) + + (-replace 1 "1" '(1 2 3 4 3 2 1)) + ⇒ ("1" 2 3 4 3 2 "1") + (-replace "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) + ⇒ ("a" "nice" "bar" "sentence" "about" "bar") + (-replace 1 2 nil) + ⇒ nil + + -- Function: -replace-first (old new list) + Replace the first occurrence of OLD with NEW in LIST. + + Elements are compared using ‘equal’. + + See also: ‘-map-first’ (*note -map-first::) + + (-replace-first 1 "1" '(1 2 3 4 3 2 1)) + ⇒ ("1" 2 3 4 3 2 1) + (-replace-first "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) + ⇒ ("a" "nice" "bar" "sentence" "about" "foo") + (-replace-first 1 2 nil) + ⇒ nil + + -- Function: -replace-last (old new list) + Replace the last occurrence of OLD with NEW in LIST. + + Elements are compared using ‘equal’. + + See also: ‘-map-last’ (*note -map-last::) + + (-replace-last 1 "1" '(1 2 3 4 3 2 1)) + ⇒ (1 2 3 4 3 2 "1") + (-replace-last "foo" "bar" '("a" "nice" "foo" "sentence" "about" "foo")) + ⇒ ("a" "nice" "foo" "sentence" "about" "bar") + (-replace-last 1 2 nil) + ⇒ nil + + -- Function: -insert-at (n x list) + Return a list with X inserted into LIST at position N. + + See also: ‘-splice’ (*note -splice::), ‘-splice-list’ (*note + -splice-list::) + + (-insert-at 1 'x '(a b c)) + ⇒ (a x b c) + (-insert-at 12 'x '(a b c)) + ⇒ (a b c x) + + -- Function: -replace-at (n x list) + Return a list with element at Nth position in LIST replaced with X. + + See also: ‘-replace’ (*note -replace::) + + (-replace-at 0 9 '(0 1 2 3 4 5)) + ⇒ (9 1 2 3 4 5) + (-replace-at 1 9 '(0 1 2 3 4 5)) + ⇒ (0 9 2 3 4 5) + (-replace-at 4 9 '(0 1 2 3 4 5)) + ⇒ (0 1 2 3 9 5) + + -- Function: -update-at (n func list) + Use FUNC to update the Nth element of LIST. Return a copy of LIST + where the Nth element is replaced with the result of calling FUNC + on it. + + See also: ‘-map-when’ (*note -map-when::) + + (-update-at 0 (lambda (x) (+ x 9)) '(0 1 2 3 4 5)) + ⇒ (9 1 2 3 4 5) + (-update-at 1 (lambda (x) (+ x 8)) '(0 1 2 3 4 5)) + ⇒ (0 9 2 3 4 5) + (--update-at 2 (length it) '("foo" "bar" "baz" "quux")) + ⇒ ("foo" "bar" 3 "quux") + + -- Function: -remove-at (n list) + Return LIST with its element at index N removed. That is, remove + any element selected as (nth N LIST) from LIST and return the + result. + + This is a non-destructive operation: parts of LIST (but not + necessarily all of it) are copied as needed to avoid destructively + modifying it. + + See also: ‘-remove-at-indices’ (*note -remove-at-indices::), + ‘-remove’ (*note -remove::). + + (-remove-at 0 '(a b c)) + ⇒ (b c) + (-remove-at 1 '(a b c)) + ⇒ (a c) + (-remove-at 2 '(a b c)) + ⇒ (a b) + + -- Function: -remove-at-indices (indices list) + Return LIST with its elements at INDICES removed. That is, for + each index I in INDICES, remove any element selected as (nth I + LIST) from LIST. + + This is a non-destructive operation: parts of LIST (but not + necessarily all of it) are copied as needed to avoid destructively + modifying it. + + See also: ‘-remove-at’ (*note -remove-at::), ‘-remove’ (*note + -remove::). + + (-remove-at-indices '(0) '(a b c d e)) + ⇒ (b c d e) + (-remove-at-indices '(1 3) '(a b c d e)) + ⇒ (a c e) + (-remove-at-indices '(4 0 2) '(a b c d e)) + ⇒ (b d) + + +File: dash.info, Node: Reductions, Next: Unfolding, Prev: List to list, Up: Functions + +2.4 Reductions +============== + +Functions reducing lists to a single value (which may also be a list). + + -- Function: -reduce-from (fn init list) + Reduce the function FN across LIST, starting with INIT. Return the + result of applying FN to INIT and the first element of LIST, then + applying FN to that result and the second element, etc. If LIST is + empty, return INIT without calling FN. + + This function’s anaphoric counterpart is ‘--reduce-from’. + + For other folds, see also ‘-reduce’ (*note -reduce::) and + ‘-reduce-r’ (*note -reduce-r::). + + (-reduce-from #'- 10 '(1 2 3)) + ⇒ 4 + (-reduce-from #'list 10 '(1 2 3)) + ⇒ (((10 1) 2) 3) + (--reduce-from (concat acc " " it) "START" '("a" "b" "c")) + ⇒ "START a b c" + + -- Function: -reduce-r-from (fn init list) + Reduce the function FN across LIST in reverse, starting with INIT. + Return the result of applying FN to the last element of LIST and + INIT, then applying FN to the second-to-last element and the + previous result of FN, etc. That is, the first argument of FN is + the current element, and its second argument the accumulated value. + If LIST is empty, return INIT without calling FN. + + This function is like ‘-reduce-from’ (*note -reduce-from::) but the + operation associates from the right rather than left. In other + words, it starts from the end of LIST and flips the arguments to + FN. Conceptually, it is like replacing the conses in LIST with + applications of FN, and its last link with INIT, and evaluating the + resulting expression. + + This function’s anaphoric counterpart is ‘--reduce-r-from’. + + For other folds, see also ‘-reduce-r’ (*note -reduce-r::) and + ‘-reduce’ (*note -reduce::). + + (-reduce-r-from #'- 10 '(1 2 3)) + ⇒ -8 + (-reduce-r-from #'list 10 '(1 2 3)) + ⇒ (1 (2 (3 10))) + (--reduce-r-from (concat it " " acc) "END" '("a" "b" "c")) + ⇒ "a b c END" + + -- Function: -reduce (fn list) + Reduce the function FN across LIST. Return the result of applying + FN to the first two elements of LIST, then applying FN to that + result and the third element, etc. If LIST contains a single + element, return it without calling FN. If LIST is empty, return + the result of calling FN with no arguments. + + This function’s anaphoric counterpart is ‘--reduce’. + + For other folds, see also ‘-reduce-from’ (*note -reduce-from::) and + ‘-reduce-r’ (*note -reduce-r::). + + (-reduce #'- '(1 2 3 4)) + ⇒ -8 + (-reduce #'list '(1 2 3 4)) + ⇒ (((1 2) 3) 4) + (--reduce (format "%s-%d" acc it) '(1 2 3)) + ⇒ "1-2-3" + + -- Function: -reduce-r (fn list) + Reduce the function FN across LIST in reverse. Return the result + of applying FN to the last two elements of LIST, then applying FN + to the third-to-last element and the previous result of FN, etc. + That is, the first argument of FN is the current element, and its + second argument the accumulated value. If LIST contains a single + element, return it without calling FN. If LIST is empty, return + the result of calling FN with no arguments. + + This function is like ‘-reduce’ (*note -reduce::) but the operation + associates from the right rather than left. In other words, it + starts from the end of LIST and flips the arguments to FN. + Conceptually, it is like replacing the conses in LIST with + applications of FN, ignoring its last link, and evaluating the + resulting expression. + + This function’s anaphoric counterpart is ‘--reduce-r’. + + For other folds, see also ‘-reduce-r-from’ (*note -reduce-r-from::) + and ‘-reduce’ (*note -reduce::). + + (-reduce-r #'- '(1 2 3 4)) + ⇒ -2 + (-reduce-r #'list '(1 2 3 4)) + ⇒ (1 (2 (3 4))) + (--reduce-r (format "%s-%d" acc it) '(1 2 3)) + ⇒ "3-2-1" + + -- Function: -reductions-from (fn init list) + Return a list of FN’s intermediate reductions across LIST. That + is, a list of the intermediate values of the accumulator when + ‘-reduce-from’ (*note -reduce-from::) (which see) is called with + the same arguments. + + This function’s anaphoric counterpart is ‘--reductions-from’. + + For other folds, see also ‘-reductions’ (*note -reductions::) and + ‘-reductions-r’ (*note -reductions-r::). + + (-reductions-from #'max 0 '(2 1 4 3)) + ⇒ (0 2 2 4 4) + (-reductions-from #'* 1 '(1 2 3 4)) + ⇒ (1 1 2 6 24) + (--reductions-from (format "(FN %s %d)" acc it) "INIT" '(1 2 3)) + ⇒ ("INIT" "(FN INIT 1)" "(FN (FN INIT 1) 2)" "(FN (FN (FN INIT 1) 2) 3)") + + -- Function: -reductions-r-from (fn init list) + Return a list of FN’s intermediate reductions across reversed LIST. + That is, a list of the intermediate values of the accumulator when + ‘-reduce-r-from’ (*note -reduce-r-from::) (which see) is called + with the same arguments. + + This function’s anaphoric counterpart is ‘--reductions-r-from’. + + For other folds, see also ‘-reductions’ (*note -reductions::) and + ‘-reductions-r’ (*note -reductions-r::). + + (-reductions-r-from #'max 0 '(2 1 4 3)) + ⇒ (4 4 4 3 0) + (-reductions-r-from #'* 1 '(1 2 3 4)) + ⇒ (24 24 12 4 1) + (--reductions-r-from (format "(FN %d %s)" it acc) "INIT" '(1 2 3)) + ⇒ ("(FN 1 (FN 2 (FN 3 INIT)))" "(FN 2 (FN 3 INIT))" "(FN 3 INIT)" "INIT") + + -- Function: -reductions (fn list) + Return a list of FN’s intermediate reductions across LIST. That + is, a list of the intermediate values of the accumulator when + ‘-reduce’ (*note -reduce::) (which see) is called with the same + arguments. + + This function’s anaphoric counterpart is ‘--reductions’. + + For other folds, see also ‘-reductions’ (*note -reductions::) and + ‘-reductions-r’ (*note -reductions-r::). + + (-reductions #'+ '(1 2 3 4)) + ⇒ (1 3 6 10) + (-reductions #'* '(1 2 3 4)) + ⇒ (1 2 6 24) + (--reductions (format "(FN %s %d)" acc it) '(1 2 3)) + ⇒ (1 "(FN 1 2)" "(FN (FN 1 2) 3)") + + -- Function: -reductions-r (fn list) + Return a list of FN’s intermediate reductions across reversed LIST. + That is, a list of the intermediate values of the accumulator when + ‘-reduce-r’ (*note -reduce-r::) (which see) is called with the same + arguments. + + This function’s anaphoric counterpart is ‘--reductions-r’. + + For other folds, see also ‘-reductions-r-from’ (*note + -reductions-r-from::) and ‘-reductions’ (*note -reductions::). + + (-reductions-r #'+ '(1 2 3 4)) + ⇒ (10 9 7 4) + (-reductions-r #'* '(1 2 3 4)) + ⇒ (24 24 12 4) + (--reductions-r (format "(FN %d %s)" it acc) '(1 2 3)) + ⇒ ("(FN 1 (FN 2 3))" "(FN 2 3)" 3) + + -- Function: -count (pred list) + Counts the number of items in LIST where (PRED item) is non-‘nil’. + + (-count 'even? '(1 2 3 4 5)) + ⇒ 2 + (--count (< it 4) '(1 2 3 4)) + ⇒ 3 + + -- Function: -sum (list) + Return the sum of LIST. + + (-sum ()) + ⇒ 0 + (-sum '(1)) + ⇒ 1 + (-sum '(1 2 3 4)) + ⇒ 10 + + -- Function: -running-sum (list) + Return a list with running sums of items in LIST. LIST must be + non-empty. + + (-running-sum '(1 2 3 4)) + ⇒ (1 3 6 10) + (-running-sum '(1)) + ⇒ (1) + (-running-sum ()) + error→ Wrong type argument: consp, nil + + -- Function: -product (list) + Return the product of LIST. + + (-product ()) + ⇒ 1 + (-product '(1)) + ⇒ 1 + (-product '(1 2 3 4)) + ⇒ 24 + + -- Function: -running-product (list) + Return a list with running products of items in LIST. LIST must be + non-empty. + + (-running-product '(1 2 3 4)) + ⇒ (1 2 6 24) + (-running-product '(1)) + ⇒ (1) + (-running-product ()) + error→ Wrong type argument: consp, nil + + -- Function: -inits (list) + Return all prefixes of LIST. + + (-inits '(1 2 3 4)) + ⇒ (nil (1) (1 2) (1 2 3) (1 2 3 4)) + (-inits nil) + ⇒ (nil) + (-inits '(1)) + ⇒ (nil (1)) + + -- Function: -tails (list) + Return all suffixes of LIST. + + (-tails '(1 2 3 4)) + ⇒ ((1 2 3 4) (2 3 4) (3 4) (4) nil) + (-tails nil) + ⇒ (nil) + (-tails '(1)) + ⇒ ((1) nil) + + -- Function: -common-prefix (&rest lists) + Return the longest common prefix of LISTS. + + (-common-prefix '(1)) + ⇒ (1) + (-common-prefix '(1 2) '(3 4) '(1 2)) + ⇒ () + (-common-prefix '(1 2) '(1 2 3) '(1 2 3 4)) + ⇒ (1 2) + + -- Function: -common-suffix (&rest lists) + Return the longest common suffix of LISTS. + + (-common-suffix '(1)) + ⇒ (1) + (-common-suffix '(1 2) '(3 4) '(1 2)) + ⇒ () + (-common-suffix '(1 2 3 4) '(2 3 4) '(3 4)) + ⇒ (3 4) + + -- Function: -min (list) + Return the smallest value from LIST of numbers or markers. + + (-min '(0)) + ⇒ 0 + (-min '(3 2 1)) + ⇒ 1 + (-min '(1 2 3)) + ⇒ 1 + + -- Function: -min-by (comparator list) + Take a comparison function COMPARATOR and a LIST and return the + least element of the list by the comparison function. + + See also combinator ‘-on’ (*note -on::) which can transform the + values before comparing them. + + (-min-by '> '(4 3 6 1)) + ⇒ 1 + (--min-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) + ⇒ (1 2 3) + (--min-by (> (length it) (length other)) '((1 2 3) (2) (3 2))) + ⇒ (2) + + -- Function: -max (list) + Return the largest value from LIST of numbers or markers. + + (-max '(0)) + ⇒ 0 + (-max '(3 2 1)) + ⇒ 3 + (-max '(1 2 3)) + ⇒ 3 + + -- Function: -max-by (comparator list) + Take a comparison function COMPARATOR and a LIST and return the + greatest element of the list by the comparison function. + + See also combinator ‘-on’ (*note -on::) which can transform the + values before comparing them. + + (-max-by '> '(4 3 6 1)) + ⇒ 6 + (--max-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) + ⇒ (3 2) + (--max-by (> (length it) (length other)) '((1 2 3) (2) (3 2))) + ⇒ (1 2 3) + + -- Function: -frequencies (list) + Count the occurrences of each distinct element of LIST. + + Return an alist of (ELEMENT . N), where each ELEMENT occurs N + times in LIST. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + See also ‘-count’ (*note -count::) and ‘-group-by’ (*note + -group-by::). + + (-frequencies ()) + ⇒ () + (-frequencies '(1 2 3 1 2 1)) + ⇒ ((1 . 3) (2 . 2) (3 . 1)) + (let ((-compare-fn #'string=)) (-frequencies '(a "a"))) + ⇒ ((a . 2)) + + +File: dash.info, Node: Unfolding, Next: Predicates, Prev: Reductions, Up: Functions + +2.5 Unfolding +============= + +Operations dual to reductions, building lists from a seed value rather +than consuming a list to produce a single value. + + -- Function: -iterate (fun init n) + Return a list of iterated applications of FUN to INIT. + + This means a list of the form: + + (INIT (FUN INIT) (FUN (FUN INIT)) ...) + + N is the length of the returned list. + + (-iterate #'1+ 1 10) + ⇒ (1 2 3 4 5 6 7 8 9 10) + (-iterate (lambda (x) (+ x x)) 2 5) + ⇒ (2 4 8 16 32) + (--iterate (* it it) 2 5) + ⇒ (2 4 16 256 65536) + + -- Function: -unfold (fun seed) + Build a list from SEED using FUN. + + This is "dual" operation to ‘-reduce-r’ (*note -reduce-r::): while + -reduce-r consumes a list to produce a single value, ‘-unfold’ + (*note -unfold::) takes a seed value and builds a (potentially + infinite!) list. + + FUN should return ‘nil’ to stop the generating process, or a cons + (A . B), where A will be prepended to the result and B is the new + seed. + + (-unfold (lambda (x) (unless (= x 0) (cons x (1- x)))) 10) + ⇒ (10 9 8 7 6 5 4 3 2 1) + (--unfold (when it (cons it (cdr it))) '(1 2 3 4)) + ⇒ ((1 2 3 4) (2 3 4) (3 4) (4)) + (--unfold (when it (cons it (butlast it))) '(1 2 3 4)) + ⇒ ((1 2 3 4) (1 2 3) (1 2) (1)) + + -- Function: -repeat (n x) + Return a new list of length N with each element being X. Return + ‘nil’ if N is less than 1. + + (-repeat 3 :a) + ⇒ (:a :a :a) + (-repeat 1 :a) + ⇒ (:a) + (-repeat 0 :a) + ⇒ () + + -- Function: -cycle (list) + Return an infinite circular copy of LIST. The returned list cycles + through the elements of LIST and repeats from the beginning. + + (-take 5 (-cycle '(1 2 3))) + ⇒ (1 2 3 1 2) + (-take 7 (-cycle '(1 "and" 3))) + ⇒ (1 "and" 3 1 "and" 3 1) + (-zip-lists (-cycle '(3)) '(1 2)) + ⇒ ((3 1) (3 2)) + + +File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Functions + +2.6 Predicates +============== + +Reductions of one or more lists to a boolean value. + + -- Function: -some (pred list) + Return (PRED x) for the first LIST item where (PRED x) is + non-‘nil’, else ‘nil’. + + Alias: ‘-any’. + + This function’s anaphoric counterpart is ‘--some’. + + (-some #'stringp '(1 "2" 3)) + ⇒ t + (--some (string-match-p "x" it) '("foo" "axe" "xor")) + ⇒ 1 + (--some (= it-index 3) '(0 1 2)) + ⇒ nil + + -- Function: -every (pred list) + Return non-‘nil’ if PRED returns non-‘nil’ for all items in LIST. + If so, return the last such result of PRED. Otherwise, once an + item is reached for which PRED returns ‘nil’, return ‘nil’ without + calling PRED on any further LIST elements. + + This function is like ‘-every-p’, but on success returns the last + non-‘nil’ result of PRED instead of just ‘t’. + + This function’s anaphoric counterpart is ‘--every’. + + (-every #'numberp '(1 2 3)) + ⇒ t + (--every (string-match-p "x" it) '("axe" "xor")) + ⇒ 0 + (--every (= it it-index) '(0 1 3)) + ⇒ nil + + -- Function: -any? (pred list) + Return ‘t’ if (PRED X) is non-‘nil’ for any X in LIST, else ‘nil’. + + Alias: ‘-any-p’, ‘-some?’, ‘-some-p’ + + (-any? #'numberp '(nil 0 t)) + ⇒ t + (-any? #'numberp '(nil t t)) + ⇒ nil + (-any? #'null '(1 3 5)) + ⇒ nil + + -- Function: -all? (pred list) + Return ‘t’ if (PRED X) is non-‘nil’ for all X in LIST, else ‘nil’. + In the latter case, stop after the first X for which (PRED X) is + ‘nil’, without calling PRED on any subsequent elements of LIST. + + The similar function ‘-every’ (*note -every::) is more widely + useful, since it returns the last non-‘nil’ result of PRED instead + of just ‘t’ on success. + + Alias: ‘-all-p’, ‘-every-p’, ‘-every?’. + + This function’s anaphoric counterpart is ‘--all?’. + + (-all? #'numberp '(1 2 3)) + ⇒ t + (-all? #'numberp '(2 t 6)) + ⇒ nil + (--all? (= 0 (% it 2)) '(2 4 6)) + ⇒ t + + -- Function: -none? (pred list) + Return ‘t’ if (PRED X) is ‘nil’ for all X in LIST, else ‘nil’. + + Alias: ‘-none-p’ + + (-none? 'even? '(1 2 3)) + ⇒ nil + (-none? 'even? '(1 3 5)) + ⇒ t + (--none? (= 0 (% it 2)) '(1 2 3)) + ⇒ nil + + -- Function: -only-some? (pred list) + Return ‘t’ if different LIST items both satisfy and do not satisfy + PRED. That is, if PRED returns both ‘nil’ for at least one item, + and non-‘nil’ for at least one other item in LIST. Return ‘nil’ if + all items satisfy the predicate or none of them do. + + Alias: ‘-only-some-p’ + + (-only-some? 'even? '(1 2 3)) + ⇒ t + (-only-some? 'even? '(1 3 5)) + ⇒ nil + (-only-some? 'even? '(2 4 6)) + ⇒ nil + + -- Function: -contains? (list element) + Return non-‘nil’ if LIST contains ELEMENT. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. As with ‘member’, the return value is + actually the tail of LIST whose car is ELEMENT. + + Alias: ‘-contains-p’. + + (-contains? '(1 2 3) 1) + ⇒ (1 2 3) + (-contains? '(1 2 3) 2) + ⇒ (2 3) + (-contains? '(1 2 3) 4) + ⇒ () + + -- Function: -is-prefix? (prefix list) + Return non-‘nil’ if PREFIX is a prefix of LIST. + + Alias: ‘-is-prefix-p’. + + (-is-prefix? '(1 2 3) '(1 2 3 4 5)) + ⇒ t + (-is-prefix? '(1 2 3 4 5) '(1 2 3)) + ⇒ nil + (-is-prefix? '(1 3) '(1 2 3 4 5)) + ⇒ nil + + -- Function: -is-suffix? (suffix list) + Return non-‘nil’ if SUFFIX is a suffix of LIST. + + Alias: ‘-is-suffix-p’. + + (-is-suffix? '(3 4 5) '(1 2 3 4 5)) + ⇒ t + (-is-suffix? '(1 2 3 4 5) '(3 4 5)) + ⇒ nil + (-is-suffix? '(3 5) '(1 2 3 4 5)) + ⇒ nil + + -- Function: -is-infix? (infix list) + Return non-‘nil’ if INFIX is infix of LIST. + + This operation runs in O(n^2) time + + Alias: ‘-is-infix-p’ + + (-is-infix? '(1 2 3) '(1 2 3 4 5)) + ⇒ t + (-is-infix? '(2 3 4) '(1 2 3 4 5)) + ⇒ t + (-is-infix? '(3 4 5) '(1 2 3 4 5)) + ⇒ t + + -- Function: -cons-pair? (obj) + Return non-‘nil’ if OBJ is a true cons pair. That is, a cons (A . + B) where B is not a list. + + Alias: ‘-cons-pair-p’. + + (-cons-pair? '(1 . 2)) + ⇒ t + (-cons-pair? '(1 2)) + ⇒ nil + (-cons-pair? '(1)) + ⇒ nil + + +File: dash.info, Node: Partitioning, Next: Indexing, Prev: Predicates, Up: Functions + +2.7 Partitioning +================ + +Functions partitioning the input list into a list of lists. + + -- Function: -split-at (n list) + Split LIST into two sublists after the Nth element. The result is + a list of two elements (TAKE DROP) where TAKE is a new list of the + first N elements of LIST, and DROP is the remaining elements of + LIST (not a copy). TAKE and DROP are like the results of ‘-take’ + (*note -take::) and ‘-drop’ (*note -drop::), respectively, but the + split is done in a single list traversal. + + (-split-at 3 '(1 2 3 4 5)) + ⇒ ((1 2 3) (4 5)) + (-split-at 17 '(1 2 3 4 5)) + ⇒ ((1 2 3 4 5) nil) + (-split-at 0 '(1 2 3 4 5)) + ⇒ (nil (1 2 3 4 5)) + + -- Function: -split-with (pred list) + Split LIST into a prefix satisfying PRED, and the rest. The first + sublist is the prefix of LIST with successive elements satisfying + PRED, and the second sublist is the remaining elements that do not. + The result is like performing + + ((-take-while PRED LIST) (-drop-while PRED LIST)) + + but in no more than a single pass through LIST. + + (-split-with 'even? '(1 2 3 4)) + ⇒ (nil (1 2 3 4)) + (-split-with 'even? '(2 4 5 6)) + ⇒ ((2 4) (5 6)) + (--split-with (< it 4) '(1 2 3 4 3 2 1)) + ⇒ ((1 2 3) (4 3 2 1)) + + -- Macro: -split-on (item list) + Split the LIST each time ITEM is found. + + Unlike ‘-partition-by’ (*note -partition-by::), the ITEM is + discarded from the results. Empty lists are also removed from the + result. + + Comparison is done by ‘equal’. + + See also ‘-split-when’ (*note -split-when::) + + (-split-on '| '(Nil | Leaf a | Node [Tree a])) + ⇒ ((Nil) (Leaf a) (Node [Tree a])) + (-split-on :endgroup '("a" "b" :endgroup "c" :endgroup "d" "e")) + ⇒ (("a" "b") ("c") ("d" "e")) + (-split-on :endgroup '("a" "b" :endgroup :endgroup "d" "e")) + ⇒ (("a" "b") ("d" "e")) + + -- Function: -split-when (fn list) + Split the LIST on each element where FN returns non-‘nil’. + + Unlike ‘-partition-by’ (*note -partition-by::), the "matched" + element is discarded from the results. Empty lists are also + removed from the result. + + This function can be thought of as a generalization of + ‘split-string’. + + (-split-when 'even? '(1 2 3 4 5 6)) + ⇒ ((1) (3) (5)) + (-split-when 'even? '(1 2 3 4 6 8 9)) + ⇒ ((1) (3) (9)) + (--split-when (memq it '(&optional &rest)) '(a b &optional c d &rest args)) + ⇒ ((a b) (c d) (args)) + + -- Function: -separate (pred list) + Split LIST into two sublists based on whether items satisfy PRED. + The result is like performing + + ((-filter PRED LIST) (-remove PRED LIST)) + + but in a single pass through LIST. + + (-separate (lambda (num) (= 0 (% num 2))) '(1 2 3 4 5 6 7)) + ⇒ ((2 4 6) (1 3 5 7)) + (--separate (< it 5) '(3 7 5 9 3 2 1 4 6)) + ⇒ ((3 3 2 1 4) (7 5 9 6)) + (-separate 'cdr '((1 2) (1) (1 2 3) (4))) + ⇒ (((1 2) (1 2 3)) ((1) (4))) + + -- Function: -partition (n list) + Return a new list with the items in LIST grouped into N-sized + sublists. If there are not enough items to make the last group + N-sized, those items are discarded. + + (-partition 2 '(1 2 3 4 5 6)) + ⇒ ((1 2) (3 4) (5 6)) + (-partition 2 '(1 2 3 4 5 6 7)) + ⇒ ((1 2) (3 4) (5 6)) + (-partition 3 '(1 2 3 4 5 6 7)) + ⇒ ((1 2 3) (4 5 6)) + + -- Function: -partition-all (n list) + Return a new list with the items in LIST grouped into N-sized + sublists. The last group may contain less than N items. + + (-partition-all 2 '(1 2 3 4 5 6)) + ⇒ ((1 2) (3 4) (5 6)) + (-partition-all 2 '(1 2 3 4 5 6 7)) + ⇒ ((1 2) (3 4) (5 6) (7)) + (-partition-all 3 '(1 2 3 4 5 6 7)) + ⇒ ((1 2 3) (4 5 6) (7)) + + -- Function: -partition-in-steps (n step list) + Partition LIST into sublists of length N that are STEP items apart. + Like ‘-partition-all-in-steps’ (*note -partition-all-in-steps::), + but if there are not enough items to make the last group N-sized, + those items are discarded. + + (-partition-in-steps 2 1 '(1 2 3 4)) + ⇒ ((1 2) (2 3) (3 4)) + (-partition-in-steps 3 2 '(1 2 3 4)) + ⇒ ((1 2 3)) + (-partition-in-steps 3 2 '(1 2 3 4 5)) + ⇒ ((1 2 3) (3 4 5)) + + -- Function: -partition-all-in-steps (n step list) + Partition LIST into sublists of length N that are STEP items apart. + Adjacent groups may overlap if N exceeds the STEP stride. Trailing + groups may contain less than N items. + + (-partition-all-in-steps 2 1 '(1 2 3 4)) + ⇒ ((1 2) (2 3) (3 4) (4)) + (-partition-all-in-steps 3 2 '(1 2 3 4)) + ⇒ ((1 2 3) (3 4)) + (-partition-all-in-steps 3 2 '(1 2 3 4 5)) + ⇒ ((1 2 3) (3 4 5) (5)) + + -- Function: -partition-by (fn list) + Apply FN to each item in LIST, splitting it each time FN returns a + new value. + + (-partition-by 'even? ()) + ⇒ () + (-partition-by 'even? '(1 1 2 2 2 3 4 6 8)) + ⇒ ((1 1) (2 2 2) (3) (4 6 8)) + (--partition-by (< it 3) '(1 2 3 4 3 2 1)) + ⇒ ((1 2) (3 4 3) (2 1)) + + -- Function: -partition-by-header (fn list) + Apply FN to the first item in LIST. That is the header value. + Apply FN to each item in LIST, splitting it each time FN returns + the header value, but only after seeing at least one other value + (the body). + + (--partition-by-header (= it 1) '(1 2 3 1 2 1 2 3 4)) + ⇒ ((1 2 3) (1 2) (1 2 3 4)) + (--partition-by-header (> it 0) '(1 2 0 1 0 1 2 3 0)) + ⇒ ((1 2 0) (1 0) (1 2 3 0)) + (-partition-by-header 'even? '(2 1 1 1 4 1 3 5 6 6 1)) + ⇒ ((2 1 1 1) (4 1 3 5) (6 6 1)) + + -- Function: -partition-after-pred (pred list) + Partition LIST after each element for which PRED returns non-‘nil’. + + This function’s anaphoric counterpart is ‘--partition-after-pred’. + + (-partition-after-pred #'booleanp ()) + ⇒ () + (-partition-after-pred #'booleanp '(t t)) + ⇒ ((t) (t)) + (-partition-after-pred #'booleanp '(0 0 t t 0 t)) + ⇒ ((0 0 t) (t) (0 t)) + + -- Function: -partition-before-pred (pred list) + Partition directly before each time PRED is true on an element of + LIST. + + (-partition-before-pred #'booleanp ()) + ⇒ () + (-partition-before-pred #'booleanp '(0 t)) + ⇒ ((0) (t)) + (-partition-before-pred #'booleanp '(0 0 t 0 t t)) + ⇒ ((0 0) (t 0) (t) (t)) + + -- Function: -partition-before-item (item list) + Partition directly before each time ITEM appears in LIST. + + (-partition-before-item 3 ()) + ⇒ () + (-partition-before-item 3 '(1)) + ⇒ ((1)) + (-partition-before-item 3 '(3)) + ⇒ ((3)) + + -- Function: -partition-after-item (item list) + Partition directly after each time ITEM appears in LIST. + + (-partition-after-item 3 ()) + ⇒ () + (-partition-after-item 3 '(1)) + ⇒ ((1)) + (-partition-after-item 3 '(3)) + ⇒ ((3)) + + -- Function: -group-by (fn list) + Separate LIST into an alist whose keys are FN applied to the + elements of LIST. Keys are compared by ‘equal’. + + (-group-by 'even? ()) + ⇒ () + (-group-by 'even? '(1 1 2 2 2 3 4 6 8)) + ⇒ ((nil 1 1 3) (t 2 2 2 4 6 8)) + (--group-by (car (split-string it "/")) '("a/b" "c/d" "a/e")) + ⇒ (("a" "a/b" "a/e") ("c" "c/d")) + + +File: dash.info, Node: Indexing, Next: Set operations, Prev: Partitioning, Up: Functions + +2.8 Indexing +============ + +Functions retrieving or sorting based on list indices and related +predicates. + + -- Function: -elem-index (elem list) + Return the first index of ELEM in LIST. That is, the index within + LIST of the first element that is ‘equal’ to ELEM. Return ‘nil’ if + there is no such element. + + See also: ‘-find-index’ (*note -find-index::). + + (-elem-index 2 '(6 7 8 3 4)) + ⇒ nil + (-elem-index "bar" '("foo" "bar" "baz")) + ⇒ 1 + (-elem-index '(1 2) '((3) (5 6) (1 2) nil)) + ⇒ 2 + + -- Function: -elem-indices (elem list) + Return the list of indices at which ELEM appears in LIST. That is, + the indices of all elements of LIST ‘equal’ to ELEM, in the same + ascending order as they appear in LIST. + + (-elem-indices 2 '(6 7 8 3 4 1)) + ⇒ () + (-elem-indices "bar" '("foo" "bar" "baz")) + ⇒ (1) + (-elem-indices '(1 2) '((3) (1 2) (5 6) (1 2) nil)) + ⇒ (1 3) + + -- Function: -find-index (pred list) + Return the index of the first item satisfying PRED in LIST. Return + ‘nil’ if no such item is found. + + PRED is called with one argument, the current list element, until + it returns non-‘nil’, at which point the search terminates. + + This function’s anaphoric counterpart is ‘--find-index’. + + See also: ‘-first’ (*note -first::), ‘-find-last-index’ (*note + -find-last-index::). + + (-find-index #'numberp '(a b c)) + ⇒ nil + (-find-index #'natnump '(1 0 -1)) + ⇒ 0 + (--find-index (> it 5) '(2 4 1 6 3 3 5 8)) + ⇒ 3 + + -- Function: -find-last-index (pred list) + Return the index of the last item satisfying PRED in LIST. Return + ‘nil’ if no such item is found. + + Predicate PRED is called with one argument each time, namely the + current list element. + + This function’s anaphoric counterpart is ‘--find-last-index’. + + See also: ‘-last’ (*note -last::), ‘-find-index’ (*note + -find-index::). + + (-find-last-index #'numberp '(a b c)) + ⇒ nil + (--find-last-index (> it 5) '(2 7 1 6 3 8 5 2)) + ⇒ 5 + (-find-last-index (-partial #'string< 'a) '(c b a)) + ⇒ 1 + + -- Function: -find-indices (pred list) + Return the list of indices in LIST satisfying PRED. + + Each element of LIST in turn is passed to PRED. If the result is + non-‘nil’, the index of that element in LIST is included in the + result. The returned indices are in ascending order, i.e., in the + same order as they appear in LIST. + + This function’s anaphoric counterpart is ‘--find-indices’. + + See also: ‘-find-index’ (*note -find-index::), ‘-elem-indices’ + (*note -elem-indices::). + + (-find-indices #'numberp '(a b c)) + ⇒ () + (-find-indices #'numberp '(8 1 d 2 b c a 3)) + ⇒ (0 1 3 7) + (--find-indices (> it 5) '(2 4 1 6 3 3 5 8)) + ⇒ (3 7) + + -- Function: -grade-up (comparator list) + Grade elements of LIST using COMPARATOR relation. This yields a + permutation vector such that applying this permutation to LIST + sorts it in ascending order. + + (-grade-up #'< '(3 1 4 2 1 3 3)) + ⇒ (1 4 3 0 5 6 2) + (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices (-grade-up #'< l) l)) + ⇒ (1 1 2 3 3 3 4) + + -- Function: -grade-down (comparator list) + Grade elements of LIST using COMPARATOR relation. This yields a + permutation vector such that applying this permutation to LIST + sorts it in descending order. + + (-grade-down #'< '(3 1 4 2 1 3 3)) + ⇒ (2 0 5 6 3 1 4) + (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices (-grade-down #'< l) l)) + ⇒ (4 3 3 3 2 1 1) + + +File: dash.info, Node: Set operations, Next: Other list operations, Prev: Indexing, Up: Functions + +2.9 Set operations +================== + +Operations pretending lists are sets. + + -- Function: -union (list1 list2) + Return a new list of distinct elements appearing in either LIST1 or + LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + (-union '(1 2 3) '(3 4 5)) + ⇒ (1 2 3 4 5) + (-union '(1 2 2 4) ()) + ⇒ (1 2 4) + (-union '(1 1 2 2) '(4 4 3 2 1)) + ⇒ (1 2 4 3) + + -- Function: -difference (list1 list2) + Return a new list with the distinct members of LIST1 that are not + in LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + (-difference () ()) + ⇒ () + (-difference '(1 2 3) '(4 5 6)) + ⇒ (1 2 3) + (-difference '(1 2 3 4) '(3 4 5 6)) + ⇒ (1 2) + + -- Function: -intersection (list1 list2) + Return a new list of distinct elements appearing in both LIST1 and + LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + (-intersection () ()) + ⇒ () + (-intersection '(1 2 3) '(4 5 6)) + ⇒ () + (-intersection '(1 2 2 3) '(4 3 3 2)) + ⇒ (2 3) + + -- Function: -powerset (list) + Return the power set of LIST. + + (-powerset ()) + ⇒ (nil) + (-powerset '(x y)) + ⇒ ((x y) (x) (y) nil) + (-powerset '(x y z)) + ⇒ ((x y z) (x y) (x z) (x) (y z) (y) (z) nil) + + -- Function: -permutations (list) + Return the distinct permutations of LIST. + + Duplicate elements of LIST are determined by ‘equal’, or by + ‘-compare-fn’ if that is non-‘nil’. + + (-permutations ()) + ⇒ (nil) + (-permutations '(a a b)) + ⇒ ((a a b) (a b a) (b a a)) + (-permutations '(a b c)) + ⇒ ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a)) + + -- Function: -distinct (list) + Return a copy of LIST with all duplicate elements removed. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + Alias: ‘-uniq’. + + (-distinct ()) + ⇒ () + (-distinct '(1 1 2 3 3)) + ⇒ (1 2 3) + (-distinct '(t t t)) + ⇒ (t) + + -- Function: -same-items? (list1 list2) + Return non-‘nil’ if LIST1 and LIST2 have the same distinct + elements. + + The order of the elements in the lists does not matter. The lists + may be of different lengths, i.e., contain duplicate elements. The + test for equality is done with ‘equal’, or with ‘-compare-fn’ if + that is non-‘nil’. + + Alias: ‘-same-items-p’. + + (-same-items? '(1 2 3) '(1 2 3)) + ⇒ t + (-same-items? '(1 1 2 3) '(3 3 2 1)) + ⇒ t + (-same-items? '(1 2 3) '(1 2 3 4)) + ⇒ nil + + +File: dash.info, Node: Other list operations, Next: Tree operations, Prev: Set operations, Up: Functions + +2.10 Other list operations +========================== + +Other list functions not fit to be classified elsewhere. + + -- Function: -rotate (n list) + Rotate LIST N places to the right (left if N is negative). The + time complexity is O(n). + + (-rotate 3 '(1 2 3 4 5 6 7)) + ⇒ (5 6 7 1 2 3 4) + (-rotate -3 '(1 2 3 4 5 6 7)) + ⇒ (4 5 6 7 1 2 3) + (-rotate 16 '(1 2 3 4 5 6 7)) + ⇒ (6 7 1 2 3 4 5) + + -- Function: -cons* (&rest args) + Make a new list from the elements of ARGS. The last 2 elements of + ARGS are used as the final cons of the result, so if the final + element of ARGS is not a list, the result is a dotted list. With + no ARGS, return ‘nil’. + + (-cons* 1 2) + ⇒ (1 . 2) + (-cons* 1 2 3) + ⇒ (1 2 . 3) + (-cons* 1) + ⇒ 1 + + -- Function: -snoc (list elem &rest elements) + Append ELEM to the end of the list. + + This is like ‘cons’, but operates on the end of list. + + If any ELEMENTS are given, append them to the list as well. + + (-snoc '(1 2 3) 4) + ⇒ (1 2 3 4) + (-snoc '(1 2 3) 4 5 6) + ⇒ (1 2 3 4 5 6) + (-snoc '(1 2 3) '(4 5 6)) + ⇒ (1 2 3 (4 5 6)) + + -- Function: -interpose (sep list) + Return a new list of all elements in LIST separated by SEP. + + (-interpose "-" ()) + ⇒ () + (-interpose "-" '("a")) + ⇒ ("a") + (-interpose "-" '("a" "b" "c")) + ⇒ ("a" "-" "b" "-" "c") + + -- Function: -interleave (&rest lists) + Return a new list of the first item in each list, then the second + etc. + + (-interleave '(1 2) '("a" "b")) + ⇒ (1 "a" 2 "b") + (-interleave '(1 2) '("a" "b") '("A" "B")) + ⇒ (1 "a" "A" 2 "b" "B") + (-interleave '(1 2 3) '("a" "b")) + ⇒ (1 "a" 2 "b") + + -- Function: -iota (count &optional start step) + Return a list containing COUNT numbers. Starts from START and adds + STEP each time. The default START is zero, the default STEP is 1. + This function takes its name from the corresponding primitive in + the APL language. + + (-iota 6) + ⇒ (0 1 2 3 4 5) + (-iota 4 2.5 -2) + ⇒ (2.5 0.5 -1.5 -3.5) + (-iota -1) + error→ Wrong type argument: natnump, -1 + + -- Function: -zip-with (fn list1 list2) + Zip LIST1 and LIST2 into a new list using the function FN. That + is, apply FN pairwise taking as first argument the next element of + LIST1 and as second argument the next element of LIST2 at the + corresponding position. The result is as long as the shorter list. + + This function’s anaphoric counterpart is ‘--zip-with’. + + For other zips, see also ‘-zip-lists’ (*note -zip-lists::) and + ‘-zip-fill’ (*note -zip-fill::). + + (-zip-with #'+ '(1 2 3 4) '(5 6 7)) + ⇒ (6 8 10) + (-zip-with #'cons '(1 2 3) '(4 5 6 7)) + ⇒ ((1 . 4) (2 . 5) (3 . 6)) + (--zip-with (format "%s & %s" it other) '(Batman Jekyll) '(Robin Hyde)) + ⇒ ("Batman & Robin" "Jekyll & Hyde") + + -- Function: -zip-pair (list1 list2) + Zip LIST1 and LIST2 together. + + Make a pair with the head of each list, followed by a pair with the + second element of each list, and so on. The number of pairs + returned is equal to the length of the shorter input list. + + See also: ‘-zip-lists’ (*note -zip-lists::). + + (-zip-pair '(1 2 3 4) '(5 6 7)) + ⇒ ((1 . 5) (2 . 6) (3 . 7)) + (-zip-pair '(1 2 3) '(4 5 6)) + ⇒ ((1 . 4) (2 . 5) (3 . 6)) + (-zip-pair '(1 2) '(3)) + ⇒ ((1 . 3)) + + -- Function: -zip-lists (&rest lists) + Zip LISTS together. + + Group the head of each list, followed by the second element of each + list, and so on. The number of returned groupings is equal to the + length of the shortest input list, and the length of each grouping + is equal to the number of input LISTS. + + The return value is always a list of proper lists, in contrast to + ‘-zip’ (*note -zip::) which returns a list of dotted pairs when + only two input LISTS are provided. + + See also: ‘-zip-pair’ (*note -zip-pair::). + + (-zip-lists '(1 2 3) '(4 5 6)) + ⇒ ((1 4) (2 5) (3 6)) + (-zip-lists '(1 2 3) '(4 5 6 7)) + ⇒ ((1 4) (2 5) (3 6)) + (-zip-lists '(1 2) '(3 4 5) '(6)) + ⇒ ((1 3 6)) + + -- Function: -zip-lists-fill (fill-value &rest lists) + Zip LISTS together, padding shorter lists with FILL-VALUE. This is + like ‘-zip-lists’ (*note -zip-lists::) (which see), except it + retains all elements at positions beyond the end of the shortest + list. The number of returned groupings is equal to the length of + the longest input list, and the length of each grouping is equal to + the number of input LISTS. + + (-zip-lists-fill 0 '(1 2) '(3 4 5) '(6)) + ⇒ ((1 3 6) (2 4 0) (0 5 0)) + (-zip-lists-fill 0 '(1 2) '(3 4) '(5 6)) + ⇒ ((1 3 5) (2 4 6)) + (-zip-lists-fill 0 '(1 2 3) nil) + ⇒ ((1 0) (2 0) (3 0)) + + -- Function: -zip (&rest lists) + Zip LISTS together. + + Group the head of each list, followed by the second element of each + list, and so on. The number of returned groupings is equal to the + length of the shortest input list, and the number of items in each + grouping is equal to the number of input LISTS. + + If only two LISTS are provided as arguments, return the groupings + as a list of dotted pairs. Otherwise, return the groupings as a + list of proper lists. + + Since the return value changes form depending on the number of + arguments, it is generally recommended to use ‘-zip-lists’ (*note + -zip-lists::) instead, or ‘-zip-pair’ (*note -zip-pair::) if a list + of dotted pairs is desired. + + See also: ‘-unzip’ (*note -unzip::). + + (-zip '(1 2 3 4) '(5 6 7) '(8 9)) + ⇒ ((1 5 8) (2 6 9)) + (-zip '(1 2 3) '(4 5 6) '(7 8 9)) + ⇒ ((1 4 7) (2 5 8) (3 6 9)) + (-zip '(1 2 3)) + ⇒ ((1) (2) (3)) + + -- Function: -zip-fill (fill-value &rest lists) + Zip LISTS together, padding shorter lists with FILL-VALUE. This is + like ‘-zip’ (*note -zip::) (which see), except it retains all + elements at positions beyond the end of the shortest list. The + number of returned groupings is equal to the length of the longest + input list, and the length of each grouping is equal to the number + of input LISTS. + + Since the return value changes form depending on the number of + arguments, it is generally recommended to use ‘-zip-lists-fill’ + (*note -zip-lists-fill::) instead, unless a list of dotted pairs is + explicitly desired. + + (-zip-fill 0 '(1 2 3) '(4 5)) + ⇒ ((1 . 4) (2 . 5) (3 . 0)) + (-zip-fill 0 () '(1 2 3)) + ⇒ ((0 . 1) (0 . 2) (0 . 3)) + (-zip-fill 0 '(1 2) '(3 4) '(5 6)) + ⇒ ((1 3 5) (2 4 6)) + + -- Function: -unzip-lists (lists) + Unzip LISTS. + + This works just like ‘-zip-lists’ (*note -zip-lists::) (which see), + but takes a list of lists instead of a variable number of + arguments, such that + + (-unzip-lists (-zip-lists ARGS...)) + + is identity (given that the lists comprising ARGS are of the same + length). + + (-unzip-lists (-zip-lists '(1 2) '(3 4) '(5 6))) + ⇒ ((1 2) (3 4) (5 6)) + (-unzip-lists '((1 2 3) (4 5) (6 7) (8 9))) + ⇒ ((1 4 6 8) (2 5 7 9)) + (-unzip-lists '((1 2 3) (4 5 6))) + ⇒ ((1 4) (2 5) (3 6)) + + -- Function: -unzip (lists) + Unzip LISTS. + + This works just like ‘-zip’ (*note -zip::) (which see), but takes a + list of lists instead of a variable number of arguments, such that + + (-unzip (-zip L1 L2 L3 ...)) + + is identity (given that the lists are of the same length, and that + ‘-zip’ (*note -zip::) is not called with two arguments, because of + the caveat described in its docstring). + + Note in particular that calling ‘-unzip’ (*note -unzip::) on a list + of two lists will return a list of dotted pairs. + + Since the return value changes form depending on the number of + LISTS, it is generally recommended to use ‘-unzip-lists’ (*note + -unzip-lists::) instead. + + (-unzip (-zip '(1 2) '(3 4) '(5 6))) + ⇒ ((1 . 2) (3 . 4) (5 . 6)) + (-unzip '((1 2 3) (4 5 6))) + ⇒ ((1 . 4) (2 . 5) (3 . 6)) + (-unzip '((1 2 3) (4 5) (6 7) (8 9))) + ⇒ ((1 4 6 8) (2 5 7 9)) + + -- Function: -pad (fill-value &rest lists) + Pad each of LISTS with FILL-VALUE until they all have equal + lengths. + + Ensure all LISTS are as long as the longest one by repeatedly + appending FILL-VALUE to the shorter lists, and return the resulting + LISTS. + + (-pad 0 ()) + ⇒ (nil) + (-pad 0 '(1 2) '(3 4)) + ⇒ ((1 2) (3 4)) + (-pad 0 '(1 2) '(3 4 5 6) '(7 8 9)) + ⇒ ((1 2 0 0) (3 4 5 6) (7 8 9 0)) + + -- Function: -table (fn &rest lists) + Compute outer product of LISTS using function FN. + + The function FN should have the same arity as the number of + supplied lists. + + The outer product is computed by applying fn to all possible + combinations created by taking one element from each list in order. + The dimension of the result is (length lists). + + See also: ‘-table-flat’ (*note -table-flat::) + + (-table '* '(1 2 3) '(1 2 3)) + ⇒ ((1 2 3) (2 4 6) (3 6 9)) + (-table (lambda (a b) (-sum (-zip-with '* a b))) '((1 2) (3 4)) '((1 3) (2 4))) + ⇒ ((7 15) (10 22)) + (apply '-table 'list (-repeat 3 '(1 2))) + ⇒ ((((1 1 1) (2 1 1)) ((1 2 1) (2 2 1))) (((1 1 2) (2 1 2)) ((1 2 2) (2 2 2)))) + + -- Function: -table-flat (fn &rest lists) + Compute flat outer product of LISTS using function FN. + + The function FN should have the same arity as the number of + supplied lists. + + The outer product is computed by applying fn to all possible + combinations created by taking one element from each list in order. + The results are flattened, ignoring the tensor structure of the + result. This is equivalent to calling: + + (-flatten-n (1- (length lists)) (apply ’-table fn lists)) + + but the implementation here is much more efficient. + + See also: ‘-flatten-n’ (*note -flatten-n::), ‘-table’ (*note + -table::) + + (-table-flat 'list '(1 2 3) '(a b c)) + ⇒ ((1 a) (2 a) (3 a) (1 b) (2 b) (3 b) (1 c) (2 c) (3 c)) + (-table-flat '* '(1 2 3) '(1 2 3)) + ⇒ (1 2 3 2 4 6 3 6 9) + (apply '-table-flat 'list (-repeat 3 '(1 2))) + ⇒ ((1 1 1) (2 1 1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2)) + + -- Function: -first (pred list) + Return the first item in LIST for which PRED returns non-‘nil’. + Return ‘nil’ if no such element is found. + + To get the first item in the list no questions asked, use + ‘-first-item’ (*note -first-item::). + + Alias: ‘-find’. + + This function’s anaphoric counterpart is ‘--first’. + + (-first #'natnump '(-1 0 1)) + ⇒ 0 + (-first #'null '(1 2 3)) + ⇒ nil + (--first (> it 2) '(1 2 3)) + ⇒ 3 + + -- Function: -last (pred list) + Return the last x in LIST where (PRED x) is non-‘nil’, else ‘nil’. + + (-last 'even? '(1 2 3 4 5 6 3 3 3)) + ⇒ 6 + (-last 'even? '(1 3 7 5 9)) + ⇒ nil + (--last (> (length it) 3) '("a" "looong" "word" "and" "short" "one")) + ⇒ "short" + + -- Function: -first-item (list) + Return the first item of LIST, or ‘nil’ on an empty list. + + See also: ‘-second-item’ (*note -second-item::), ‘-last-item’ + (*note -last-item::), etc. + + (-first-item ()) + ⇒ () + (-first-item '(1 2 3 4 5)) + ⇒ 1 + (let ((list (list 1 2 3))) (setf (-first-item list) 5) list) + ⇒ (5 2 3) + + -- Function: -second-item (list) + Return the second item of LIST, or ‘nil’ if LIST is too short. + + See also: ‘-first-item’ (*note -first-item::), ‘-third-item’ (*note + -third-item::), etc. + + (-second-item ()) + ⇒ () + (-second-item '(1 2 3 4 5)) + ⇒ 2 + (let ((list (list 1 2))) (setf (-second-item list) 5) list) + ⇒ (1 5) + + -- Function: -third-item (list) + Return the third item of LIST, or ‘nil’ if LIST is too short. + + See also: ‘-second-item’ (*note -second-item::), ‘-fourth-item’ + (*note -fourth-item::), etc. + + (-third-item ()) + ⇒ () + (-third-item '(1 2)) + ⇒ () + (-third-item '(1 2 3 4 5)) + ⇒ 3 + + -- Function: -fourth-item (list) + Return the fourth item of LIST, or ‘nil’ if LIST is too short. + + See also: ‘-third-item’ (*note -third-item::), ‘-fifth-item’ (*note + -fifth-item::), etc. + + (-fourth-item ()) + ⇒ () + (-fourth-item '(1 2 3)) + ⇒ () + (-fourth-item '(1 2 3 4 5)) + ⇒ 4 + + -- Function: -fifth-item (list) + Return the fifth item of LIST, or ‘nil’ if LIST is too short. + + See also: ‘-fourth-item’ (*note -fourth-item::), ‘-last-item’ + (*note -last-item::), etc. + + (-fifth-item ()) + ⇒ () + (-fifth-item '(1 2 3 4)) + ⇒ () + (-fifth-item '(1 2 3 4 5)) + ⇒ 5 + + -- Function: -last-item (list) + Return the last item of LIST, or ‘nil’ on an empty list. + + See also: ‘-first-item’ (*note -first-item::), etc. + + (-last-item ()) + ⇒ () + (-last-item '(1 2 3 4 5)) + ⇒ 5 + (let ((list (list 1 2 3))) (setf (-last-item list) 5) list) + ⇒ (1 2 5) + + -- Function: -butlast (list) + Return a list of all items in list except for the last. + + (-butlast '(1 2 3)) + ⇒ (1 2) + (-butlast '(1 2)) + ⇒ (1) + (-butlast '(1)) + ⇒ nil + + -- Function: -sort (comparator list) + Sort LIST, stably, comparing elements using COMPARATOR. Return the + sorted list. LIST is NOT modified by side effects. COMPARATOR is + called with two elements of LIST, and should return non-‘nil’ if + the first element should sort before the second. + + (-sort #'< '(3 1 2)) + ⇒ (1 2 3) + (-sort #'> '(3 1 2)) + ⇒ (3 2 1) + (--sort (< it other) '(3 1 2)) + ⇒ (1 2 3) + + -- Function: -list (arg) + Ensure ARG is a list. If ARG is already a list, return it as is + (not a copy). Otherwise, return a new list with ARG as its only + element. + + Another supported calling convention is (-list &rest ARGS). In + this case, if ARG is not a list, a new list with all of ARGS as + elements is returned. This use is supported for backward + compatibility and is otherwise deprecated. + + (-list 1) + ⇒ (1) + (-list ()) + ⇒ () + (-list '(1 2 3)) + ⇒ (1 2 3) + + -- Function: -fix (fn list) + Compute the (least) fixpoint of FN with initial input LIST. + + FN is called at least once, results are compared with ‘equal’. + + (-fix (lambda (l) (-non-nil (--mapcat (-split-at (/ (length it) 2) it) l))) '((1 2 3))) + ⇒ ((1) (2) (3)) + (let ((l '((starwars scifi) (jedi starwars warrior)))) (--fix (-uniq (--mapcat (cons it (cdr (assq it l))) it)) '(jedi book))) + ⇒ (jedi starwars warrior scifi book) + + +File: dash.info, Node: Tree operations, Next: Threading macros, Prev: Other list operations, Up: Functions + +2.11 Tree operations +==================== + +Functions pretending lists are trees. + + -- Function: -tree-seq (branch children tree) + Return a sequence of the nodes in TREE, in depth-first search + order. + + BRANCH is a predicate of one argument that returns non-‘nil’ if the + passed argument is a branch, that is, a node that can have + children. + + CHILDREN is a function of one argument that returns the children of + the passed branch node. + + Non-branch nodes are simply copied. + + (-tree-seq 'listp 'identity '(1 (2 3) 4 (5 (6 7)))) + ⇒ ((1 (2 3) 4 (5 (6 7))) 1 (2 3) 2 3 4 (5 (6 7)) 5 (6 7) 6 7) + (-tree-seq 'listp 'reverse '(1 (2 3) 4 (5 (6 7)))) + ⇒ ((1 (2 3) 4 (5 (6 7))) (5 (6 7)) (6 7) 7 6 5 4 (2 3) 3 2 1) + (--tree-seq (vectorp it) (append it nil) [1 [2 3] 4 [5 [6 7]]]) + ⇒ ([1 [2 3] 4 [5 [6 7]]] 1 [2 3] 2 3 4 [5 [6 7]] 5 [6 7] 6 7) + + -- Function: -tree-map (fn tree) + Apply FN to each element of TREE while preserving the tree + structure. + + (-tree-map '1+ '(1 (2 3) (4 (5 6) 7))) + ⇒ (2 (3 4) (5 (6 7) 8)) + (-tree-map '(lambda (x) (cons x (expt 2 x))) '(1 (2 3) 4)) + ⇒ ((1 . 2) ((2 . 4) (3 . 8)) (4 . 16)) + (--tree-map (length it) '("" ("

" "text" "

") "")) + ⇒ (6 (3 4 4) 7) + + -- Function: -tree-map-nodes (pred fun tree) + Call FUN on each node of TREE that satisfies PRED. + + If PRED returns ‘nil’, continue descending down this node. If PRED + returns non-‘nil’, apply FUN to this node and do not descend + further. + + (-tree-map-nodes 'vectorp (lambda (x) (-sum (append x nil))) '(1 [2 3] 4 (5 [6 7] 8))) + ⇒ (1 5 4 (5 13 8)) + (-tree-map-nodes 'keywordp (lambda (x) (symbol-name x)) '(1 :foo 4 ((5 6 :bar) :baz 8))) + ⇒ (1 ":foo" 4 ((5 6 ":bar") ":baz" 8)) + (--tree-map-nodes (eq (car-safe it) 'add-mode) (-concat it (list :mode 'emacs-lisp-mode)) '(with-mode emacs-lisp-mode (foo bar) (add-mode a b) (baz (add-mode c d)))) + ⇒ (with-mode emacs-lisp-mode (foo bar) (add-mode a b :mode emacs-lisp-mode) (baz (add-mode c d :mode emacs-lisp-mode))) + + -- Function: -tree-reduce (fn tree) + Use FN to reduce elements of list TREE. If elements of TREE are + lists themselves, apply the reduction recursively. + + FN is first applied to first element of the list and second + element, then on this result and third element from the list etc. + + See ‘-reduce-r’ (*note -reduce-r::) for how exactly are lists of + zero or one element handled. + + (-tree-reduce '+ '(1 (2 3) (4 5))) + ⇒ 15 + (-tree-reduce 'concat '("strings" (" on" " various") ((" levels")))) + ⇒ "strings on various levels" + (--tree-reduce (cond ((stringp it) (concat it " " acc)) (t (let ((sn (symbol-name it))) (concat "<" sn ">" acc "")))) '(body (p "some words") (div "more" (b "bold") "words"))) + ⇒ "

some words

more bold words
" + + -- Function: -tree-reduce-from (fn init-value tree) + Use FN to reduce elements of list TREE. If elements of TREE are + lists themselves, apply the reduction recursively. + + FN is first applied to INIT-VALUE and first element of the list, + then on this result and second element from the list etc. + + The initial value is ignored on cons pairs as they always contain + two elements. + + (-tree-reduce-from '+ 1 '(1 (1 1) ((1)))) + ⇒ 8 + (--tree-reduce-from (-concat acc (list it)) nil '(1 (2 3 (4 5)) (6 7))) + ⇒ ((7 6) ((5 4) 3 2) 1) + + -- Function: -tree-mapreduce (fn folder tree) + Apply FN to each element of TREE, and make a list of the results. + If elements of TREE are lists themselves, apply FN recursively to + elements of these nested lists. + + Then reduce the resulting lists using FOLDER and initial value + INIT-VALUE. See ‘-reduce-r-from’ (*note -reduce-r-from::). + + This is the same as calling ‘-tree-reduce’ (*note -tree-reduce::) + after ‘-tree-map’ (*note -tree-map::) but is twice as fast as it + only traverse the structure once. + + (-tree-mapreduce 'list 'append '(1 (2 (3 4) (5 6)) (7 (8 9)))) + ⇒ (1 2 3 4 5 6 7 8 9) + (--tree-mapreduce 1 (+ it acc) '(1 (2 (4 9) (2 1)) (7 (4 3)))) + ⇒ 9 + (--tree-mapreduce 0 (max acc (1+ it)) '(1 (2 (4 9) (2 1)) (7 (4 3)))) + ⇒ 3 + + -- Function: -tree-mapreduce-from (fn folder init-value tree) + Apply FN to each element of TREE, and make a list of the results. + If elements of TREE are lists themselves, apply FN recursively to + elements of these nested lists. + + Then reduce the resulting lists using FOLDER and initial value + INIT-VALUE. See ‘-reduce-r-from’ (*note -reduce-r-from::). + + This is the same as calling ‘-tree-reduce-from’ (*note + -tree-reduce-from::) after ‘-tree-map’ (*note -tree-map::) but is + twice as fast as it only traverse the structure once. + + (-tree-mapreduce-from 'identity '* 1 '(1 (2 (3 4) (5 6)) (7 (8 9)))) + ⇒ 362880 + (--tree-mapreduce-from (+ it it) (cons it acc) nil '(1 (2 (4 9) (2 1)) (7 (4 3)))) + ⇒ (2 (4 (8 18) (4 2)) (14 (8 6))) + (concat "{" (--tree-mapreduce-from (cond ((-cons-pair? it) (concat (symbol-name (car it)) " -> " (symbol-name (cdr it)))) (t (concat (symbol-name it) " : {"))) (concat it (unless (or (equal acc "}") (equal (substring it (1- (length it))) "{")) ", ") acc) "}" '((elisp-mode (foo (bar . booze)) (baz . qux)) (c-mode (foo . bla) (bum . bam))))) + ⇒ "{elisp-mode : {foo : {bar -> booze}, baz -> qux}, c-mode : {foo -> bla, bum -> bam}}" + + -- Function: -clone (list) + Create a deep copy of LIST. The new list has the same elements and + structure but all cons are replaced with new ones. This is useful + when you need to clone a structure such as plist or alist. + + (let* ((a (list (list 1))) (b (-clone a))) (setcar (car a) 2) b) + ⇒ ((1)) + + +File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions + +2.12 Threading macros +===================== + +Macros that conditionally combine sequential forms for brevity or +readability. + + -- Macro: -> (x &optional form &rest more) + Thread the expr through the forms. Insert X as the second item in + the first form, making a list of it if it is not a list already. + If there are more forms, insert the first form as the second item + in second form, etc. + + (-> '(2 3 5)) + ⇒ (2 3 5) + (-> '(2 3 5) (append '(8 13))) + ⇒ (2 3 5 8 13) + (-> '(2 3 5) (append '(8 13)) (-slice 1 -1)) + ⇒ (3 5 8) + + -- Macro: ->> (x &optional form &rest more) + Thread the expr through the forms. Insert X as the last item in + the first form, making a list of it if it is not a list already. + If there are more forms, insert the first form as the last item in + second form, etc. + + (->> '(1 2 3) (-map 'square)) + ⇒ (1 4 9) + (->> '(1 2 3) (-map 'square) (-remove 'even?)) + ⇒ (1 9) + (->> '(1 2 3) (-map 'square) (-reduce '+)) + ⇒ 14 + + -- Macro: --> (x &rest forms) + Starting with the value of X, thread each expression through FORMS. + + Insert X at the position signified by the symbol ‘it’ in the first + form. If there are more forms, insert the first form at the + position signified by ‘it’ in in second form, etc. + + (--> "def" (concat "abc" it "ghi")) + ⇒ "abcdefghi" + (--> "def" (concat "abc" it "ghi") (upcase it)) + ⇒ "ABCDEFGHI" + (--> "def" (concat "abc" it "ghi") upcase) + ⇒ "ABCDEFGHI" + + -- Macro: -as-> (value variable &rest forms) + Starting with VALUE, thread VARIABLE through FORMS. + + In the first form, bind VARIABLE to VALUE. In the second form, + bind VARIABLE to the result of the first form, and so forth. + + (-as-> 3 my-var (1+ my-var) (list my-var) (mapcar (lambda (ele) (* 2 ele)) my-var)) + ⇒ (8) + (-as-> 3 my-var 1+) + ⇒ 4 + (-as-> 3 my-var) + ⇒ 3 + + -- Macro: -some-> (x &optional form &rest more) + When expr is non-‘nil’, thread it through the first form (via ‘->’ + (*note ->::)), and when that result is non-‘nil’, through the next + form, etc. + + (-some-> '(2 3 5)) + ⇒ (2 3 5) + (-some-> 5 square) + ⇒ 25 + (-some-> 5 even? square) + ⇒ nil + + -- Macro: -some->> (x &optional form &rest more) + When expr is non-‘nil’, thread it through the first form (via ‘->>’ + (*note ->>::)), and when that result is non-‘nil’, through the next + form, etc. + + (-some->> '(1 2 3) (-map 'square)) + ⇒ (1 4 9) + (-some->> '(1 3 5) (-last 'even?) (+ 100)) + ⇒ nil + (-some->> '(2 4 6) (-last 'even?) (+ 100)) + ⇒ 106 + + -- Macro: -some--> (expr &rest forms) + Thread EXPR through FORMS via ‘-->’ (*note -->::), while the result + is non-‘nil’. When EXPR evaluates to non-‘nil’, thread the result + through the first of FORMS, and when that result is non-‘nil’, + thread it through the next form, etc. + + (-some--> "def" (concat "abc" it "ghi")) + ⇒ "abcdefghi" + (-some--> nil (concat "abc" it "ghi")) + ⇒ nil + (-some--> '(0 1) (-remove #'natnump it) (append it it) (-map #'1+ it)) + ⇒ () + + -- Macro: -doto (init &rest forms) + Evaluate INIT and pass it as argument to FORMS with ‘->’ (*note + ->::). The RESULT of evaluating INIT is threaded through each of + FORMS individually using ‘->’ (*note ->::), which see. The return + value is RESULT, which FORMS may have modified by side effect. + + (-doto (list 1 2 3) pop pop) + ⇒ (3) + (-doto (cons 1 2) (setcar 3) (setcdr 4)) + ⇒ (3 . 4) + (gethash 'k (--doto (make-hash-table) (puthash 'k 'v it))) + ⇒ v + + +File: dash.info, Node: Binding, Next: Side effects, Prev: Threading macros, Up: Functions + +2.13 Binding +============ + +Macros that combine ‘let’ and ‘let*’ with destructuring and flow +control. + + -- Macro: -when-let ((var val) &rest body) + If VAL evaluates to non-‘nil’, bind it to VAR and execute body. + + Note: binding is done according to ‘-let’ (*note -let::). + + (-when-let (match-index (string-match "d" "abcd")) (+ match-index 2)) + ⇒ 5 + (-when-let ((&plist :foo foo) (list :foo "foo")) foo) + ⇒ "foo" + (-when-let ((&plist :foo foo) (list :bar "bar")) foo) + ⇒ nil + + -- Macro: -when-let* (vars-vals &rest body) + If all VALS evaluate to true, bind them to their corresponding VARS + and execute body. VARS-VALS should be a list of (VAR VAL) pairs. + + Note: binding is done according to ‘-let*’ (*note -let*::). VALS + are evaluated sequentially, and evaluation stops after the first + ‘nil’ VAL is encountered. + + (-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) + ⇒ 15 + (-when-let* ((x 5) (y nil) (z 7)) (+ x y z)) + ⇒ nil + + -- Macro: -if-let ((var val) then &rest else) + If VAL evaluates to non-‘nil’, bind it to VAR and do THEN, + otherwise do ELSE. + + Note: binding is done according to ‘-let’ (*note -let::). + + (-if-let (match-index (string-match "d" "abc")) (+ match-index 3) 7) + ⇒ 7 + (--if-let (even? 4) it nil) + ⇒ t + + -- Macro: -if-let* (vars-vals then &rest else) + If all VALS evaluate to true, bind them to their corresponding VARS + and do THEN, otherwise do ELSE. VARS-VALS should be a list of (VAR + VAL) pairs. + + Note: binding is done according to ‘-let*’ (*note -let*::). VALS + are evaluated sequentially, and evaluation stops after the first + ‘nil’ VAL is encountered. + + (-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") + ⇒ 15 + (-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") + ⇒ "foo" + (-if-let* (((_ _ x) '(nil nil 7))) x) + ⇒ 7 + + -- Macro: -let (varlist &rest body) + Bind variables according to VARLIST then eval BODY. + + VARLIST is a list of lists of the form (PATTERN SOURCE). Each + PATTERN is matched against the SOURCE "structurally". SOURCE is + only evaluated once for each PATTERN. Each PATTERN is matched + recursively, and can therefore contain sub-patterns which are + matched against corresponding sub-expressions of SOURCE. + + All the SOURCEs are evalled before any symbols are bound (i.e. "in + parallel"). + + If VARLIST only contains one (PATTERN SOURCE) element, you can + optionally specify it using a vector and discarding the outer-most + parens. Thus + + (-let ((PATTERN SOURCE)) ...) + + becomes + + (-let [PATTERN SOURCE] ...). + + ‘-let’ (*note -let::) uses a convention of not binding places + (symbols) starting with _ whenever it’s possible. You can use this + to skip over entries you don’t care about. However, this is not + *always* possible (as a result of implementation) and these symbols + might get bound to undefined values. + + Following is the overview of supported patterns. Remember that + patterns can be matched recursively, so every a, b, aK in the + following can be a matching construct and not necessarily a + symbol/variable. + + Symbol: + + a - bind the SOURCE to A. This is just like regular ‘let’. + + Conses and lists: + + (a) - bind ‘car’ of cons/list to A + + (a . b) - bind car of cons to A and ‘cdr’ to B + + (a b) - bind car of list to A and ‘cadr’ to B + + (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to + A3... + + (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST. + + Vectors: + + [a] - bind 0th element of a non-list sequence to A (works with + vectors, strings, bit arrays...) + + [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st + to A1, 2nd to A2, ... If the PATTERN is shorter than SOURCE, the + values at places not in PATTERN are ignored. If the PATTERN is + longer than SOURCE, an ‘error’ is thrown. + + [a1 a2 a3 ... &rest rest] - as above, but bind the rest of the + sequence to REST. This is conceptually the same as improper list + matching (a1 a2 ... aN . rest) + + Key/value stores: + + (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE plist to aK. If the value is not found, aK is ‘nil’. Uses + ‘plist-get’ to fetch values. + + (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE alist to aK. If the value is not found, aK is ‘nil’. Uses + ‘assoc’ to fetch values. + + (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the + SOURCE hash table to aK. If the value is not found, aK is ‘nil’. + Uses ‘gethash’ to fetch values. + + Further, special keyword &keys supports "inline" matching of + plist-like key-value pairs, similarly to &keys keyword of + ‘cl-defun’. + + (a1 a2 ... aN &keys key1 b1 ... keyN bK) + + This binds N values from the list to a1 ... aN, then interprets the + cdr as a plist (see key/value matching above). + + A shorthand notation for kv-destructuring exists which allows the + patterns be optionally left out and derived from the key name in + the following fashion: + + - a key :foo is converted into ‘foo’ pattern, - a key ’bar is + converted into ‘bar’ pattern, - a key "baz" is converted into ‘baz’ + pattern. + + That is, the entire value under the key is bound to the derived + variable without any further destructuring. + + This is possible only when the form following the key is not a + valid pattern (i.e. not a symbol, a cons cell or a vector). + Otherwise the matching proceeds as usual and in case of an invalid + spec fails with an error. + + Thus the patterns are normalized as follows: + + ;; derive all the missing patterns (&plist :foo ’bar "baz") => + (&plist :foo foo ’bar bar "baz" baz) + + ;; we can specify some but not others (&plist :foo ’bar + explicit-bar) => (&plist :foo foo ’bar explicit-bar) + + ;; nothing happens, we store :foo in x (&plist :foo x) => (&plist + :foo x) + + ;; nothing happens, we match recursively (&plist :foo (a b c)) => + (&plist :foo (a b c)) + + You can name the source using the syntax SYMBOL &as PATTERN. This + syntax works with lists (proper or improper), vectors and all types + of maps. + + (list &as a b c) (list 1 2 3) + + binds A to 1, B to 2, C to 3 and LIST to (1 2 3). + + Similarly: + + (bounds &as beg . end) (cons 1 2) + + binds BEG to 1, END to 2 and BOUNDS to (1 . 2). + + (items &as first . rest) (list 1 2 3) + + binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3) + + [vect &as _ b c] [1 2 3] + + binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as + usual). + + (plist &as &plist :b b) (list :a 1 :b 2 :c 3) + + binds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and + &hash. + + This is especially useful when we want to capture the result of a + computation and destructure at the same time. Consider the form + (function-returning-complex-structure) returning a list of two + vectors with two items each. We want to capture this entire result + and pass it to another computation, but at the same time we want to + get the second item from each vector. We can achieve it with + pattern + + (result &as [_ a] [_ b]) (function-returning-complex-structure) + + Note: Clojure programmers may know this feature as the ":as + binding". The difference is that we put the &as at the front + because we need to support improper list binding. + + (-let (([a (b c) d] [1 (2 3) 4])) (list a b c d)) + ⇒ (1 2 3 4) + (-let [(a b c . d) (list 1 2 3 4 5 6)] (list a b c d)) + ⇒ (1 2 3 (4 5 6)) + (-let [(&plist :foo foo :bar bar) (list :baz 3 :foo 1 :qux 4 :bar 2)] (list foo bar)) + ⇒ (1 2) + + -- Macro: -let* (varlist &rest body) + Bind variables according to VARLIST then eval BODY. + + VARLIST is a list of lists of the form (PATTERN SOURCE). Each + PATTERN is matched against the SOURCE structurally. SOURCE is only + evaluated once for each PATTERN. + + Each SOURCE can refer to the symbols already bound by this VARLIST. + This is useful if you want to destructure SOURCE recursively but + also want to name the intermediate structures. + + See ‘-let’ (*note -let::) for the list of all possible patterns. + + (-let* (((a . b) (cons 1 2)) ((c . d) (cons 3 4))) (list a b c d)) + ⇒ (1 2 3 4) + (-let* (((a . b) (cons 1 (cons 2 3))) ((c . d) b)) (list a b c d)) + ⇒ (1 (2 . 3) 2 3) + (-let* (((&alist "foo" foo "bar" bar) (list (cons "foo" 1) (cons "bar" (list 'a 'b 'c)))) ((a b c) bar)) (list foo a b c bar)) + ⇒ (1 a b c (a b c)) + + -- Macro: -lambda (match-form &rest body) + Return a lambda which destructures its input as MATCH-FORM and + executes BODY. + + Note that you have to enclose the MATCH-FORM in a pair of parens, + such that: + + (-lambda (x) body) (-lambda (x y ...) body) + + has the usual semantics of ‘lambda’. Furthermore, these get + translated into normal ‘lambda’, so there is no performance + penalty. + + See ‘-let’ (*note -let::) for a description of the destructuring + mechanism. + + (-map (-lambda ((x y)) (+ x y)) '((1 2) (3 4) (5 6))) + ⇒ (3 7 11) + (-map (-lambda ([x y]) (+ x y)) '([1 2] [3 4] [5 6])) + ⇒ (3 7 11) + (funcall (-lambda ((_ . a) (_ . b)) (-concat a b)) '(1 2 3) '(4 5 6)) + ⇒ (2 3 5 6) + + -- Macro: -setq ([match-form val] ...) + Bind each MATCH-FORM to the value of its VAL. + + MATCH-FORM destructuring is done according to the rules of ‘-let’ + (*note -let::). + + This macro allows you to bind multiple variables by destructuring + the value, so for example: + + (-setq (a b) x (&plist :c c) plist) + + expands roughly speaking to the following code + + (setq a (car x) b (cadr x) c (plist-get plist :c)) + + Care is taken to only evaluate each VAL once so that in case of + multiple assignments it does not cause unexpected side effects. + + (let (a) (-setq a 1) a) + ⇒ 1 + (let (a b) (-setq (a b) (list 1 2)) (list a b)) + ⇒ (1 2) + (let (c) (-setq (&plist :c c) (list :c "c")) c) + ⇒ "c" + + +File: dash.info, Node: Side effects, Next: Destructive operations, Prev: Binding, Up: Functions + +2.14 Side effects +================= + +Functions iterating over lists for side effect only. + + -- Function: -each (list fn) + Call FN on each element of LIST. Return ‘nil’; this function is + intended for side effects. + + Its anaphoric counterpart is ‘--each’. + + For access to the current element’s index in LIST, see + ‘-each-indexed’ (*note -each-indexed::). + + (let (l) (-each '(1 2 3) (lambda (x) (push x l))) l) + ⇒ (3 2 1) + (let (l) (--each '(1 2 3) (push it l)) l) + ⇒ (3 2 1) + (-each '(1 2 3) #'identity) + ⇒ nil + + -- Function: -each-while (list pred fn) + Call FN on each ITEM in LIST, while (PRED ITEM) is non-‘nil’. Once + an ITEM is reached for which PRED returns ‘nil’, FN is no longer + called. Return ‘nil’; this function is intended for side effects. + + Its anaphoric counterpart is ‘--each-while’. + + (let (l) (-each-while '(2 4 5 6) #'even? (lambda (x) (push x l))) l) + ⇒ (4 2) + (let (l) (--each-while '(1 2 3 4) (< it 3) (push it l)) l) + ⇒ (2 1) + (let ((s 0)) (--each-while '(1 3 4 5) (< it 5) (setq s (+ s it))) s) + ⇒ 8 + + -- Function: -each-indexed (list fn) + Call FN on each index and element of LIST. For each ITEM at INDEX + in LIST, call (funcall FN INDEX ITEM). Return ‘nil’; this function + is intended for side effects. + + See also: ‘-map-indexed’ (*note -map-indexed::). + + (let (l) (-each-indexed '(a b c) (lambda (i x) (push (list x i) l))) l) + ⇒ ((c 2) (b 1) (a 0)) + (let (l) (--each-indexed '(a b c) (push (list it it-index) l)) l) + ⇒ ((c 2) (b 1) (a 0)) + (let (l) (--each-indexed () (push it l)) l) + ⇒ () + + -- Function: -each-r (list fn) + Call FN on each element of LIST in reversed order. Return ‘nil’; + this function is intended for side effects. + + Its anaphoric counterpart is ‘--each-r’. + + (let (l) (-each-r '(1 2 3) (lambda (x) (push x l))) l) + ⇒ (1 2 3) + (let (l) (--each-r '(1 2 3) (push it l)) l) + ⇒ (1 2 3) + (-each-r '(1 2 3) #'identity) + ⇒ nil + + -- Function: -each-r-while (list pred fn) + Call FN on each ITEM in reversed LIST, while (PRED ITEM) is + non-‘nil’. Once an ITEM is reached for which PRED returns ‘nil’, + FN is no longer called. Return ‘nil’; this function is intended + for side effects. + + Its anaphoric counterpart is ‘--each-r-while’. + + (let (l) (-each-r-while '(2 4 5 6) #'even? (lambda (x) (push x l))) l) + ⇒ (6) + (let (l) (--each-r-while '(1 2 3 4) (>= it 3) (push it l)) l) + ⇒ (3 4) + (let ((s 0)) (--each-r-while '(1 2 3 5) (> it 1) (setq s (+ s it))) s) + ⇒ 10 + + -- Function: -dotimes (num fn) + Call FN NUM times, presumably for side effects. FN is called with + a single argument on successive integers running from 0, inclusive, + to NUM, exclusive. FN is not called if NUM is less than 1. + + This function’s anaphoric counterpart is ‘--dotimes’. + + (let (s) (-dotimes 3 (lambda (n) (push n s))) s) + ⇒ (2 1 0) + (let (s) (-dotimes 0 (lambda (n) (push n s))) s) + ⇒ () + (let (s) (--dotimes 5 (push it s)) s) + ⇒ (4 3 2 1 0) + + +File: dash.info, Node: Destructive operations, Next: Function combinators, Prev: Side effects, Up: Functions + +2.15 Destructive operations +=========================== + +Macros that modify variables holding lists. + + -- Macro: !cons (car cdr) + Destructive: Set CDR to the cons of CAR and CDR. + + (let (l) (!cons 5 l) l) + ⇒ (5) + (let ((l '(3))) (!cons 5 l) l) + ⇒ (5 3) + + -- Macro: !cdr (list) + Destructive: Set LIST to the cdr of LIST. + + (let ((l '(3))) (!cdr l) l) + ⇒ () + (let ((l '(3 5))) (!cdr l) l) + ⇒ (5) + + +File: dash.info, Node: Function combinators, Prev: Destructive operations, Up: Functions + +2.16 Function combinators +========================= + +Functions that manipulate and compose other functions. + + -- Function: -partial (fun &rest args) + Return a function that is a partial application of FUN to ARGS. + ARGS is a list of the first N arguments to pass to FUN. The result + is a new function which does the same as FUN, except that the first + N arguments are fixed at the values with which this function was + called. + + (funcall (-partial #'+ 5)) + ⇒ 5 + (funcall (-partial #'- 5) 3) + ⇒ 2 + (funcall (-partial #'+ 5 2) 3) + ⇒ 10 + + -- Function: -rpartial (fn &rest args) + Return a function that is a partial application of FN to ARGS. + ARGS is a list of the last N arguments to pass to FN. The result + is a new function which does the same as FN, except that the last N + arguments are fixed at the values with which this function was + called. This is like ‘-partial’ (*note -partial::), except the + arguments are fixed starting from the right rather than the left. + + (funcall (-rpartial #'- 5)) + ⇒ -5 + (funcall (-rpartial #'- 5) 8) + ⇒ 3 + (funcall (-rpartial #'- 5 2) 10) + ⇒ 3 + + -- Function: -juxt (&rest fns) + Return a function that is the juxtaposition of FNS. The returned + function takes a variable number of ARGS, applies each of FNS in + turn to ARGS, and returns the list of results. + + (funcall (-juxt) 1 2) + ⇒ () + (funcall (-juxt #'+ #'- #'* #'/) 7 5) + ⇒ (12 2 35 1) + (mapcar (-juxt #'number-to-string #'1+) '(1 2)) + ⇒ (("1" 2) ("2" 3)) + + -- Function: -compose (&rest fns) + Compose FNS into a single composite function. Return a function + that takes a variable number of ARGS, applies the last function in + FNS to ARGS, and returns the result of calling each remaining + function on the result of the previous function, right-to-left. If + no FNS are given, return a variadic ‘identity’ function. + + (funcall (-compose #'- #'1+ #'+) 1 2 3) + ⇒ -7 + (funcall (-compose #'identity #'1+) 3) + ⇒ 4 + (mapcar (-compose #'not #'stringp) '(nil "")) + ⇒ (t nil) + + -- Function: -applify (fn) + Return a function that applies FN to a single list of args. This + changes the arity of FN from taking N distinct arguments to taking + 1 argument which is a list of N arguments. + + (funcall (-applify #'+) nil) + ⇒ 0 + (mapcar (-applify #'+) '((1 1 1) (1 2 3) (5 5 5))) + ⇒ (3 6 15) + (funcall (-applify #'<) '(3 6)) + ⇒ t + + -- Function: -on (op trans) + Return a function that calls TRANS on each arg and OP on the + results. The returned function takes a variable number of + arguments, calls the function TRANS on each one in turn, and then + passes those results as the list of arguments to OP, in the same + order. + + For example, the following pairs of expressions are morally + equivalent: + + (funcall (-on #’+ #’1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3)) (funcall + (-on #’+ #’1+)) = (+) + + (-sort (-on #'< #'length) '((1 2 3) (1) (1 2))) + ⇒ ((1) (1 2) (1 2 3)) + (funcall (-on #'min #'string-to-number) "22" "2" "1" "12") + ⇒ 1 + (-min-by (-on #'> #'length) '((1 2 3) (4) (1 2))) + ⇒ (4) + + -- Function: -flip (fn) + Return a function that calls FN with its arguments reversed. The + returned function takes the same number of arguments as FN. + + For example, the following two expressions are morally equivalent: + + (funcall (-flip #’-) 1 2) = (- 2 1) + + See also: ‘-rotate-args’ (*note -rotate-args::). + + (-sort (-flip #'<) '(4 3 6 1)) + ⇒ (6 4 3 1) + (funcall (-flip #'-) 3 2 1 10) + ⇒ 4 + (funcall (-flip #'1+) 1) + ⇒ 2 + + -- Function: -rotate-args (n fn) + Return a function that calls FN with args rotated N places to the + right. The returned function takes the same number of arguments as + FN, rotates the list of arguments N places to the right (left if N + is negative) just like ‘-rotate’ (*note -rotate::), and applies FN + to the result. + + See also: ‘-flip’ (*note -flip::). + + (funcall (-rotate-args -1 #'list) 1 2 3 4) + ⇒ (2 3 4 1) + (funcall (-rotate-args 1 #'-) 1 10 100) + ⇒ 89 + (funcall (-rotate-args 2 #'list) 3 4 5 1 2) + ⇒ (1 2 3 4 5) + + -- Function: -const (c) + Return a function that returns C ignoring any additional arguments. + + In types: a -> b -> a + + (funcall (-const 2) 1 3 "foo") + ⇒ 2 + (mapcar (-const 1) '("a" "b" "c" "d")) + ⇒ (1 1 1 1) + (-sum (mapcar (-const 1) '("a" "b" "c" "d"))) + ⇒ 4 + + -- Macro: -cut (&rest params) + Take n-ary function and n arguments and specialize some of them. + Arguments denoted by <> will be left unspecialized. + + See SRFI-26 for detailed description. + + (funcall (-cut list 1 <> 3 <> 5) 2 4) + ⇒ (1 2 3 4 5) + (-map (-cut funcall <> 5) `(1+ 1- ,(lambda (x) (/ 1.0 x)))) + ⇒ (6 4 0.2) + (-map (-cut <> 1 2 3) '(list vector string)) + ⇒ ((1 2 3) [1 2 3] "\1\2\3") + + -- Function: -not (pred) + Return a predicate that negates the result of PRED. The returned + predicate passes its arguments to PRED. If PRED returns ‘nil’, the + result is non-‘nil’; otherwise the result is ‘nil’. + + See also: ‘-andfn’ (*note -andfn::) and ‘-orfn’ (*note -orfn::). + + (funcall (-not #'numberp) "5") + ⇒ t + (-sort (-not #'<) '(5 2 1 0 6)) + ⇒ (6 5 2 1 0) + (-filter (-not (-partial #'< 4)) '(1 2 3 4 5 6 7 8)) + ⇒ (1 2 3 4) + + -- Function: -orfn (&rest preds) + Return a predicate that returns the first non-‘nil’ result of + PREDS. The returned predicate takes a variable number of + arguments, passes them to each predicate in PREDS in turn until one + of them returns non-‘nil’, and returns that non-‘nil’ result + without calling the remaining PREDS. If all PREDS return ‘nil’, or + if no PREDS are given, the returned predicate returns ‘nil’. + + See also: ‘-andfn’ (*note -andfn::) and ‘-not’ (*note -not::). + + (-filter (-orfn #'natnump #'booleanp) '(1 nil "a" -4 b c t)) + ⇒ (1 nil t) + (funcall (-orfn #'symbolp (-cut string-match-p "x" <>)) "axe") + ⇒ 1 + (funcall (-orfn #'= #'+) 1 1) + ⇒ t + + -- Function: -andfn (&rest preds) + Return a predicate that returns non-‘nil’ if all PREDS do so. The + returned predicate P takes a variable number of arguments and + passes them to each predicate in PREDS in turn. If any one of + PREDS returns ‘nil’, P also returns ‘nil’ without calling the + remaining PREDS. If all PREDS return non-‘nil’, P returns the last + such value. If no PREDS are given, P always returns non-‘nil’. + + See also: ‘-orfn’ (*note -orfn::) and ‘-not’ (*note -not::). + + (-filter (-andfn #'numberp (-cut < <> 5)) '(a 1 b 6 c 2)) + ⇒ (1 2) + (mapcar (-andfn #'numberp #'1+) '(a 1 b 6)) + ⇒ (nil 2 nil 7) + (funcall (-andfn #'= #'+) 1 1) + ⇒ 2 + + -- Function: -iteratefn (fn n) + Return a function FN composed N times with itself. + + FN is a unary function. If you need to use a function of higher + arity, use ‘-applify’ (*note -applify::) first to turn it into a + unary function. + + With n = 0, this acts as identity function. + + In types: (a -> a) -> Int -> a -> a. + + This function satisfies the following law: + + (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init + (1+ n))). + + (funcall (-iteratefn (lambda (x) (* x x)) 3) 2) + ⇒ 256 + (funcall (-iteratefn '1+ 3) 1) + ⇒ 4 + (funcall (-iteratefn 'cdr 3) '(1 2 3 4 5)) + ⇒ (4 5) + + -- Function: -fixfn (fn &optional equal-test halt-test) + Return a function that computes the (least) fixpoint of FN. + + FN must be a unary function. The returned lambda takes a single + argument, X, the initial value for the fixpoint iteration. The + iteration halts when either of the following conditions is + satisfied: + + 1. Iteration converges to the fixpoint, with equality being tested + using EQUAL-TEST. If EQUAL-TEST is not specified, ‘equal’ is used. + For functions over the floating point numbers, it may be necessary + to provide an appropriate approximate comparison test. + + 2. HALT-TEST returns a non-‘nil’ value. HALT-TEST defaults to a + simple counter that returns ‘t’ after ‘-fixfn-max-iterations’, to + guard against infinite iteration. Otherwise, HALT-TEST must be a + function that accepts a single argument, the current value of X, + and returns non-‘nil’ as long as iteration should continue. In + this way, a more sophisticated convergence test may be supplied by + the caller. + + The return value of the lambda is either the fixpoint or, if + iteration halted before converging, a cons with car ‘halted’ and + cdr the final output from HALT-TEST. + + In types: (a -> a) -> a -> a. + + (funcall (-fixfn #'cos #'approx=) 0.7) + ⇒ 0.7390851332151607 + (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) + ⇒ 1.8555845286409378 + (funcall (-fixfn #'sin #'approx=) 0.1) + ⇒ (halted . t) + + -- Function: -prodfn (&rest fns) + Return a function that applies each of FNS to each of a list of + arguments. + + Takes a list of N functions and returns a function that takes a + list of length N, applying Ith function to Ith element of the input + list. Returns a list of length N. + + In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + + This function satisfies the following laws: + + (-compose (-prodfn f g ...) (-prodfn f’ g’ ...)) = (-prodfn + (-compose f f’) (-compose g g’) ...) + + (-prodfn f g ...) = (-juxt (-compose f (-partial #’nth 0)) + (-compose g (-partial #’nth 1)) ...) + + (-compose (-prodfn f g ...) (-juxt f’ g’ ...)) = (-juxt (-compose f + f’) (-compose g g’) ...) + + (-compose (-partial #’nth n) (-prod f1 f2 ...)) = (-compose fn + (-partial #’nth n)) + + (funcall (-prodfn #'1+ #'1- #'number-to-string) '(1 2 3)) + ⇒ (2 1 "3") + (-map (-prodfn #'1- #'1+) '((1 2) (3 4) (5 6))) + ⇒ ((0 3) (2 5) (4 7)) + (apply #'+ (funcall (-prodfn #'length #'string-to-number) '((t) "5"))) + ⇒ 6 + + +File: dash.info, Node: Development, Next: FDL, Prev: Functions, Up: Top + +3 Development +************* + +The Dash repository is hosted on GitHub at +. + +* Menu: + +* Contribute:: How to contribute. +* Contributors:: List of contributors. + + +File: dash.info, Node: Contribute, Next: Contributors, Up: Development + +3.1 Contribute +============== + +Yes, please do. Pure functions in the list manipulation realm only, +please. There’s a suite of examples/tests in ‘dev/examples.el’, so +remember to add tests for your additions, or they may get broken later. + + Run the tests with ‘make check’. Regenerate the docs with ‘make +docs’. Contributors are encouraged to install these commands as a Git +pre-commit hook, so that the tests are always running and the docs are +always in sync: + + $ cp dev/pre-commit.sh .git/hooks/pre-commit + + Oh, and don’t edit ‘README.md’ or ‘dash.texi’ directly, as they are +auto-generated. Instead, change their respective templates +‘readme-template.md’ or ‘dash-template.texi’. + + To ensure that Dash can be distributed with GNU ELPA or Emacs, we +require that all contributors assign copyright to the Free Software +Foundation. For more on this, *note (emacs)Copyright Assignment::. + + +File: dash.info, Node: Contributors, Prev: Contribute, Up: Development + +3.2 Contributors +================ + + • Matus Goljer (https://github.com/Fuco1) contributed lots of + features and functions. + • Takafumi Arakaki (https://github.com/tkf) contributed ‘-group-by’. + • tali713 (https://github.com/tali713) is the author of ‘-applify’. + • Víctor M. Valenzuela (https://github.com/vemv) contributed + ‘-repeat’. + • Nic Ferrier (https://github.com/nicferrier) contributed ‘-cons*’. + • Wilfred Hughes (https://github.com/Wilfred) contributed ‘-slice’, + ‘-first-item’, and ‘-last-item’. + • Emanuel Evans (https://github.com/shosti) contributed ‘-if-let’, + ‘-when-let’, and ‘-insert-at’. + • Johan Andersson (https://github.com/rejeep) contributed ‘-sum’, + ‘-product’, and ‘-same-items?’. + • Christina Whyte (https://github.com/kurisuwhyte) contributed + ‘-compose’. + • Steve Lamb (https://github.com/steventlamb) contributed ‘-cycle’, + ‘-pad’, ‘-annotate’, ‘-zip-fill’, and a variadic version of ‘-zip’. + • Fredrik Bergroth (https://github.com/fbergroth) made the ‘-if-let’ + family use ‘-let’ destructuring and improved the script for + generating documentation. + • Mark Oteiza (https://github.com/holomorph) contributed ‘-iota’ and + the script to create an Info manual. + • Vasilij Schneidermann (https://github.com/wasamasa) contributed + ‘-some’. + • William West (https://github.com/occidens) made ‘-fixfn’ more + robust at handling floats. + • Cam Saul (https://github.com/camsaul) contributed ‘-some->’, + ‘-some->>’, and ‘-some-->’. + • Basil L. Contovounesios (https://github.com/basil-conto) + contributed ‘-common-prefix’, ‘-common-suffix’, and various other + improvements. + • Paul Pogonyshev (https://github.com/doublep) contributed ‘-each-r’ + and ‘-each-r-while’. + + Thanks! + + New contributors are very welcome. *Note Contribute::. + + +File: dash.info, Node: FDL, Next: GPL, Prev: Development, Up: Top + +Appendix A GNU Free Documentation License +***************************************** + + Version 1.3, 3 November 2008 + + Copyright © 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. + + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document “free” in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of “copyleft”, which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. We + recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it can + be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + “Document”, below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as “you”. You accept + the license if you copy, modify or distribute the work in a way + requiring permission under copyright law. + + A “Modified Version” of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A “Secondary Section” is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document’s overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The “Invariant Sections” are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in the + notice that says that the Document is released under this License. + If a section does not fit the above definition of Secondary then it + is not allowed to be designated as Invariant. The Document may + contain zero Invariant Sections. If the Document does not identify + any Invariant Sections then there are none. + + The “Cover Texts” are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A “Transparent” copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images composed + of pixels) generic paint programs or (for drawings) some widely + available drawing editor, and that is suitable for input to text + formatters or for automatic translation to a variety of formats + suitable for input to text formatters. A copy made in an otherwise + Transparent file format whose markup, or absence of markup, has + been arranged to thwart or discourage subsequent modification by + readers is not Transparent. An image format is not Transparent if + used for any substantial amount of text. A copy that is not + “Transparent” is called “Opaque”. + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and standard-conforming + simple HTML, PostScript or PDF designed for human modification. + Examples of transparent image formats include PNG, XCF and JPG. + Opaque formats include proprietary formats that can be read and + edited only by proprietary word processors, SGML or XML for which + the DTD and/or processing tools are not generally available, and + the machine-generated HTML, PostScript or PDF produced by some word + processors for output purposes only. + + The “Title Page” means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, “Title + Page” means the text near the most prominent appearance of the + work’s title, preceding the beginning of the body of the text. + + The “publisher” means any person or entity that distributes copies + of the Document to the public. + + A section “Entitled XYZ” means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + “Acknowledgements”, “Dedications”, “Endorsements”, or “History”.) + To “Preserve the Title” of such a section when you modify the + Document means that it remains a section “Entitled XYZ” according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow the + conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document’s license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the title + equally prominent and visible. You may add other material on the + covers in addition. Copying with changes limited to the covers, as + long as they preserve the title of the Document and satisfy these + conditions, can be treated as verbatim copying in other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a machine-readable + Transparent copy along with each Opaque copy, or state in or with + each Opaque copy a computer-network location from which the general + network-using public has access to download using public-standard + network protocols a complete Transparent copy of the Document, free + of added material. If you use the latter option, you must take + reasonably prudent steps, when you begin distribution of Opaque + copies in quantity, to ensure that this Transparent copy will + remain thus accessible at the stated location until at least one + year after the last time you distribute an Opaque copy (directly or + through your agents or retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of copies, + to give them a chance to provide you with an updated version of the + Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with the + Modified Version filling the role of the Document, thus licensing + distribution and modification of the Modified Version to whoever + possesses a copy of it. In addition, you must do these things in + the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of previous + versions (which should, if there were any, be listed in the + History section of the Document). You may use the same title + as a previous version if the original publisher of that + version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document’s + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled “History”, Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on the + Title Page. If there is no section Entitled “History” in the + Document, create one stating the title, year, authors, and + publisher of the Document as given on its Title Page, then add + an item describing the Modified Version as stated in the + previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in the + “History” section. You may omit a network location for a work + that was published at least four years before the Document + itself, or if the original publisher of the version it refers + to gives permission. + + K. For any section Entitled “Acknowledgements” or “Dedications”, + Preserve the Title of the section, and preserve in the section + all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, unaltered + in their text and in their titles. Section numbers or the + equivalent are not considered part of the section titles. + + M. Delete any section Entitled “Endorsements”. Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + “Endorsements” or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option designate + some or all of these sections as invariant. To do this, add their + titles to the list of Invariant Sections in the Modified Version’s + license notice. These titles must be distinct from any other + section titles. + + You may add a section Entitled “Endorsements”, provided it contains + nothing but endorsements of your Modified Version by various + parties—for example, statements of peer review or that the text has + been approved by an organization as the authoritative definition of + a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end of + the list of Cover Texts in the Modified Version. Only one passage + of Front-Cover Text and one of Back-Cover Text may be added by (or + through arrangements made by) any one entity. If the Document + already includes a cover text for the same cover, previously added + by you or by arrangement made by the same entity you are acting on + behalf of, you may not add another; but you may replace the old + one, on explicit permission from the previous publisher that added + the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination all + of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + “History” in the various original documents, forming one section + Entitled “History”; likewise combine any sections Entitled + “Acknowledgements”, and any sections Entitled “Dedications”. You + must delete all sections Entitled “Endorsements.” + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the documents + in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow this + License in all other respects regarding verbatim copying of that + document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of a + storage or distribution medium, is called an “aggregate” if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation’s users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document’s Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled “Acknowledgements”, + “Dedications”, or “History”, the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided under this License. Any attempt + otherwise to copy, modify, sublicense, or distribute it is void, + and will automatically terminate your rights under this License. + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, receipt of a copy of some or all of the + same material does not give you any rights to use it. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + . + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License “or any later version” applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If the + Document does not specify a version number of this License, you may + choose any version ever published (not as a draft) by the Free + Software Foundation. If the Document specifies that a proxy can + decide which future versions of this License can be used, that + proxy’s public statement of acceptance of a version permanently + authorizes you to choose that version for the Document. + + 11. RELICENSING + + “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any + World Wide Web server that publishes copyrightable works and also + provides prominent facilities for anybody to edit those works. A + public wiki that anybody can edit is an example of such a server. + A “Massive Multiauthor Collaboration” (or “MMC”) contained in the + site means any set of copyrightable works thus published on the MMC + site. + + “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0 + license published by Creative Commons Corporation, a not-for-profit + corporation with a principal place of business in San Francisco, + California, as well as future copyleft versions of that license + published by that same organization. + + “Incorporate” means to publish or republish a Document, in whole or + in part, as part of another Document. + + An MMC is “eligible for relicensing” if it is licensed under this + License, and if all works that were first published under this + License somewhere other than this MMC, and subsequently + incorporated in whole or in part into the MMC, (1) had no cover + texts or invariant sections, and (2) were thus incorporated prior + to November 1, 2008. + + The operator of an MMC Site may republish an MMC contained in the + site under CC-BY-SA on the same site at any time before August 1, + 2009, provided the MMC is eligible for relicensing. + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + + If you have Invariant Sections, Front-Cover Texts and Back-Cover +Texts, replace the “with...Texts.” line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + + If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + + If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of free +software license, such as the GNU General Public License, to permit +their use in free software. + + +File: dash.info, Node: GPL, Next: Index, Prev: FDL, Up: Top + +Appendix B GNU General Public License +************************************* + + Version 3, 29 June 2007 + + Copyright © 2007 Free Software Foundation, Inc. + + Everyone is permitted to copy and distribute verbatim copies of this + license document, but changing it is not allowed. + +Preamble +======== + +The GNU General Public License is a free, copyleft license for software +and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program—to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers’ and authors’ protection, the GPL clearly explains +that there is no warranty for this free software. For both users’ and +authors’ sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users’ freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + +TERMS AND CONDITIONS +==================== + + 0. Definitions. + + “This License” refers to version 3 of the GNU General Public + License. + + “Copyright” also means copyright-like laws that apply to other + kinds of works, such as semiconductor masks. + + “The Program” refers to any copyrightable work licensed under this + License. Each licensee is addressed as “you”. “Licensees” and + “recipients” may be individuals or organizations. + + To “modify” a work means to copy from or adapt all or part of the + work in a fashion requiring copyright permission, other than the + making of an exact copy. The resulting work is called a “modified + version” of the earlier work or a work “based on” the earlier work. + + A “covered work” means either the unmodified Program or a work + based on the Program. + + To “propagate” a work means to do anything with it that, without + permission, would make you directly or secondarily liable for + infringement under applicable copyright law, except executing it on + a computer or modifying a private copy. Propagation includes + copying, distribution (with or without modification), making + available to the public, and in some countries other activities as + well. + + To “convey” a work means any kind of propagation that enables other + parties to make or receive copies. Mere interaction with a user + through a computer network, with no transfer of a copy, is not + conveying. + + An interactive user interface displays “Appropriate Legal Notices” + to the extent that it includes a convenient and prominently visible + feature that (1) displays an appropriate copyright notice, and (2) + tells the user that there is no warranty for the work (except to + the extent that warranties are provided), that licensees may convey + the work under this License, and how to view a copy of this + License. If the interface presents a list of user commands or + options, such as a menu, a prominent item in the list meets this + criterion. + + 1. Source Code. + + The “source code” for a work means the preferred form of the work + for making modifications to it. “Object code” means any non-source + form of a work. + + A “Standard Interface” means an interface that either is an + official standard defined by a recognized standards body, or, in + the case of interfaces specified for a particular programming + language, one that is widely used among developers working in that + language. + + The “System Libraries” of an executable work include anything, + other than the work as a whole, that (a) is included in the normal + form of packaging a Major Component, but which is not part of that + Major Component, and (b) serves only to enable use of the work with + that Major Component, or to implement a Standard Interface for + which an implementation is available to the public in source code + form. A “Major Component”, in this context, means a major + essential component (kernel, window system, and so on) of the + specific operating system (if any) on which the executable work + runs, or a compiler used to produce the work, or an object code + interpreter used to run it. + + The “Corresponding Source” for a work in object code form means all + the source code needed to generate, install, and (for an executable + work) run the object code and to modify the work, including scripts + to control those activities. However, it does not include the + work’s System Libraries, or general-purpose tools or generally + available free programs which are used unmodified in performing + those activities but which are not part of the work. For example, + Corresponding Source includes interface definition files associated + with source files for the work, and the source code for shared + libraries and dynamically linked subprograms that the work is + specifically designed to require, such as by intimate data + communication or control flow between those subprograms and other + parts of the work. + + The Corresponding Source need not include anything that users can + regenerate automatically from other parts of the Corresponding + Source. + + The Corresponding Source for a work in source code form is that + same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of + copyright on the Program, and are irrevocable provided the stated + conditions are met. This License explicitly affirms your unlimited + permission to run the unmodified Program. The output from running + a covered work is covered by this License only if the output, given + its content, constitutes a covered work. This License acknowledges + your rights of fair use or other equivalent, as provided by + copyright law. + + You may make, run and propagate covered works that you do not + convey, without conditions so long as your license otherwise + remains in force. You may convey covered works to others for the + sole purpose of having them make modifications exclusively for you, + or provide you with facilities for running those works, provided + that you comply with the terms of this License in conveying all + material for which you do not control copyright. Those thus making + or running the covered works for you must do so exclusively on your + behalf, under your direction and control, on terms that prohibit + them from making any copies of your copyrighted material outside + their relationship with you. + + Conveying under any other circumstances is permitted solely under + the conditions stated below. Sublicensing is not allowed; section + 10 makes it unnecessary. + + 3. Protecting Users’ Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological + measure under any applicable law fulfilling obligations under + article 11 of the WIPO copyright treaty adopted on 20 December + 1996, or similar laws prohibiting or restricting circumvention of + such measures. + + When you convey a covered work, you waive any legal power to forbid + circumvention of technological measures to the extent such + circumvention is effected by exercising rights under this License + with respect to the covered work, and you disclaim any intention to + limit operation or modification of the work as a means of + enforcing, against the work’s users, your or third parties’ legal + rights to forbid circumvention of technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program’s source code as you + receive it, in any medium, provided that you conspicuously and + appropriately publish on each copy an appropriate copyright notice; + keep intact all notices stating that this License and any + non-permissive terms added in accord with section 7 apply to the + code; keep intact all notices of the absence of any warranty; and + give all recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, + and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to + produce it from the Program, in the form of source code under the + terms of section 4, provided that you also meet all of these + conditions: + + a. The work must carry prominent notices stating that you + modified it, and giving a relevant date. + + b. The work must carry prominent notices stating that it is + released under this License and any conditions added under + section 7. This requirement modifies the requirement in + section 4 to “keep intact all notices”. + + c. You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable + section 7 additional terms, to the whole of the work, and all + its parts, regardless of how they are packaged. This License + gives no permission to license the work in any other way, but + it does not invalidate such permission if you have separately + received it. + + d. If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has + interactive interfaces that do not display Appropriate Legal + Notices, your work need not make them do so. + + A compilation of a covered work with other separate and independent + works, which are not by their nature extensions of the covered + work, and which are not combined with it such as to form a larger + program, in or on a volume of a storage or distribution medium, is + called an “aggregate” if the compilation and its resulting + copyright are not used to limit the access or legal rights of the + compilation’s users beyond what the individual works permit. + Inclusion of a covered work in an aggregate does not cause this + License to apply to the other parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms + of sections 4 and 5, provided that you also convey the + machine-readable Corresponding Source under the terms of this + License, in one of these ways: + + a. Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b. Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that + product model, to give anyone who possesses the object code + either (1) a copy of the Corresponding Source for all the + software in the product that is covered by this License, on a + durable physical medium customarily used for software + interchange, for a price no more than your reasonable cost of + physically performing this conveying of source, or (2) access + to copy the Corresponding Source from a network server at no + charge. + + c. Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, + and only if you received the object code with such an offer, + in accord with subsection 6b. + + d. Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to + the Corresponding Source in the same way through the same + place at no further charge. You need not require recipients + to copy the Corresponding Source along with the object code. + If the place to copy the object code is a network server, the + Corresponding Source may be on a different server (operated by + you or a third party) that supports equivalent copying + facilities, provided you maintain clear directions next to the + object code saying where to find the Corresponding Source. + Regardless of what server hosts the Corresponding Source, you + remain obligated to ensure that it is available for as long as + needed to satisfy these requirements. + + e. Convey the object code using peer-to-peer transmission, + provided you inform other peers where the object code and + Corresponding Source of the work are being offered to the + general public at no charge under subsection 6d. + + A separable portion of the object code, whose source code is + excluded from the Corresponding Source as a System Library, need + not be included in conveying the object code work. + + A “User Product” is either (1) a “consumer product”, which means + any tangible personal property which is normally used for personal, + family, or household purposes, or (2) anything designed or sold for + incorporation into a dwelling. In determining whether a product is + a consumer product, doubtful cases shall be resolved in favor of + coverage. For a particular product received by a particular user, + “normally used” refers to a typical or common use of that class of + product, regardless of the status of the particular user or of the + way in which the particular user actually uses, or expects or is + expected to use, the product. A product is a consumer product + regardless of whether the product has substantial commercial, + industrial or non-consumer uses, unless such uses represent the + only significant mode of use of the product. + + “Installation Information” for a User Product means any methods, + procedures, authorization keys, or other information required to + install and execute modified versions of a covered work in that + User Product from a modified version of its Corresponding Source. + The information must suffice to ensure that the continued + functioning of the modified object code is in no case prevented or + interfered with solely because modification has been made. + + If you convey an object code work under this section in, or with, + or specifically for use in, a User Product, and the conveying + occurs as part of a transaction in which the right of possession + and use of the User Product is transferred to the recipient in + perpetuity or for a fixed term (regardless of how the transaction + is characterized), the Corresponding Source conveyed under this + section must be accompanied by the Installation Information. But + this requirement does not apply if neither you nor any third party + retains the ability to install modified object code on the User + Product (for example, the work has been installed in ROM). + + The requirement to provide Installation Information does not + include a requirement to continue to provide support service, + warranty, or updates for a work that has been modified or installed + by the recipient, or for the User Product in which it has been + modified or installed. Access to a network may be denied when the + modification itself materially and adversely affects the operation + of the network or violates the rules and protocols for + communication across the network. + + Corresponding Source conveyed, and Installation Information + provided, in accord with this section must be in a format that is + publicly documented (and with an implementation available to the + public in source code form), and must require no special password + or key for unpacking, reading or copying. + + 7. Additional Terms. + + “Additional permissions” are terms that supplement the terms of + this License by making exceptions from one or more of its + conditions. Additional permissions that are applicable to the + entire Program shall be treated as though they were included in + this License, to the extent that they are valid under applicable + law. If additional permissions apply only to part of the Program, + that part may be used separately under those permissions, but the + entire Program remains governed by this License without regard to + the additional permissions. + + When you convey a copy of a covered work, you may at your option + remove any additional permissions from that copy, or from any part + of it. (Additional permissions may be written to require their own + removal in certain cases when you modify the work.) You may place + additional permissions on material, added by you to a covered work, + for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material + you add to a covered work, you may (if authorized by the copyright + holders of that material) supplement the terms of this License with + terms: + + a. Disclaiming warranty or limiting liability differently from + the terms of sections 15 and 16 of this License; or + + b. Requiring preservation of specified reasonable legal notices + or author attributions in that material or in the Appropriate + Legal Notices displayed by works containing it; or + + c. Prohibiting misrepresentation of the origin of that material, + or requiring that modified versions of such material be marked + in reasonable ways as different from the original version; or + + d. Limiting the use for publicity purposes of names of licensors + or authors of the material; or + + e. Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f. Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified + versions of it) with contractual assumptions of liability to + the recipient, for any liability that these contractual + assumptions directly impose on those licensors and authors. + + All other non-permissive additional terms are considered “further + restrictions” within the meaning of section 10. If the Program as + you received it, or any part of it, contains a notice stating that + it is governed by this License along with a term that is a further + restriction, you may remove that term. If a license document + contains a further restriction but permits relicensing or conveying + under this License, you may add to a covered work material governed + by the terms of that license document, provided that the further + restriction does not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you + must place, in the relevant source files, a statement of the + additional terms that apply to those files, or a notice indicating + where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in + the form of a separately written license, or stated as exceptions; + the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly + provided under this License. Any attempt otherwise to propagate or + modify it is void, and will automatically terminate your rights + under this License (including any patent licenses granted under the + third paragraph of section 11). + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, you do not qualify to receive new licenses + for the same material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or + run a copy of the Program. Ancillary propagation of a covered work + occurring solely as a consequence of using peer-to-peer + transmission to receive a copy likewise does not require + acceptance. However, nothing other than this License grants you + permission to propagate or modify any covered work. These actions + infringe copyright if you do not accept this License. Therefore, + by modifying or propagating a covered work, you indicate your + acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically + receives a license from the original licensors, to run, modify and + propagate that work, subject to this License. You are not + responsible for enforcing compliance by third parties with this + License. + + An “entity transaction” is a transaction transferring control of an + organization, or substantially all assets of one, or subdividing an + organization, or merging organizations. If propagation of a + covered work results from an entity transaction, each party to that + transaction who receives a copy of the work also receives whatever + licenses to the work the party’s predecessor in interest had or + could give under the previous paragraph, plus a right to possession + of the Corresponding Source of the work from the predecessor in + interest, if the predecessor has it or can get it with reasonable + efforts. + + You may not impose any further restrictions on the exercise of the + rights granted or affirmed under this License. For example, you + may not impose a license fee, royalty, or other charge for exercise + of rights granted under this License, and you may not initiate + litigation (including a cross-claim or counterclaim in a lawsuit) + alleging that any patent claim is infringed by making, using, + selling, offering for sale, or importing the Program or any portion + of it. + + 11. Patents. + + A “contributor” is a copyright holder who authorizes use under this + License of the Program or a work on which the Program is based. + The work thus licensed is called the contributor’s “contributor + version”. + + A contributor’s “essential patent claims” are all patent claims + owned or controlled by the contributor, whether already acquired or + hereafter acquired, that would be infringed by some manner, + permitted by this License, of making, using, or selling its + contributor version, but do not include claims that would be + infringed only as a consequence of further modification of the + contributor version. For purposes of this definition, “control” + includes the right to grant patent sublicenses in a manner + consistent with the requirements of this License. + + Each contributor grants you a non-exclusive, worldwide, + royalty-free patent license under the contributor’s essential + patent claims, to make, use, sell, offer for sale, import and + otherwise run, modify and propagate the contents of its contributor + version. + + In the following three paragraphs, a “patent license” is any + express agreement or commitment, however denominated, not to + enforce a patent (such as an express permission to practice a + patent or covenant not to sue for patent infringement). To “grant” + such a patent license to a party means to make such an agreement or + commitment not to enforce a patent against the party. + + If you convey a covered work, knowingly relying on a patent + license, and the Corresponding Source of the work is not available + for anyone to copy, free of charge and under the terms of this + License, through a publicly available network server or other + readily accessible means, then you must either (1) cause the + Corresponding Source to be so available, or (2) arrange to deprive + yourself of the benefit of the patent license for this particular + work, or (3) arrange, in a manner consistent with the requirements + of this License, to extend the patent license to downstream + recipients. “Knowingly relying” means you have actual knowledge + that, but for the patent license, your conveying the covered work + in a country, or your recipient’s use of the covered work in a + country, would infringe one or more identifiable patents in that + country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or + arrangement, you convey, or propagate by procuring conveyance of, a + covered work, and grant a patent license to some of the parties + receiving the covered work authorizing them to use, propagate, + modify or convey a specific copy of the covered work, then the + patent license you grant is automatically extended to all + recipients of the covered work and works based on it. + + A patent license is “discriminatory” if it does not include within + the scope of its coverage, prohibits the exercise of, or is + conditioned on the non-exercise of one or more of the rights that + are specifically granted under this License. You may not convey a + covered work if you are a party to an arrangement with a third + party that is in the business of distributing software, under which + you make payment to the third party based on the extent of your + activity of conveying the work, and under which the third party + grants, to any of the parties who would receive the covered work + from you, a discriminatory patent license (a) in connection with + copies of the covered work conveyed by you (or copies made from + those copies), or (b) primarily for and in connection with specific + products or compilations that contain the covered work, unless you + entered into that arrangement, or that patent license was granted, + prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting + any implied license or other defenses to infringement that may + otherwise be available to you under applicable patent law. + + 12. No Surrender of Others’ Freedom. + + If conditions are imposed on you (whether by court order, agreement + or otherwise) that contradict the conditions of this License, they + do not excuse you from the conditions of this License. If you + cannot convey a covered work so as to satisfy simultaneously your + obligations under this License and any other pertinent obligations, + then as a consequence you may not convey it at all. For example, + if you agree to terms that obligate you to collect a royalty for + further conveying from those to whom you convey the Program, the + only way you could satisfy both those terms and this License would + be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have + permission to link or combine any covered work with a work licensed + under version 3 of the GNU Affero General Public License into a + single combined work, and to convey the resulting work. The terms + of this License will continue to apply to the part which is the + covered work, but the special requirements of the GNU Affero + General Public License, section 13, concerning interaction through + a network will apply to the combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new + versions of the GNU General Public License from time to time. Such + new versions will be similar in spirit to the present version, but + may differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the + Program specifies that a certain numbered version of the GNU + General Public License “or any later version” applies to it, you + have the option of following the terms and conditions either of + that numbered version or of any later version published by the Free + Software Foundation. If the Program does not specify a version + number of the GNU General Public License, you may choose any + version ever published by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future + versions of the GNU General Public License can be used, that + proxy’s public statement of acceptance of a version permanently + authorizes you to choose that version for the Program. + + Later license versions may give you additional or different + permissions. However, no additional obligations are imposed on any + author or copyright holder as a result of your choosing to follow a + later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY + APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE + COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” + WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE + RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. + SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL + NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN + WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES + AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR + DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR + CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE + THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA + BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD + PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER + PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF + THE POSSIBILITY OF SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided + above cannot be given local legal effect according to their terms, + reviewing courts shall apply local law that most closely + approximates an absolute waiver of all civil liability in + connection with the Program, unless a warranty or assumption of + liability accompanies a copy of the Program in return for a fee. + +END OF TERMS AND CONDITIONS +=========================== + +How to Apply These Terms to Your New Programs +============================================= + +If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least the +“copyright” line and a pointer to where the full notice is found. + + ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. + Copyright (C) YEAR NAME OF AUTHOR + + This program 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. + + This program 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 this program. If not, see . + + Also add information on how to contact you by electronic and paper +mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + PROGRAM Copyright (C) YEAR NAME OF AUTHOR + This program comes with ABSOLUTELY NO WARRANTY; for details type ‘show w’. + This is free software, and you are welcome to redistribute it + under certain conditions; type ‘show c’ for details. + + The hypothetical commands ‘show w’ and ‘show c’ should show the +appropriate parts of the General Public License. Of course, your +program’s commands might be different; for a GUI interface, you would +use an “about box”. + + You should also get your employer (if you work as a programmer) or +school, if any, to sign a “copyright disclaimer” for the program, if +necessary. For more information on this, and how to apply and follow +the GNU GPL, see . + + The GNU General Public License does not permit incorporating your +program into proprietary programs. If your program is a subroutine +library, you may consider it more useful to permit linking proprietary +applications with the library. If this is what you want to do, use the +GNU Lesser General Public License instead of this License. But first, +please read . + + +File: dash.info, Node: Index, Prev: GPL, Up: Top + +Index +***** + +[index] +* Menu: + +* !cdr: Destructive operations. + (line 16) +* !cons: Destructive operations. + (line 8) +* -->: Threading macros. (line 35) +* ->: Threading macros. (line 9) +* ->>: Threading macros. (line 22) +* -all?: Predicates. (line 53) +* -andfn: Function combinators. + (line 184) +* -annotate: Maps. (line 86) +* -any?: Predicates. (line 41) +* -applify: Function combinators. + (line 63) +* -as->: Threading macros. (line 49) +* -butlast: Other list operations. + (line 405) +* -clone: Tree operations. (line 123) +* -common-prefix: Reductions. (line 242) +* -common-suffix: Reductions. (line 252) +* -compose: Function combinators. + (line 49) +* -concat: List to list. (line 23) +* -cons*: Other list operations. + (line 19) +* -cons-pair?: Predicates. (line 154) +* -const: Function combinators. + (line 128) +* -contains?: Predicates. (line 100) +* -copy: Maps. (line 151) +* -count: Reductions. (line 172) +* -cut: Function combinators. + (line 140) +* -cycle: Unfolding. (line 55) +* -difference: Set operations. (line 22) +* -distinct: Set operations. (line 73) +* -dotimes: Side effects. (line 80) +* -doto: Threading macros. (line 99) +* -drop: Sublist selection. (line 149) +* -drop-last: Sublist selection. (line 163) +* -drop-while: Sublist selection. (line 194) +* -each: Side effects. (line 8) +* -each-indexed: Side effects. (line 38) +* -each-r: Side effects. (line 52) +* -each-r-while: Side effects. (line 65) +* -each-while: Side effects. (line 24) +* -elem-index: Indexing. (line 9) +* -elem-indices: Indexing. (line 23) +* -every: Predicates. (line 23) +* -fifth-item: Other list operations. + (line 380) +* -filter: Sublist selection. (line 8) +* -find-index: Indexing. (line 35) +* -find-indices: Indexing. (line 73) +* -find-last-index: Indexing. (line 54) +* -first: Other list operations. + (line 300) +* -first-item: Other list operations. + (line 328) +* -fix: Other list operations. + (line 445) +* -fixfn: Function combinators. + (line 224) +* -flatten: List to list. (line 38) +* -flatten-n: List to list. (line 60) +* -flip: Function combinators. + (line 95) +* -fourth-item: Other list operations. + (line 367) +* -frequencies: Reductions. (line 310) +* -grade-down: Indexing. (line 103) +* -grade-up: Indexing. (line 93) +* -group-by: Partitioning. (line 205) +* -if-let: Binding. (line 34) +* -if-let*: Binding. (line 45) +* -inits: Reductions. (line 222) +* -insert-at: List to list. (line 114) +* -interleave: Other list operations. + (line 56) +* -interpose: Other list operations. + (line 46) +* -intersection: Set operations. (line 36) +* -iota: Other list operations. + (line 67) +* -is-infix?: Predicates. (line 140) +* -is-prefix?: Predicates. (line 116) +* -is-suffix?: Predicates. (line 128) +* -iterate: Unfolding. (line 9) +* -iteratefn: Function combinators. + (line 201) +* -juxt: Function combinators. + (line 37) +* -keep: List to list. (line 8) +* -lambda: Binding. (line 247) +* -last: Other list operations. + (line 318) +* -last-item: Other list operations. + (line 393) +* -let: Binding. (line 61) +* -let*: Binding. (line 227) +* -list: Other list operations. + (line 428) +* -map: Maps. (line 10) +* -map-first: Maps. (line 38) +* -map-indexed: Maps. (line 68) +* -map-last: Maps. (line 53) +* -map-when: Maps. (line 22) +* -mapcat: Maps. (line 140) +* -max: Reductions. (line 286) +* -max-by: Reductions. (line 296) +* -min: Reductions. (line 262) +* -min-by: Reductions. (line 272) +* -non-nil: Sublist selection. (line 95) +* -none?: Predicates. (line 73) +* -not: Function combinators. + (line 153) +* -on: Function combinators. + (line 75) +* -only-some?: Predicates. (line 85) +* -orfn: Function combinators. + (line 167) +* -pad: Other list operations. + (line 241) +* -partial: Function combinators. + (line 8) +* -partition: Partitioning. (line 90) +* -partition-after-item: Partitioning. (line 195) +* -partition-after-pred: Partitioning. (line 162) +* -partition-all: Partitioning. (line 102) +* -partition-all-in-steps: Partitioning. (line 126) +* -partition-before-item: Partitioning. (line 185) +* -partition-before-pred: Partitioning. (line 174) +* -partition-by: Partitioning. (line 138) +* -partition-by-header: Partitioning. (line 149) +* -partition-in-steps: Partitioning. (line 113) +* -permutations: Set operations. (line 60) +* -powerset: Set operations. (line 50) +* -prodfn: Function combinators. + (line 258) +* -product: Reductions. (line 201) +* -reduce: Reductions. (line 53) +* -reduce-from: Reductions. (line 8) +* -reduce-r: Reductions. (line 72) +* -reduce-r-from: Reductions. (line 26) +* -reductions: Reductions. (line 136) +* -reductions-from: Reductions. (line 100) +* -reductions-r: Reductions. (line 154) +* -reductions-r-from: Reductions. (line 118) +* -remove: Sublist selection. (line 26) +* -remove-at: List to list. (line 151) +* -remove-at-indices: List to list. (line 170) +* -remove-first: Sublist selection. (line 44) +* -remove-item: Sublist selection. (line 84) +* -remove-last: Sublist selection. (line 65) +* -repeat: Unfolding. (line 44) +* -replace: List to list. (line 72) +* -replace-at: List to list. (line 125) +* -replace-first: List to list. (line 86) +* -replace-last: List to list. (line 100) +* -rotate: Other list operations. + (line 8) +* -rotate-args: Function combinators. + (line 112) +* -rpartial: Function combinators. + (line 22) +* -running-product: Reductions. (line 211) +* -running-sum: Reductions. (line 190) +* -same-items?: Set operations. (line 88) +* -second-item: Other list operations. + (line 341) +* -select-by-indices: Sublist selection. (line 211) +* -select-column: Sublist selection. (line 241) +* -select-columns: Sublist selection. (line 222) +* -separate: Partitioning. (line 75) +* -setq: Binding. (line 270) +* -slice: Sublist selection. (line 105) +* -snoc: Other list operations. + (line 32) +* -some: Predicates. (line 8) +* -some-->: Threading macros. (line 86) +* -some->: Threading macros. (line 62) +* -some->>: Threading macros. (line 74) +* -sort: Other list operations. + (line 415) +* -splice: Maps. (line 102) +* -splice-list: Maps. (line 127) +* -split-at: Partitioning. (line 8) +* -split-on: Partitioning. (line 40) +* -split-when: Partitioning. (line 58) +* -split-with: Partitioning. (line 23) +* -sum: Reductions. (line 180) +* -table: Other list operations. + (line 256) +* -table-flat: Other list operations. + (line 275) +* -tails: Reductions. (line 232) +* -take: Sublist selection. (line 121) +* -take-last: Sublist selection. (line 135) +* -take-while: Sublist selection. (line 177) +* -third-item: Other list operations. + (line 354) +* -tree-map: Tree operations. (line 28) +* -tree-map-nodes: Tree operations. (line 39) +* -tree-mapreduce: Tree operations. (line 85) +* -tree-mapreduce-from: Tree operations. (line 104) +* -tree-reduce: Tree operations. (line 53) +* -tree-reduce-from: Tree operations. (line 70) +* -tree-seq: Tree operations. (line 8) +* -unfold: Unfolding. (line 25) +* -union: Set operations. (line 8) +* -unzip: Other list operations. + (line 215) +* -unzip-lists: Other list operations. + (line 196) +* -update-at: List to list. (line 137) +* -when-let: Binding. (line 9) +* -when-let*: Binding. (line 21) +* -zip: Other list operations. + (line 150) +* -zip-fill: Other list operations. + (line 176) +* -zip-lists: Other list operations. + (line 114) +* -zip-lists-fill: Other list operations. + (line 135) +* -zip-pair: Other list operations. + (line 98) +* -zip-with: Other list operations. + (line 80) +* dash-fontify-mode: Fontification of special variables. + (line 6) +* dash-register-info-lookup: Info symbol lookup. (line 6) +* global-dash-fontify-mode: Fontification of special variables. + (line 12) + + + +Tag Table: +Node: Top742 +Node: Installation2397 +Node: Using in a package3159 +Node: Fontification of special variables3504 +Node: Info symbol lookup4294 +Node: Functions4877 +Node: Maps6361 +Ref: -map6658 +Ref: -map-when7031 +Ref: -map-first7605 +Ref: -map-last8200 +Ref: -map-indexed8790 +Ref: -annotate9476 +Ref: -splice10080 +Ref: -splice-list11155 +Ref: -mapcat11614 +Ref: -copy11987 +Node: Sublist selection12175 +Ref: -filter12368 +Ref: -remove12921 +Ref: -remove-first13470 +Ref: -remove-last14318 +Ref: -remove-item15048 +Ref: -non-nil15448 +Ref: -slice15730 +Ref: -take16259 +Ref: -take-last16677 +Ref: -drop17114 +Ref: -drop-last17561 +Ref: -take-while17993 +Ref: -drop-while18620 +Ref: -select-by-indices19253 +Ref: -select-columns19764 +Ref: -select-column20467 +Node: List to list20930 +Ref: -keep21122 +Ref: -concat21698 +Ref: -flatten22226 +Ref: -flatten-n22988 +Ref: -replace23372 +Ref: -replace-first23833 +Ref: -replace-last24328 +Ref: -insert-at24816 +Ref: -replace-at25141 +Ref: -update-at25528 +Ref: -remove-at26069 +Ref: -remove-at-indices26696 +Node: Reductions27386 +Ref: -reduce-from27582 +Ref: -reduce-r-from28306 +Ref: -reduce29569 +Ref: -reduce-r30320 +Ref: -reductions-from31598 +Ref: -reductions-r-from32404 +Ref: -reductions33234 +Ref: -reductions-r33945 +Ref: -count34690 +Ref: -sum34920 +Ref: -running-sum35108 +Ref: -product35429 +Ref: -running-product35637 +Ref: -inits35978 +Ref: -tails36223 +Ref: -common-prefix36468 +Ref: -common-suffix36762 +Ref: -min37056 +Ref: -min-by37282 +Ref: -max37803 +Ref: -max-by38028 +Ref: -frequencies38554 +Node: Unfolding39169 +Ref: -iterate39410 +Ref: -unfold39857 +Ref: -repeat40662 +Ref: -cycle40946 +Node: Predicates41343 +Ref: -some41520 +Ref: -every41949 +Ref: -any?42663 +Ref: -all?43012 +Ref: -none?43754 +Ref: -only-some?44074 +Ref: -contains?44619 +Ref: -is-prefix?45125 +Ref: -is-suffix?45457 +Ref: -is-infix?45789 +Ref: -cons-pair?46149 +Node: Partitioning46480 +Ref: -split-at46668 +Ref: -split-with47332 +Ref: -split-on47972 +Ref: -split-when48643 +Ref: -separate49286 +Ref: -partition49820 +Ref: -partition-all50269 +Ref: -partition-in-steps50694 +Ref: -partition-all-in-steps51240 +Ref: -partition-by51754 +Ref: -partition-by-header52132 +Ref: -partition-after-pred52733 +Ref: -partition-before-pred53186 +Ref: -partition-before-item53571 +Ref: -partition-after-item53878 +Ref: -group-by54180 +Node: Indexing54613 +Ref: -elem-index54815 +Ref: -elem-indices55302 +Ref: -find-index55761 +Ref: -find-last-index56430 +Ref: -find-indices57081 +Ref: -grade-up57843 +Ref: -grade-down58250 +Node: Set operations58664 +Ref: -union58847 +Ref: -difference59277 +Ref: -intersection59705 +Ref: -powerset60134 +Ref: -permutations60411 +Ref: -distinct60849 +Ref: -same-items?61243 +Node: Other list operations61852 +Ref: -rotate62077 +Ref: -cons*62430 +Ref: -snoc62852 +Ref: -interpose63264 +Ref: -interleave63558 +Ref: -iota63924 +Ref: -zip-with64407 +Ref: -zip-pair65215 +Ref: -zip-lists65781 +Ref: -zip-lists-fill66579 +Ref: -zip67289 +Ref: -zip-fill68316 +Ref: -unzip-lists69230 +Ref: -unzip69853 +Ref: -pad70846 +Ref: -table71331 +Ref: -table-flat72117 +Ref: -first73122 +Ref: -last73655 +Ref: -first-item74001 +Ref: -second-item74413 +Ref: -third-item74830 +Ref: -fourth-item75205 +Ref: -fifth-item75583 +Ref: -last-item75958 +Ref: -butlast76319 +Ref: -sort76564 +Ref: -list77058 +Ref: -fix77627 +Node: Tree operations78116 +Ref: -tree-seq78312 +Ref: -tree-map79173 +Ref: -tree-map-nodes79613 +Ref: -tree-reduce80477 +Ref: -tree-reduce-from81359 +Ref: -tree-mapreduce81959 +Ref: -tree-mapreduce-from82818 +Ref: -clone84103 +Node: Threading macros84441 +Ref: ->84666 +Ref: ->>85154 +Ref: -->85657 +Ref: -as->86213 +Ref: -some->86667 +Ref: -some->>87052 +Ref: -some-->87499 +Ref: -doto88066 +Node: Binding88619 +Ref: -when-let88826 +Ref: -when-let*89287 +Ref: -if-let89816 +Ref: -if-let*90182 +Ref: -let90805 +Ref: -let*96895 +Ref: -lambda97832 +Ref: -setq98638 +Node: Side effects99439 +Ref: -each99633 +Ref: -each-while100160 +Ref: -each-indexed100780 +Ref: -each-r101372 +Ref: -each-r-while101814 +Ref: -dotimes102458 +Node: Destructive operations103011 +Ref: !cons103229 +Ref: !cdr103433 +Node: Function combinators103626 +Ref: -partial103830 +Ref: -rpartial104348 +Ref: -juxt104996 +Ref: -compose105448 +Ref: -applify106055 +Ref: -on106485 +Ref: -flip107257 +Ref: -rotate-args107781 +Ref: -const108410 +Ref: -cut108752 +Ref: -not109232 +Ref: -orfn109776 +Ref: -andfn110569 +Ref: -iteratefn111356 +Ref: -fixfn112058 +Ref: -prodfn113632 +Node: Development114783 +Node: Contribute115072 +Node: Contributors116084 +Node: FDL118177 +Node: GPL143497 +Node: Index181246 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/dash-20230714.723/dir b/elpa/dash-20230714.723/dir new file mode 100644 index 00000000..7d473f49 --- /dev/null +++ b/elpa/dash-20230714.723/dir @@ -0,0 +1,18 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "H" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs +* Dash: (dash.info). A modern list library for GNU Emacs. diff --git a/elpa/smartparens-20220623.1523/smartparens-autoloads.el b/elpa/smartparens-20220623.1523/smartparens-autoloads.el deleted file mode 100644 index b6b42bfb..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-autoloads.el +++ /dev/null @@ -1,402 +0,0 @@ -;;; smartparens-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "smartparens" "smartparens.el" (0 0 0 0)) -;;; Generated autoloads from smartparens.el - -(autoload 'sp-cheat-sheet "smartparens" "\ -Generate a cheat sheet of all the smartparens interactive functions. - -Without a prefix argument, print only the short documentation and examples. - -With non-nil prefix argument ARG, show the full documentation for each function. - -You can follow the links to the function or variable help page. -To get back to the full list, use \\[help-go-back]. - -You can use `beginning-of-defun' and `end-of-defun' to jump to -the previous/next entry. - -Examples are fontified using the `font-lock-string-face' for -better orientation. - -\(fn &optional ARG)" t nil) - -(defvar smartparens-mode-map (make-sparse-keymap) "\ -Keymap used for `smartparens-mode'.") - -(autoload 'sp-use-paredit-bindings "smartparens" "\ -Initiate `smartparens-mode-map' with `sp-paredit-bindings'." t nil) - -(autoload 'sp-use-smartparens-bindings "smartparens" "\ -Initiate `smartparens-mode-map' with `sp-smartparens-bindings'." t nil) - -(autoload 'smartparens-mode "smartparens" "\ -Toggle smartparens mode. - -This is a minor mode. If called interactively, toggle the -`Smartparens mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `smartparens-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -You can enable pre-set bindings by customizing -`sp-base-key-bindings' variable. The current content of -`smartparens-mode-map' is: - - \\{smartparens-mode-map} - -\(fn &optional ARG)" t nil) - -(autoload 'smartparens-strict-mode "smartparens" "\ -Toggle the strict smartparens mode. - -This is a minor mode. If called interactively, toggle the -`Smartparens-Strict mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `smartparens-strict-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -When strict mode is active, `delete-char', `kill-word' and their -backward variants will skip over the pair delimiters in order to -keep the structure always valid (the same way as `paredit-mode' -does). This is accomplished by remapping them to -`sp-delete-char' and `sp-kill-word'. There is also function -`sp-kill-symbol' that deletes symbols instead of words, otherwise -working exactly the same (it is not bound to any key by default). - -When strict mode is active, this is indicated with \"/s\" -after the smartparens indicator in the mode list. - -\(fn &optional ARG)" t nil) - -(put 'smartparens-global-strict-mode 'globalized-minor-mode t) - -(defvar smartparens-global-strict-mode nil "\ -Non-nil if Smartparens-Global-Strict mode is enabled. -See the `smartparens-global-strict-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `smartparens-global-strict-mode'.") - -(custom-autoload 'smartparens-global-strict-mode "smartparens" nil) - -(autoload 'smartparens-global-strict-mode "smartparens" "\ -Toggle Smartparens-Strict mode in all buffers. -With prefix ARG, enable Smartparens-Global-Strict mode if ARG is -positive; otherwise, disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Smartparens-Strict mode is enabled in all buffers where -`turn-on-smartparens-strict-mode' would do it. - -See `smartparens-strict-mode' for more information on -Smartparens-Strict mode. - -\(fn &optional ARG)" t nil) - -(autoload 'turn-on-smartparens-strict-mode "smartparens" "\ -Turn on `smartparens-strict-mode'." t nil) - -(autoload 'turn-off-smartparens-strict-mode "smartparens" "\ -Turn off `smartparens-strict-mode'." t nil) - -(put 'smartparens-global-mode 'globalized-minor-mode t) - -(defvar smartparens-global-mode nil "\ -Non-nil if Smartparens-Global mode is enabled. -See the `smartparens-global-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `smartparens-global-mode'.") - -(custom-autoload 'smartparens-global-mode "smartparens" nil) - -(autoload 'smartparens-global-mode "smartparens" "\ -Toggle Smartparens mode in all buffers. -With prefix ARG, enable Smartparens-Global mode if ARG is positive; -otherwise, disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Smartparens mode is enabled in all buffers where -`turn-on-smartparens-mode' would do it. - -See `smartparens-mode' for more information on Smartparens mode. - -\(fn &optional ARG)" t nil) - -(autoload 'turn-on-smartparens-mode "smartparens" "\ -Turn on `smartparens-mode'. - -This function is used to turn on `smartparens-global-mode'. - -By default `smartparens-global-mode' ignores buffers with -`mode-class' set to special, but only if they are also not comint -buffers. - -Additionally, buffers on `sp-ignore-modes-list' are ignored. - -You can still turn on smartparens in these mode manually (or -in mode's startup-hook etc.) by calling `smartparens-mode'." t nil) - -(autoload 'turn-off-smartparens-mode "smartparens" "\ -Turn off `smartparens-mode'." t nil) - -(autoload 'show-smartparens-mode "smartparens" "\ -Toggle visualization of matching pairs. When enabled, any -matching pair is highlighted after `sp-show-pair-delay' seconds -of Emacs idle time if the point is immediately in front or after -a pair. This mode works similarly to `show-paren-mode', but -support custom pairs. - -This is a minor mode. If called interactively, toggle the -`Show-Smartparens mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `show-smartparens-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(put 'show-smartparens-global-mode 'globalized-minor-mode t) - -(defvar show-smartparens-global-mode nil "\ -Non-nil if Show-Smartparens-Global mode is enabled. -See the `show-smartparens-global-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `show-smartparens-global-mode'.") - -(custom-autoload 'show-smartparens-global-mode "smartparens" nil) - -(autoload 'show-smartparens-global-mode "smartparens" "\ -Toggle Show-Smartparens mode in all buffers. -With prefix ARG, enable Show-Smartparens-Global mode if ARG is -positive; otherwise, disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Show-Smartparens mode is enabled in all buffers where -`turn-on-show-smartparens-mode' would do it. - -See `show-smartparens-mode' for more information on Show-Smartparens -mode. - -\(fn &optional ARG)" t nil) - -(autoload 'turn-on-show-smartparens-mode "smartparens" "\ -Turn on `show-smartparens-mode'." t nil) - -(autoload 'turn-off-show-smartparens-mode "smartparens" "\ -Turn off `show-smartparens-mode'." t nil) - -(register-definition-prefixes "smartparens" '("smartparens-" "sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-clojure" "smartparens-clojure.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-clojure.el - -(register-definition-prefixes "smartparens-clojure" '("sp-clojure-prefix")) - -;;;*** - -;;;### (autoloads nil "smartparens-config" "smartparens-config.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-config.el - -(register-definition-prefixes "smartparens-config" '("sp-lisp-invalid-hyperlink-p")) - -;;;*** - -;;;### (autoloads nil "smartparens-crystal" "smartparens-crystal.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-crystal.el - -(register-definition-prefixes "smartparens-crystal" '("sp-crystal-")) - -;;;*** - -;;;### (autoloads nil "smartparens-elixir" "smartparens-elixir.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-elixir.el - -(register-definition-prefixes "smartparens-elixir" '("sp-elixir-")) - -;;;*** - -;;;### (autoloads nil "smartparens-ess" "smartparens-ess.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-ess.el - -(register-definition-prefixes "smartparens-ess" '("sp-ess-")) - -;;;*** - -;;;### (autoloads nil "smartparens-haskell" "smartparens-haskell.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-haskell.el - -(register-definition-prefixes "smartparens-haskell" '("sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-html" "smartparens-html.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-html.el - -(register-definition-prefixes "smartparens-html" '("sp-html-")) - -;;;*** - -;;;### (autoloads nil "smartparens-latex" "smartparens-latex.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-latex.el - -(register-definition-prefixes "smartparens-latex" '("sp-latex-")) - -;;;*** - -;;;### (autoloads nil "smartparens-lua" "smartparens-lua.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-lua.el - -(register-definition-prefixes "smartparens-lua" '("sp-lua-post-keyword-insert")) - -;;;*** - -;;;### (autoloads nil "smartparens-markdown" "smartparens-markdown.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-markdown.el - -(register-definition-prefixes "smartparens-markdown" '("sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-org" "smartparens-org.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-org.el - -(register-definition-prefixes "smartparens-org" '("sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-python" "smartparens-python.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-python.el - -(register-definition-prefixes "smartparens-python" '("sp-python-")) - -;;;*** - -;;;### (autoloads nil "smartparens-rst" "smartparens-rst.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-rst.el - -(register-definition-prefixes "smartparens-rst" '("sp-rst-point-after-backtick")) - -;;;*** - -;;;### (autoloads nil "smartparens-ruby" "smartparens-ruby.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-ruby.el - -(register-definition-prefixes "smartparens-ruby" '("sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-rust" "smartparens-rust.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-rust.el - -(register-definition-prefixes "smartparens-rust" '("sp-")) - -;;;*** - -;;;### (autoloads nil "smartparens-scala" "smartparens-scala.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-scala.el - -(register-definition-prefixes "smartparens-scala" '("sp-scala-wrap-with-indented-newlines")) - -;;;*** - -;;;### (autoloads nil "smartparens-swift" "smartparens-swift.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-swift.el - -(register-definition-prefixes "smartparens-swift" '("sp-swift-")) - -;;;*** - -;;;### (autoloads nil "smartparens-text" "smartparens-text.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-text.el - -(register-definition-prefixes "smartparens-text" '("sp-text-mode-")) - -;;;*** - -;;;### (autoloads nil "sp-sublimetext-like" "sp-sublimetext-like.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from sp-sublimetext-like.el - -(register-definition-prefixes "sp-sublimetext-like" '("sp-point-not-before-word")) - -;;;*** - -;;;### (autoloads nil nil ("smartparens-c.el" "smartparens-go.el" -;;;;;; "smartparens-javascript.el" "smartparens-ml.el" "smartparens-pkg.el" -;;;;;; "smartparens-racket.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; smartparens-autoloads.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-c.el b/elpa/smartparens-20220623.1523/smartparens-c.el deleted file mode 100644 index eeb96b5a..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-c.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; smartparens-c.el --- Additional configuration for C/C++ mode. -*- lexical-binding: t; -*- -;; -;; Author: Naoya Yamashita -;; Maintainer: Matus Goljer -;; Created: 23 June 2019 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens -;; -;; This file is not part of GNU Emacs. -;; -;;; License: -;; -;; This file is part of Smartparens. -;; -;; Smartparens 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. -;; -;; Smartparens 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 Smartparens. If not, see . -;; -;;; Commentary: -;; -;; This file provides some additional configuration for C/C++ mode. -;; To use it, simply add: -;; -;; (require 'smartparens-c) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;;; Code: - -(require 'smartparens) - -;; remap electric delete functions to smartparens function -(define-key smartparens-strict-mode-map [remap c-electric-delete-forward] 'sp-delete-char) -(define-key smartparens-strict-mode-map [remap c-electric-backspace] 'sp-backward-delete-char) - -(sp-with-modes sp-c-modes - (sp-local-pair "{" nil :post-handlers '(("||\n[i]" "RET"))) - (sp-local-pair "/*" "*/" :post-handlers '(("| " "SPC") - ("* ||\n[i]" "RET")))) - -(provide 'smartparens-c) -;;; smartparens-c.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-clojure.el b/elpa/smartparens-20220623.1523/smartparens-clojure.el deleted file mode 100644 index e07e650d..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-clojure.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; smartparens-clojure.el --- Additional configuration for Clojure mode. -*- lexical-binding: t; -*- -;; -;; Author: Vitalie Spinu -;; Maintainer: Matus Goljer -;; Created: 14 July 2016 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens -;; -;; This file is not part of GNU Emacs. -;; -;;; License: -;; -;; This file is part of Smartparens. -;; -;; Smartparens 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. -;; -;; Smartparens 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 Smartparens. If not, see . -;; -;;; Commentary: -;; -;; This file provides some additional configuration for Clojure mode. To use -;; it, simply add: -;; -;; (require 'smartparens-clojure) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;;; Code: - -(require 'smartparens) - -(defvar sp-clojure-prefix "\\(?:[@`'#~,_?^]+\\)" - "Prefix used in `sp-sexp-prefix' for clojure modes.") - -(dolist (mode '(clojure-mode clojurescript-mode clojurec-mode cider-repl-mode)) - (add-to-list 'sp-sexp-prefix `(,mode regexp ,sp-clojure-prefix))) - -;; Match "`" with "`" in strings and comments -(sp-with-modes sp-clojure-modes - (sp-local-pair "`" "`" - :when '(sp-in-string-p - sp-in-comment-p) - :unless '(sp-lisp-invalid-hyperlink-p))) - -(provide 'smartparens-clojure) -;;; smartparens-clojure.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-config.el b/elpa/smartparens-20220623.1523/smartparens-config.el deleted file mode 100644 index 3b8e8f59..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-config.el +++ /dev/null @@ -1,136 +0,0 @@ -;;; smartparens-config.el --- Default configuration for smartparens package -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2016 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 30 Jan 2013 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This is a default configuration for smartparens package. If you -;; wish to set up everything by yourself, you can instead require -;; smartparens directly. - -;; However, some configuration is always loaded by default, most -;; notably the built-in list of supported pairs. If you want to erase -;; this list, simply use (setq sp-pairs nil) and then add your own -;; pairs. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defun sp-lisp-invalid-hyperlink-p (_id action _context) - "Test if there is an invalid hyperlink in a Lisp docstring. -ID, ACTION, CONTEXT." - (when (eq action 'navigate) - ;; Ignore errors due to us being at the start or end of the - ;; buffer. - (ignore-errors - (or - ;; foo'|bar - (and (looking-at "\\sw\\|\\s_") - ;; do not consider punctuation - (not (looking-at "[?.,;!]")) - (save-excursion - (backward-char 2) - (looking-at "\\sw\\|\\s_"))) - ;; foo|'bar - (and (save-excursion - (backward-char 1) - (looking-at "\\sw\\|\\s_")) - (save-excursion - (forward-char 1) - (looking-at "\\sw\\|\\s_") - ;; do not consider punctuation - (not (looking-at "[?.,;!]")))))))) - -;; emacs is lisp hacking enviroment, so we set up some most common -;; lisp modes too -(sp-with-modes sp-lisp-modes - ;; disable ', it's the quote character! - (sp-local-pair "'" nil :actions nil)) - -(sp-with-modes (-difference sp-lisp-modes sp-clojure-modes) - ;; also only use the pseudo-quote inside strings where it serve as - ;; hyperlink. - (sp-local-pair "`" "'" - :when '(sp-in-string-p - sp-in-comment-p) - :unless '(sp-lisp-invalid-hyperlink-p) - :skip-match (lambda (ms _mb _me) - (cond - ((equal ms "'") - (or (sp-lisp-invalid-hyperlink-p "`" 'navigate '_) - (not (sp-point-in-string-or-comment)))) - (t (not (sp-point-in-string-or-comment))))))) - -;; TODO: this should only be active in docstring, otherwise we want -;; the regexp completion \\{\\}. To handle this feature, we must -;; allow multiple pairs on same opening (therefore, the unique ID must -;; become the opening and closing pair) -(sp-local-pair 'emacs-lisp-mode "\\\\{" "}" :when '(sp-in-docstring-p)) - -;; NOTE: Normally, `sp-local-pair' accepts list of modes (or a single -;; mode) as a first argument. The macro `sp-with-modes' adds this -;; automatically. If you want to call sp-local-pair outside this -;; macro, you MUST supply the major mode argument. - -(eval-after-load 'cc-mode '(require 'smartparens-c)) -(eval-after-load 'clojure-mode '(require 'smartparens-clojure)) -(eval-after-load 'crystal-mode '(require 'smartparens-crystal)) -(eval-after-load 'elixir-mode '(require 'smartparens-elixir)) -(eval-after-load 'enh-ruby-mode '(require 'smartparens-ruby)) -(eval-after-load 'ess '(require 'smartparens-ess)) -(eval-after-load 'go-mode '(require 'smartparens-go)) -(eval-after-load 'haskell-interactive-mode '(require 'smartparens-haskell)) -(eval-after-load 'haskell-mode '(require 'smartparens-haskell)) -(--each sp--html-modes - (eval-after-load it '(require 'smartparens-html))) -(eval-after-load 'latex '(require 'smartparens-latex)) -(eval-after-load 'lua-mode '(require 'smartparens-lua)) -(eval-after-load 'markdown-mode '(require 'smartparens-markdown)) -(--each '(python-mode python) - (eval-after-load it '(require 'smartparens-python))) -(eval-after-load 'org '(require 'smartparens-org)) -(eval-after-load 'racket-mode '(require 'smartparens-racket)) -(eval-after-load 'rst '(require 'smartparens-rst)) -(eval-after-load 'ruby-mode '(require 'smartparens-ruby)) -(eval-after-load 'rust-mode '(require 'smartparens-rust)) -(eval-after-load 'rustic '(require 'smartparens-rust)) -(eval-after-load 'scala-mode '(require 'smartparens-scala)) -(eval-after-load 'swift-mode '(require 'smartparens-swift)) -(eval-after-load 'tex-mode '(require 'smartparens-latex)) -(eval-after-load 'text-mode '(require 'smartparens-text)) -(eval-after-load 'tuareg '(require 'smartparens-ml)) -(eval-after-load 'fsharp-mode '(require 'smartparens-ml)) -(--each '(js js2-mode) - (eval-after-load it '(require 'smartparens-javascript))) -(provide 'smartparens-config) - -;;; smartparens-config.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-crystal.el b/elpa/smartparens-20220623.1523/smartparens-crystal.el deleted file mode 100644 index 574ac8ea..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-crystal.el +++ /dev/null @@ -1,261 +0,0 @@ -;;; smartparens-crystal.el --- Additional configuration for Crystal based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2018 Brantou - -;; Author: Brantou -;; Maintainer: Brantou -;; Created: 5 March 2018 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; Based on smartparens-ruby.el - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Crystal based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-crystal) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) -(require 'smartparens-ruby) - -(declare-function crystal-forward-sexp "crystal") -(declare-function crystal-backward-sexp "crystal") - -(defun sp-crystal-forward-sexp () - "Wrapper for `crystal-forward-sexp'." - (interactive) - (crystal-forward-sexp)) - -(defun sp-crystal-backward-sexp () - "Wrapper for `crystal-backward-sexp'." - (interactive) - (crystal-backward-sexp)) - -(defun sp-crystal-inline-p (id) - "Test if ID is inline." - (save-excursion - (when (looking-back id nil) - (backward-word)) - (when (not (or (looking-back "^[[:blank:]]*" nil) - (looking-back "= *" nil))) - (or (save-excursion - (forward-symbol -1) - (forward-symbol 1) - (looking-at-p (concat " *" id))) - (save-excursion - ;; This does not seem to make emacs snapshot happy - (ignore-errors - (sp-crystal-backward-sexp) - (sp-crystal-forward-sexp) - (looking-at-p (concat "[^[:blank:]]* *" id)))))))) - -(defun sp-crystal-skip-inline-match-p (ms _mb _me) - "If non-nil, skip inline match. -MS, MB, ME." - (or (sp-ruby-method-p ms) - (sp-crystal-inline-p ms))) - -(defun sp-crystal-in-string-word-or-inline-p (id action context) - "Test if point is inside string, word or inline. -ID, ACTION, CONTEXT." - (or (sp-ruby-in-string-or-word-p id action context) - (and (looking-back id nil) - (sp-crystal-inline-p id)))) - -(add-to-list 'sp-navigate-skip-match - '((crystal-mode) . sp--ruby-skip-match)) - -(dolist (mode '(crystal-mode)) - (add-to-list 'sp-sexp-suffix `(,mode syntax ""))) - -(sp-with-modes 'crystal-mode - (sp-local-pair "do" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-block-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "{" "}" - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-post-handler) - :suffix "") - - (sp-local-pair "begin" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-block-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "def" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "class" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "struct" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "lib" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "fun" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "enum" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "union" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "module" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "macro" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "case" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "if" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-crystal-skip-inline-match-p - :suffix "") - - (sp-local-pair "unless" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-crystal-skip-inline-match-p - :suffix "") - - (sp-local-pair "while" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-crystal-skip-inline-match-p - :suffix "") - - (sp-local-pair "until" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-crystal-skip-inline-match-p - :suffix "") - - (sp-local-pair "|" "|" - :when '(sp-ruby-should-insert-pipe-close) - :pre-handlers '(sp-ruby-pre-pipe-handler) - :suffix "")) - -(provide 'smartparens-crystal) - -;;; smartparens-crystal.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-elixir.el b/elpa/smartparens-20220623.1523/smartparens-elixir.el deleted file mode 100644 index 820c8df1..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-elixir.el +++ /dev/null @@ -1,214 +0,0 @@ -;;; smartparens-elixir.el --- Configuration for Elixir. -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Matúš Goljer - -;; Author: Matúš Goljer -;; Maintainer: Matúš Goljer -;; Version: 0.0.1 -;; Created: 15th January 2017 -;; Keywords: languages - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: - -;;; Code: - -(require 'smartparens) - -(--each '(elixir-mode) - (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) - -(defvar sp-elixir-builtins - (regexp-opt '("defmodule" "defmacro" "defmacrop" "def" "defp" "defimpl" - "if" "unless" "case" "cond" - "with" "for" "receive" "try" "quote") - 'words) - "Regexp that matches opening delimiters for definitions. - -Definitions require either comma followed by \"do:\" keyword -list, or \"do\" \"end\" block delimiters.") - -(defun sp-elixir-skip-do-keyword-p-fun (bodyless-ms keywords) - "Define a function that will test if any of keywords is part of definition. - -BODYLESS-MS is an keyword that supports bodyless form, like -\"def\" or \"defp\". KEYWORDS is additional regexp for keywords -to check in order to skip definition. - -This line-based search terminates early if any of -`sp-elixir-builtins' were found." - (lambda (ms _mb _me) - (unless (or (equal "end" ms) (equal "do" ms)) - (or (string-match-p keywords (thing-at-point 'line t)) - (catch 'definition - (save-excursion - (while t - (forward-line 1) - (let ((line (string-trim-left (thing-at-point 'line t)))) - (unless (string-match-p "\\s-*#" line) ;; skip full line comments - (cond ((eq (string-match-p "\\bend\\b" line) 0) - (throw 'definition nil)) - ;; if BODYLESS-MS was supplied, means we're trying - ;; to match bodyless form - ((and bodyless-ms (eq (string-match-p bodyless-ms line) 0)) - (throw 'definition t)) - ;; Terminate the search if we find any of - ;; `sp-elixir-builtins' as we're usually - ;; searching for "end" - ((eq (string-match-p sp-elixir-builtins line) 0) - (throw 'definition nil)) - ;; "do:" keyword means that there will be no - ;; "end" so we skip this definition - ((eq (string-match-p keywords line) 0) - (throw 'definition t)) - ((eobp) (throw 'definition nil)))))))))))) - -;; Special functions for SKIP-MATCH parameter of `sp-pair' - -(fset 'sp-elixir-skip-keyword-list-def-p (sp-elixir-skip-do-keyword-p-fun nil "\\bdo:")) -(fset 'sp-elixir-skip-bodyless-def-p (sp-elixir-skip-do-keyword-p-fun "\\bdef\\b" "\\bdo:")) -(fset 'sp-elixir-skip-bodyless-defp-p (sp-elixir-skip-do-keyword-p-fun "\\bdefp\\b" "\\bdo:")) -(fset 'sp-elixir-skip-for-in-defimpl-p (sp-elixir-skip-do-keyword-p-fun nil "\\b\\(defimpl\\b\\|do:\\)")) - -(defun sp-elixir-skip-def-p (ms _mb _me) - "Test if \"do\" is part of definition. - -MS must be \"do\" keyword. - -Definitions in Elixir can contain any of `sp-elixir-builtins' -followed with \"do\" keyword and closed with \"end\" keyword, -which may not be on the same line." - (when (equal "do" ms) - (save-excursion - (catch 'definition - (while t - (let ((line (string-trim-left (thing-at-point 'line t)))) - (unless (string-match-p "\\s-*#" line) - (cond ((eq (string-match-p sp-elixir-builtins line) 0) - (throw 'definition t)) - ((eq (string-match-p "\\bend\\b" line) 0) - (throw 'definition nil)) - ((bobp) (throw 'definition nil))))) - (forward-line -1)))))) - -(defun sp-elixir-do-block-post-handler (_id action _context) - "Insert \"do\" keyword and indent the new block. -ID, ACTION, CONTEXT." - (when (eq action 'insert) - (let ((m (make-marker))) - (save-excursion - (forward-word) ;; over the "end" - (move-marker m (point))) - (save-excursion (newline)) - (save-excursion (insert " do")) - (indent-region (line-beginning-position) m) - (move-marker m nil nil)))) - -(defun sp-elixir-empty-do-block-post-handler (_id action _context) - "Insert empty \"do\" keyword and indent the new block. - -This is used for receive-do-end expression. -ID, ACTION, CONTEXT." - (when (eq action 'insert) - (let ((m (make-marker))) - (save-excursion - (forward-word) ;; over the "end" - (move-marker m (point))) - (save-excursion - (forward-line -1) - (end-of-line) - (insert " do")) - (save-excursion (newline)) - (indent-region (line-beginning-position) m) - (indent-according-to-mode) - (move-marker m nil nil)))) - -(sp-with-modes 'elixir-mode - (sp-local-pair "do" "end" - :when '(("SPC" "RET" "")) - :skip-match 'sp-elixir-skip-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "def" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-bodyless-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "defp" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-bodyless-defp-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "defmodule" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "defimpl" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "fn" "end" - :when '(("SPC" "RET" "")) - :post-handlers '("| ")) - (sp-local-pair "if" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "for" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-for-in-defimpl-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "cond" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "with" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "unless" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "case" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "try" "end" - :when '(("SPC" "RET" "")) - :post-handlers '(sp-elixir-do-block-post-handler) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "receive" "end" - :when '(("RET" "")) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :post-handlers '(sp-elixir-empty-do-block-post-handler)) - (sp-local-pair "quote" "end" - :when '(("RET" "")) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :post-handlers '(sp-elixir-empty-do-block-post-handler)) - (sp-local-pair "defmacro" "end" - :when '(("RET" "")) - :skip-match 'sp-elixir-skip-keyword-list-def-p - :post-handlers '(sp-elixir-empty-do-block-post-handler)) - ) - -(provide 'smartparens-elixir) -;;; smartparens-elixir.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-ess.el b/elpa/smartparens-20220623.1523/smartparens-ess.el deleted file mode 100644 index 25ba4558..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-ess.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; smartparens-ess.el --- Smartparens Extension for Emacs Speaks Statistics -*- lexical-binding: t; -*- - -;; Copyright (c) 2015-2016 Bernhard Pröll - -;; Author: Bernhard Pröll -;; Maintainer: Bernhard Pröll -;; URL: https://github.com/Fuco1/smartparens -;; Created: 2015-02-26 -;; Version: 0.2 -;; Keywords: abbrev convenience editing - -;; This file is NOT part of GNU Emacs. - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: -;; -;; This file provides some additional configuration for ESS. To use -;; it, simply add: -;; -;; (require 'smartparens-ess) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;;; Code: - -(require 'smartparens) -(require 'rx) - -(defvar ess-roxy-str) - -(declare-function ess-roxy-indent-on-newline "ess-roxy") - - -(dolist (mode '(ess-mode ess-r-mode inferior-ess-mode inferior-ess-r-mode)) - ;; avoid traveling commas when slurping - ;; (|a, b), c ---> (|a, b, c) - (add-to-list 'sp-sexp-suffix (list mode 'regexp "")) - ;; `sp-sexp-prefix' for ESS - (add-to-list 'sp-sexp-prefix - (list mode 'regexp - (rx (zero-or-more (or word (syntax symbol))))))) - -(defadvice sp-backward-kill-symbol (around sp-ess-backward-kill-symbol activate) - "#821 For the purpose of killing words and symbols, we remove -the prefix resolution because it is not necessary. We want to -treat function prefix as word or symbol to be deleted." - (let ((sp-sexp-prefix nil)) - ad-do-it)) - -;; slurping follows Google's R style guide -;; see https://google.github.io/styleguide/Rguide.xml -(defun sp-ess-pre-handler (_id action _context) - "Remove spaces before opening parenthesis in a function call. -Remove redundant space around commas. -ID, ACTION, CONTEXT." - (when (equal action 'slurp-forward) - (let ((sxp (sp-get-thing 'back))) - (save-excursion - (goto-char (sp-get sxp :beg-prf)) - ;; (|) x ---> (x) - (when (looking-back (rx (syntax open-parenthesis) - (one-or-more space)) nil) - (cycle-spacing 0 nil 'single-shot)) - (cond - ;; (|)if(cond) ---> (|if (cond)) - ((member (sp-get sxp :prefix) '("if" "for" "while")) - (goto-char (sp-get sxp :beg)) - (cycle-spacing 1 nil 'single-shot)) - ;; (|)v [,2] <- if(x > 1) ---> (v[,2] <- if (x > 1)) - ((and - (member (sp-get sxp :op) '("[" "(")) - (equal (sp-get sxp :prefix) "") - (looking-back - (rx (and (not-char "%" ",") - (not (syntax close-parenthesis))) - (one-or-more space)) nil) - (not (member - (save-excursion - (sp-backward-sexp) - (thing-at-point 'word 'noprop)) - '("if" "for" "while")))) - (cycle-spacing 0 nil 'single-shot)) - ;; (|[...])%in% ---> ([...] %in%|) - ((or (looking-at "%") (looking-back "%" nil)) - (just-one-space)) - ;; (|)a , b, c ---> (|a, b, c) - ((looking-back - (rx (zero-or-more space) "," (zero-or-more space)) - (line-beginning-position) 'greedy) - (replace-match ", ")))))) - (when (equal action 'slurp-backward) - (let ((sxp (sp-get-thing))) - (save-excursion - (goto-char (sp-get sxp :end)) - ;; x (|) ---> (x) - (when (looking-at (rx (one-or-more space) - (syntax close-parenthesis))) - (cycle-spacing 0 nil 'single-shot)) - ;; if(cond){} (|) ---> (if (cond) {}|) - (cond ((member (sp-get sxp :prefix) '("if" "for" "while")) - (goto-char (sp-get sxp :beg)) - (cycle-spacing 1 nil 'single-shot)) - ;; for style reasons there should be a space before curly - ;; brackets and binary operators - ((and (member (sp-get sxp :op) '("{" "%")) - (not (looking-at (rx (syntax close-parenthesis))))) - (cycle-spacing 1 nil 'single-shot)) - ;; v[2](|) ---> (v[2]|) - ((and - (not (member (thing-at-point 'word 'noprop) - '("if" "for" "while"))) - (looking-at - (rx (and (zero-or-more space) - (not-char "{") - (or (syntax close-parenthesis) - (char "(") - (char "[")))))) - (cycle-spacing 0 nil 'single-shot)) - ;; 1 , 2 (|) ---> (1, 2) - ((looking-at - (rx (zero-or-more space) "," (zero-or-more space))) - (replace-match ", "))))))) - -;; function(x) {|} ---> function(x) {\n|\n} -;; ##' \tabular{rrr}{|} ---> -;; ##' \tabular{rrr}{ -;; ##' | -;; ##' } -(defun sp-ess-open-sexp-indent (&rest _args) - "Open new brace or bracket with indentation. -ARGS." - (if (and (fboundp 'ess-roxy-entry-p) (ess-roxy-entry-p)) - (progn - (save-excursion (ess-roxy-indent-on-newline)) - (when (looking-back ess-roxy-str nil) - (cycle-spacing 3 nil t))) - (newline) - (indent-according-to-mode) - (forward-line -1) - (indent-according-to-mode))) - -(defun sp-ess-roxy-str-p (_id action _context) - "Test if looking back at `ess-roxy-re'. -ID, ACTION, CONTEXT." - (when (and (bound-and-true-p ess-roxy-re) (eq action 'insert)) - (sp--looking-back-p ess-roxy-re))) - -(sp-with-modes 'ess-mode - (sp-local-pair "{" nil - :pre-handlers '(sp-ess-pre-handler) - ;; the more reasonable C-j interferes with default binding for - ;; `ess-eval-line' - :post-handlers '((sp-ess-open-sexp-indent "M-j"))) - (sp-local-pair "(" nil - :pre-handlers '(sp-ess-pre-handler) - :post-handlers '((sp-ess-open-sexp-indent "M-j"))) - (sp-local-pair "[" nil - :pre-handlers '(sp-ess-pre-handler) - :post-handlers '((sp-ess-open-sexp-indent "M-j"))) - (sp-local-pair "'" nil - :unless '(sp-ess-roxy-str-p sp-in-comment-p sp-in-string-quotes-p))) - -;;; roxygen2 markup -;; see https://cran.r-project.org/web/packages/roxygen2/vignettes/formatting.html -(sp-with-modes 'ess-mode - (sp-local-pair "\\strong{" "}" - :when '(sp-in-comment-p) - :trigger "\\strong") - (sp-local-pair "\\emph{" "}" - :when '(sp-in-comment-p) - :trigger "\\emph") - (sp-local-pair "\\code{" "}" - :when '(sp-in-comment-p) - :trigger "\\code") - (sp-local-pair "\\url{" "}" - :when '(sp-in-comment-p) - :trigger "\\url") - (sp-local-pair "\\link{" "}" - :when '(sp-in-comment-p) - :trigger "\\link") - (sp-local-pair "\\href{" "}" - :when '(sp-in-comment-p) - :trigger "\\href" - :suffix "{[^}]*}") - (sp-local-pair "\\email{" "}" - :when '(sp-in-comment-p) - :trigger "\\email") - (sp-local-pair "\\pkg{" "}" - :when '(sp-in-comment-p) - :trigger "\\pkg") - (sp-local-pair "\\item{" "}" - :when '(sp-in-comment-p) - :post-handlers '((sp-ess-open-sexp-indent "M-j")) - :trigger "\\item{") - (sp-local-pair "\\enumerate{" "}" - :when '(sp-in-comment-p) - :post-handlers '((sp-ess-open-sexp-indent "M-j")) - :trigger "\\enumerate") - (sp-local-pair "\\itemize{" "}" - :when '(sp-in-comment-p) - :post-handlers '((sp-ess-open-sexp-indent "M-j")) - :trigger "\\itemize") - (sp-local-pair "\\describe{" "}" - :when '(sp-in-comment-p) - :post-handlers '((sp-ess-open-sexp-indent "M-j")) - :trigger "\\describe") - (sp-local-pair "\\eqn{" "}" - :when '(sp-in-comment-p) - :trigger "\\eqn") - (sp-local-pair "\\deqn{" "}" - :when '(sp-in-comment-p) - :trigger "\\deqn") - (sp-local-pair "\\tabular{" "}" - :when '(sp-in-comment-p) - :trigger "\\tabular" - :post-handlers '((sp-ess-open-sexp-indent "M-j")) - :suffix "{[^}]*}")) - -(sp-with-modes '(ess-r-mode inferior-ess-r-mode) - (sp-local-pair "\\(" nil - :unless '(:add sp-in-code-p))) - -(provide 'smartparens-ess) -;;; smartparens-ess ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-go.el b/elpa/smartparens-20220623.1523/smartparens-go.el deleted file mode 100644 index 7479a4cc..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-go.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; smartparens-go.el --- Additional configuration for go-mode. -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Jimmy Yuen Ho Wong - -;; Created: 10 June 2022 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Go. To use -;; it, simply add: -;; -;; (require 'smartparens-config) -;; -;; alternatively, you can explicitly load these preferences: -;; -;; (require 'smartparens-go) -;; -;; in your configuration. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: -(require 'smartparens) - -(declare-function go-mode "go-mode") - -(sp-with-modes 'go-mode - (sp-local-pair "{" nil :post-handlers '(("||\n[i]" "RET"))) - (sp-local-pair "/*" "*/" :post-handlers '(("| " "SPC") - ("* ||\n[i]" "RET")))) - -;; Go has no sexp suffices. This fixes slurping -;; (|foo).bar -> (foo.bar) -(add-to-list 'sp-sexp-suffix (list #'go-mode 'regexp "")) - -(provide 'smartparens-go) - -;;; smartparens-go.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-haskell.el b/elpa/smartparens-20220623.1523/smartparens-haskell.el deleted file mode 100644 index 47a9ab58..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-haskell.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; smartparens-haskell.el --- Additional configuration for Haskell based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015 Michael Xavier - -;; Author: Michael Xavier -;; Maintainer: Michael Xavier -;; Created: 29 Apr 2016 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Haskell based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-haskell) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: -(require 'smartparens) - -(defun sp-haskell-skip-apostrophe (_ms mb _me) - (save-excursion - ;; We test the syntax class because haskell mode overrides - ;; the class for ' on the fly when it run the syntax pass of - ;; font-lock... so that if '' is a valid string (char) it - ;; gets an override via 'syntax-table property. In which - ;; case we just agree with haskell mode and let it be used as - ;; a pair. - (not (eq (syntax-class (syntax-after mb)) 7)))) - -(defun sp-haskell-strict-ignore-apostrophe-after-word (_id action _context) - "Ignore trailing ' when navigating. - -Because ' in haskell is symbol class it gets picked up as part of -a words such as myFunction', and then strict mode won't allow us -to delete it. Also show-smartparens-mode incorrectly highlights -it as missing an opener. - -So we ignore that pair when at the end of word." - (when (eq action 'navigate) - (sp--looking-back-p (concat "\\(\\sw\\|\\s_\\)'+")))) - -(sp-with-modes '(haskell-mode haskell-interactive-mode) - (sp-local-pair "{-" "-}") - (sp-local-pair "{-#" "#-}") - (sp-local-pair "{-@" "@-}") - (sp-local-pair "'" nil - :unless '(sp-point-after-word-p - sp-haskell-strict-ignore-apostrophe-after-word) - :skip-match 'sp-haskell-skip-apostrophe) - (sp-local-pair "\\(" nil :actions nil)) - -(defun sp--inferior-haskell-mode-backward-bound-fn () - "Limit the backward search to the prompt if point is on prompt." - (-when-let (limit (cond ((bound-and-true-p comint-last-prompt) - (marker-position (cdr comint-last-prompt))) - ((bound-and-true-p comint-last-prompt-overlay) - (overlay-end comint-last-prompt-overlay)) - (t nil))) - (and (> (point) limit) limit))) - -(defun sp--inferior-haskell-mode-forward-bound-fn () - "Limit the forward search to exclude the prompt if point is before prompt." - (-when-let (limit (cond ((bound-and-true-p comint-last-prompt) - (marker-position (car comint-last-prompt))) - ((bound-and-true-p comint-last-prompt-overlay) - (overlay-start comint-last-prompt-overlay)) - (t nil))) - (and (< (point) limit) limit))) - -(defun sp--setup-inferior-haskell-mode-search-bounds () - "Setup the search bound. - -If the point is after the last prompt, limit the backward search -only for the propmt. - -If the point is before the last prompt, limit the forward search up until the prompt start." - (setq sp-forward-bound-fn 'sp--inferior-haskell-mode-forward-bound-fn) - (setq sp-backward-bound-fn 'sp--inferior-haskell-mode-backward-bound-fn)) - -(add-hook 'inferior-haskell-mode-hook 'sp--setup-inferior-haskell-mode-search-bounds) - -(provide 'smartparens-haskell) - -;;; smartparens-haskell.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-html.el b/elpa/smartparens-20220623.1523/smartparens-html.el deleted file mode 100644 index 3ba64060..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-html.el +++ /dev/null @@ -1,173 +0,0 @@ -;;; smartparens-html.el --- Additional configuration for HTML based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2014 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 14 Sep 2013 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for HTML based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-html) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. - -;; This file provides these interactive functions: - -;; `sp-html-next-tag' - Recommended binding: C-c C-f -;; `sp-html-previous-tag' - Recommended binding: C-c C-b -;; -;; (These two bindings are used for navigation by tags forward or -;; backward, but `sp-forward-sexp' already does that.) - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defun sp-html-next-tag (arg) - "Move point to the beginning of next SGML tag. - -With ARG positive N > 1, move N tags forward. - -With ARG raw prefix argument \\[universal-argument] move out of -the current tag and to the beginning of enclosing tag. - -Note: this function is based on `sp-beginning-of-sexp' but -specialized to only work with SGML tags and to always move -forward." - (interactive "P") - (let ((sp-prefix-tag-object t)) - (if (sp--raw-argument-p arg) - (sp-beginning-of-sexp arg) - (sp-beginning-of-sexp (1+ (prefix-numeric-value arg)))))) - -(defun sp-html-previous-tag (arg) - "Move point to the beginning of previous SGML tag. - -With ARG positive N > 1, move N tags backward. - -With ARG raw prefix argument \\[universal-argument] move out of -the current tag and to the beginning of enclosing tag. - -Note: this function is based on `sp-beginning-of-sexp' but -specialized to only work with SGML tags and to always move -backward." - (interactive "P") - (let ((sp-prefix-tag-object t)) - (if (sp--raw-argument-p arg) - (sp-beginning-of-sexp arg) - (sp-beginning-of-sexp (1- (- (prefix-numeric-value arg))))))) - -(defun sp-html-post-handler (&optional _id action _context) - "Post-action hooks for `html-mode'. - -ID is the tag being processed, ACTION is the action and CONTEXT -specifies if we are inside a string or code." - (cl-case action - (slurp-forward - (save-excursion - (let ((sp-prefix-pair-object t)) - (sp-backward-sexp)) - (-when-let (enc (sp-get-enclosing-sexp)) - (sp-get enc - (goto-char :beg-in) - (when (looking-at-p "[ \t]*$") - (goto-char :end-in) - (save-excursion - (sp-backward-sexp) - (forward-line -1) - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (1+ (line-end-position))))) - (newline-and-indent)))))) - (slurp-backward - (save-excursion - (-when-let (enc (sp-get-enclosing-sexp)) - (sp-get enc - (goto-char :end-in) - (when (sp--looking-back-p "^[ \t]*") - (save-excursion - (goto-char :beg-in) - (newline-and-indent) - (sp-forward-sexp) - (forward-line) - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (1+ (line-end-position)))))))))) - (barf-forward - (save-excursion - (let ((sp-prefix-pair-object t)) - (sp-backward-sexp)) - (-when-let (enc (sp-get-enclosing-sexp)) - (sp-get enc - (goto-char :beg-in) - (when (looking-at-p "[ \t]*$") - (goto-char :end-in) - (newline-and-indent))))) - (save-excursion - (sp-forward-sexp) - (forward-line) - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (1+ (line-end-position)))))) - (barf-backward - (save-excursion - (-when-let (enc (sp-get-enclosing-sexp)) - (sp-get enc - (goto-char :end-in) - (when (sp--looking-back-p "^[ \t]*") - (goto-char :beg-in) - (newline-and-indent) - (sp-backward-up-sexp) - (sp-backward-sexp) - (forward-line -1) - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (1+ (line-end-position))))))))) - (beginning-of-sexp - (when (looking-at-p "[ \t]*$") - (sp-next-sexp))) - (end-of-sexp - (when (sp--looking-back-p "^[ \t]*" nil t) - (sp-previous-sexp))))) - -(sp-with-modes sp--html-modes - (sp-local-pair "<" ">") - (sp-local-tag "<" "<_>" "" :transform 'sp-match-sgml-tags :post-handlers '(sp-html-post-handler))) - -(--each sp--html-modes - (add-to-list 'sp-navigate-consider-sgml-tags it)) - -(--each '(web-mode) - (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) - -(provide 'smartparens-html) - -;;; smartparens-html.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-javascript.el b/elpa/smartparens-20220623.1523/smartparens-javascript.el deleted file mode 100644 index aa024d68..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-javascript.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; smartparens-javascript.el --- Additional configuration for JavaScript based modes. -*- lexical-binding: t; -*- - -;; Copyright (c) 2017 Marinin Tim -;; Author: Tim Marinin -;; Maintainer: Tim Marinin -;; Created: 2017-03-03 -;; Keywords: abbrev convenience editing javascript -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for JavaScript based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-javascript) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -;; (|sys).path.append---the dot should not travel with the closing -;; paren -(--each '(js-mode javascript-mode js2-mode typescript-mode rjsx-mode) - (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) - -(provide 'smartparens-javascript) -;;; smartparens-javascript.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-latex.el b/elpa/smartparens-20220623.1523/smartparens-latex.el deleted file mode 100644 index 61d9a00c..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-latex.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; smartparens-latex.el --- Additional configuration for (La)TeX based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2016 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 14 Feb 2013 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for (La)TeX based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-latex) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defun sp-latex-insert-spaces-inside-pair (_id action _context) - "ID, ACTION, CONTEXT." - (when (eq action 'insert) - (insert " ") - (backward-char 1)) - (when (and (eq action 'wrap) - (save-excursion - (goto-char (sp-get sp-last-wrapped-region :beg-in)) - (not (sp--looking-back-p "[[{(]")))) - (save-excursion - (goto-char (sp-get sp-last-wrapped-region :end-in)) - (insert " ") - (goto-char (sp-get sp-last-wrapped-region :beg-in)) - (insert " ")))) - -(defun sp-latex-skip-match-apostrophe (ms _mb me) - "MS, MB, ME." - (when (equal ms "'") - (save-excursion - (goto-char me) - (looking-at-p "\\sw")))) - -(defun sp-latex-skip-double-quote (_id action _context) - "ID, ACTION, CONTEXT." - (when (eq action 'insert) - (when (looking-at-p "''''") - (delete-char -2) - (delete-char 2) - (forward-char 2)))) - -(defun sp-latex-point-after-backslash (id action _context) - "Return t if point follows a backslash, nil otherwise. -This predicate is only tested on \"insert\" action. -ID, ACTION, CONTEXT." - (when (eq action 'insert) - (let ((trigger (sp-get-pair id :trigger))) - (looking-back (concat "\\\\" (regexp-quote (if trigger trigger id))) nil)))) - -(add-to-list 'sp-navigate-skip-match - '((tex-mode plain-tex-mode latex-mode) . sp--backslash-skip-match)) - -(sp-with-modes '( - tex-mode - plain-tex-mode - latex-mode - LaTeX-mode - ) - (sp-local-pair "`" "'" - :actions '(:rem autoskip) - :skip-match 'sp-latex-skip-match-apostrophe - :unless '(sp-latex-point-after-backslash sp-in-math-p)) - ;; math modes, yay. The :actions are provided automatically if - ;; these pairs do not have global definitions. - (sp-local-pair "$" "$") - (sp-local-pair "\\[" "\\]" - :unless '(sp-latex-point-after-backslash)) - - ;; disable useless pairs. - (sp-local-pair "\\\\(" nil :actions nil) - (sp-local-pair "'" nil :actions nil) - (sp-local-pair "\\\"" nil :actions nil) - - ;; quote should insert ``'' instead of double quotes. If we ever - ;; need to insert ", C-q is our friend. - (sp-local-pair "``" "''" - :trigger "\"" - :unless '(sp-latex-point-after-backslash sp-in-math-p) - :post-handlers '(sp-latex-skip-double-quote)) - - ;; add the prefix function sticking to {} pair - (sp-local-pair "{" nil :prefix "\\\\\\(\\sw\\|\\s_\\)*") - - ;; do not add more space when slurping - (sp-local-pair "{" "}") - (sp-local-pair "(" ")") - (sp-local-pair "[" "]") - - ;; pairs for big brackets. Needs more research on what pairs are - ;; useful to add here. Post suggestions if you know some. - (sp-local-pair "\\left(" "\\right)" - :trigger "\\l(" - :when '(sp-in-math-p) - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\left[" "\\right]" - :trigger "\\l[" - :when '(sp-in-math-p) - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\left\\{" "\\right\\}" - :trigger "\\l{" - :when '(sp-in-math-p) - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\left|" "\\right|" - :trigger "\\l|" - :when '(sp-in-math-p) - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\bigl(" "\\bigr)" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\biggl(" "\\biggr)" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Bigl(" "\\Bigr)" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Biggl(" "\\Biggr)" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\bigl[" "\\bigr]" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\biggl[" "\\biggr]" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Bigl[" "\\Bigr]" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Biggl[" "\\Biggr]" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\bigl\\{" "\\bigr\\}" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\biggl\\{" "\\biggr\\}" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Bigl\\{" "\\Bigr\\}" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\Biggl\\{" "\\Biggr\\}" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\lfloor" "\\rfloor" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\lceil" "\\rceil" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\langle" "\\rangle" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\lVert" "\\rVert" - :when '(sp-in-math-p) - :trigger "\\lVert" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - (sp-local-pair "\\lvert" "\\rvert" - :when '(sp-in-math-p) - :trigger "\\lvert" - :post-handlers '(sp-latex-insert-spaces-inside-pair)) - - ;; some common wrappings - (sp-local-tag "\"" "``" "''" :actions '(wrap)) - (sp-local-tag "\\b" "\\begin{_}" "\\end{_}") - (sp-local-tag "bi" "\\begin{itemize}" "\\end{itemize}") - (sp-local-tag "be" "\\begin{enumerate}" "\\end{enumerate}")) - -(provide 'smartparens-latex) - -;;; smartparens-latex.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-lua.el b/elpa/smartparens-20220623.1523/smartparens-lua.el deleted file mode 100644 index 29621a6c..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-lua.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; smartparens-lua.el --- Additional configuration for Lua based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2014 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 3 August 2013 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Lua based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-lua) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defun sp-lua-post-keyword-insert (id action _context) - "ID, ACTION, CONTEXT." - (cond - ((eq action 'insert) - (cond - ((member id '("while" "for")) - (insert " do") - (save-excursion (newline-and-indent)) - (backward-char 3)) - ((equal id "if") - (insert " then") - (save-excursion (newline-and-indent)) - (backward-char 5)) - ((equal id "function") - (save-excursion (newline-and-indent)) - (insert " ")))))) - -;; all the pairs are expanded only if followed by "SPC" event. This -;; will reduce false positives like 'dIFficult' to trigger. -(sp-with-modes '(lua-mode) - (sp-local-pair "if" "end" - :when '(("SPC")) - :unless '(sp-in-comment-p sp-in-string-p) - :post-handlers '(sp-lua-post-keyword-insert)) - (sp-local-pair "function" "end" - :when '(("SPC")) - :unless '(sp-in-comment-p sp-in-string-p) - :post-handlers '(sp-lua-post-keyword-insert)) - (sp-local-pair "for" "end" - :when '(("SPC")) - :unless '(sp-in-comment-p sp-in-string-p) - :post-handlers '(sp-lua-post-keyword-insert)) - (sp-local-pair "while" "end" - :when '(("SPC")) - :unless '(sp-in-comment-p sp-in-string-p) - :post-handlers '(sp-lua-post-keyword-insert)) - ) - -(provide 'smartparens-lua) - -;;; smartparens-lua.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-markdown.el b/elpa/smartparens-20220623.1523/smartparens-markdown.el deleted file mode 100644 index b097fb5d..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-markdown.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; smartparens-markdown.el --- Additional configuration for Markdown based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 11th May 2017 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Markdown based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-markdown) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) -(require 'smartparens-text) -(eval-when-compile - (defvar markdown-gfm-use-electric-backquote)) - - -(defun sp-gfm-electric-backquote-p (_id action _context) - "Do not insert ```...``` pair if that would be handled by `markdown-electric-backquote'." - (and (eq action 'insert) - markdown-gfm-use-electric-backquote - (sp--looking-back-p "^```"))) - -(defun sp--gfm-point-after-word-p (id action _context) - "Return t if point is after a word, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-back-p (concat "\\(\\sw\\)" (regexp-quote id))))) - -(defun sp--gfm-skip-asterisk (_ms mb _me) - "Non-nil if we should ignore this asterisk as a delimiter." - (save-excursion - (goto-char mb) - (save-match-data (looking-at "^\\* ")))) - -(sp-with-modes '(markdown-mode gfm-mode) - (sp-local-pair "*" "*" - :unless '(sp--gfm-point-after-word-p sp-point-at-bol-p) - :post-handlers '(("[d1]" "SPC")) - :skip-match 'sp--gfm-skip-asterisk) - (sp-local-pair "**" "**") - (sp-local-pair "_" "_" :unless '(sp-point-after-word-p))) - -(sp-with-modes 'markdown-mode - (sp-local-pair "```" "```")) - -(sp-with-modes 'gfm-mode - (sp-local-pair "`" "`" :unless '(:add sp-gfm-electric-backquote-p)) - (sp-local-pair "```" "```" :unless '(:add sp-gfm-electric-backquote-p))) - -(provide 'smartparens-markdown) -;;; smartparens-markdown.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-ml.el b/elpa/smartparens-20220623.1523/smartparens-ml.el deleted file mode 100644 index ee066deb..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-ml.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; smartparens-ml.el --- Additional configuration for ML languages -*- lexical-binding: t; -*- - -;; Copyright (C) 2016-2017 Ta Quang Trung -;; Copyright (C) 2017 Matus Goljer - -;; Author: Ta Quang Trung -;; Matus Goljer -;; Louis Roché -;; Maintainer: Matus Goljer -;; Created: 14 July 2016 -;; Keywords: smartparens, ML, ocaml, reason -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for ML languages. -;; To use it, simply add: -;; -;; (require 'smartparens-ml) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -;;; Local pairs for ML-family languages - -(sp-with-modes '(fsharp-mode) - (sp-local-pair "(*" "*)" )) - -(sp-with-modes '(tuareg-mode) - ;; Disable ` because it is used in polymorphic variants - (sp-local-pair "`" nil :actions nil) - ;; Disable ' because it is used in value names and types - (sp-local-pair "'" nil :actions nil) - (sp-local-pair "{|" "|}" ) ;; multi-line string - (sp-local-pair "[|" "|]" ) ;; array - (sp-local-pair "sig" "end" ) ;; signature - (sp-local-pair "module" "end" ) ;; module - (sp-local-pair "(*" "*)" )) ;; comment - -;; Ignore punctuation, so we can split ~(foo) to ~foo. -(add-to-list 'sp-sexp-prefix (list 'tuareg-mode 'syntax "")) - -(sp-with-modes '(reason-mode) - ;; Disable ` because it is used in polymorphic variants - (sp-local-pair "`" nil :actions nil) - ;; Disable ' because it is used in value names and types - (sp-local-pair "'" nil :actions nil) - (sp-local-pair "/*" "*/" )) - -(provide 'smartparens-ml) -;;; smartparens-ml.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-org.el b/elpa/smartparens-20220623.1523/smartparens-org.el deleted file mode 100644 index 87dfeca3..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-org.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; smartparens-org.el --- Configuration for Org mode. -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Matúš Goljer - -;; Author: Matúš Goljer -;; Maintainer: Matúš Goljer -;; Version: 0.0.1 -;; Created: 15th January 2017 -;; Keywords: languages - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Org based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-org) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) -(require 'smartparens-text) - -(defun sp--org-skip-asterisk (_ms mb me) - "Non-nil if the asterisk is part of the outline marker." - (save-excursion - (goto-char mb) - (beginning-of-line) - (let ((skip-distance (skip-chars-forward "*"))) - (if (= skip-distance 1) - (not (memq (syntax-class (syntax-after (point))) '(2 3))) - (<= me (point)))))) - -(defun sp-org-point-after-left-square-bracket-p (id action _context) - "Return t if point is after a left square bracket, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-back-p (concat "\\[" (regexp-quote id))))) - -(sp-with-modes 'org-mode - (sp-local-pair "*" "*" - :unless '(sp-point-after-word-p sp-point-at-bol-p) - :skip-match 'sp--org-skip-asterisk) - (sp-local-pair "_" "_" :unless '(sp-point-after-word-p)) - (sp-local-pair "/" "/" :unless '(sp-point-after-word-p sp-org-point-after-left-square-bracket-p) :post-handlers '(("[d1]" "SPC"))) - (sp-local-pair "~" "~" :unless '(sp-point-after-word-p) :post-handlers '(("[d1]" "SPC"))) - (sp-local-pair "=" "=" :unless '(sp-point-after-word-p) :post-handlers '(("[d1]" "SPC"))) - (sp-local-pair "«" "»")) - -(provide 'smartparens-org) -;;; smartparens-org.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-pkg.el b/elpa/smartparens-20220623.1523/smartparens-pkg.el deleted file mode 100644 index a2b66c5e..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-pkg.el +++ /dev/null @@ -1,13 +0,0 @@ -(define-package "smartparens" "20220623.1523" "Automatic insertion, wrapping and paredit-like navigation with user defined pairs." - '((dash "2.13.0") - (cl-lib "0.3")) - :commit "8b6a3c3b31afd5b3f846e09859b5fc62eb06e7c1" :authors - '(("Matus Goljer" . "matus.goljer@gmail.com")) - :maintainer - '("Matus Goljer" . "matus.goljer@gmail.com") - :keywords - '("abbrev" "convenience" "editing") - :url "https://github.com/Fuco1/smartparens") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/smartparens-20220623.1523/smartparens-python.el b/elpa/smartparens-20220623.1523/smartparens-python.el deleted file mode 100644 index 93698ce5..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-python.el +++ /dev/null @@ -1,133 +0,0 @@ -;;; smartparens-python.el --- Additional configuration for Python based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015-2016 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 8 February 2015 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Python based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-python) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defgroup smartparens-python () - "smartparens settings for python-mode" - :group 'smartparens) - -(defcustom sp-python-insert-colon-in-function-definitions t - "If non-nil, auto-insert a colon after parens insertion in definition. - -Supported definitions are: - -- def -- async def -- class" - :group 'smartparens-python - :type 'boolean) - -;; Python has no sexp suffices. This fixes slurping -;; (|sys).path.append---the dot should not travel with the closing -;; paren -(--each '(python-mode inferior-python-mode) - (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) - -(defun sp-python-maybe-add-colon-python (_id action _context) - "Adds a colon after parentheses in a python definition. - -Works for (async) def forms and class forms. - -See also the option `sp-python-insert-colon-in-function-definitions'." - ;; here, caret supposed to be in between parens, i.e. (|) - (when (and sp-python-insert-colon-in-function-definitions - (eq action 'insert) - (looking-at ")\\s-*$") - (save-excursion - (goto-char (line-beginning-position)) - (re-search-forward - (rx bol - (* (syntax whitespace)) - (? "async") - (* (syntax whitespace)) - (or "def" "class") - word-boundary) - (line-end-position) - t))) - (save-excursion - (forward-char) ;; skip closing paren - (insert ":")))) - -(sp-with-modes 'python-mode - (sp-local-pair "'" "'" :unless '(sp-in-comment-p sp-in-string-quotes-p) :post-handlers '(:add sp-python-fix-tripple-quotes)) - (sp-local-pair "\"" "\"" :post-handlers '(:add sp-python-fix-tripple-quotes)) - (sp-local-pair "'''" "'''") - (sp-local-pair "\\'" "\\'") - (sp-local-pair "\"\"\"" "\"\"\"") - (sp-local-pair "(" ")" :post-handlers '(:add sp-python-maybe-add-colon-python))) - -(defun sp-python-fix-tripple-quotes (id action _context) - "Properly rewrap tripple quote pairs. - -When the user rewraps a tripple quote pair to the other pair -type (i.e. ''' to \") we check if the old pair was a -tripple-quote pair and if so add two pairs to beg/end of the -newly formed pair (which was a single-quote \"...\" pair)." - (when (eq action 'rewrap-sexp) - (let ((old (plist-get sp-handler-context :parent))) - (when (or (and (equal old "'''") (equal id "\"")) - (and (equal old "\"\"\"") (equal id "'"))) - (save-excursion - (sp-get sp-last-wrapped-region - (goto-char :end-in) - (insert (make-string 2 (aref id 0))) - (goto-char :beg) - (insert (make-string 2 (aref id 0))))))))) - -(defadvice python-indent-dedent-line-backspace - (around sp-backward-delete-char-advice activate) - "Fix indend." - (if smartparens-strict-mode - (cl-letf (((symbol-function 'delete-backward-char) - (lambda (arg &optional killp) - (sp-backward-delete-char arg)))) - ad-do-it) - ad-do-it)) - -(provide 'smartparens-python) -;;; smartparens-python.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-racket.el b/elpa/smartparens-20220623.1523/smartparens-racket.el deleted file mode 100644 index 08af6760..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-racket.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; smartparens-racket.el --- Additional configuration for Racket based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015 Vikraman Choudhury - -;; Author: Vikraman Choudhury -;; Maintainer: Vikraman Choudhury -;; Created: 26 Oct 2015 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Racket based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-racket) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(sp-with-modes '(racket-mode racket-repl-mode) - (sp-local-pair "`" nil :actions nil) - (sp-local-pair "'" nil :actions nil) - (sp-local-pair "#|" "|#")) - -(provide 'smartparens-racket) -;;; smartparens-racket.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-rst.el b/elpa/smartparens-20220623.1523/smartparens-rst.el deleted file mode 100644 index ceac6a63..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-rst.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; smartparens-rst.el --- Additional configuration for rst based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 28th January 2019 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for rst based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-rst) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) -(require 'smartparens-text) -(require 'smartparens-markdown) - -(defun sp-rst-point-after-backtick (_id action _context) - (when (eq action 'insert) - (sp--looking-back-p "`_"))) - -(sp-with-modes 'rst-mode - (sp-local-pair "*" "*" - :unless '(sp--gfm-point-after-word-p sp-point-at-bol-p) - :post-handlers '(("[d1]" "SPC")) - :skip-match 'sp--gfm-skip-asterisk) - (sp-local-pair "**" "**") - (sp-local-pair "_" "_" :unless '(sp-point-after-word-p sp-rst-point-after-backtick)) - (sp-local-pair "``" "``")) - -(provide 'smartparens-rst) -;;; smartparens-rst.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-ruby.el b/elpa/smartparens-20220623.1523/smartparens-ruby.el deleted file mode 100644 index 3ba86716..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-ruby.el +++ /dev/null @@ -1,411 +0,0 @@ -;;; smartparens-ruby.el --- Additional configuration for Ruby based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2014 Jean-Louis Giordano - -;; Author: Jean-Louis Giordano -;; Maintainer: Matus Goljer -;; Created: 16 June 2013 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Ruby based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-ruby) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(declare-function enh-ruby-forward-sexp "ruby") -(declare-function ruby-forward-sexp "ruby") -(declare-function enh-ruby-backward-sexp "ruby") -(declare-function ruby-backward-sexp "ruby") - -(defun sp-ruby-forward-sexp () - "Wrapper for `ruby-forward-sexp' based on `enh-ruby-mode'." - (interactive) - (if (boundp 'enh-ruby-forward-sexp) - (enh-ruby-forward-sexp) - (ruby-forward-sexp))) - -(defun sp-ruby-backward-sexp () - "Wrapper for `ruby-backward-sexp' based on `enh-ruby-mode'." - (interactive) - (if (boundp 'enh-ruby-backward-sexp) - (enh-ruby-backward-sexp) - (ruby-backward-sexp))) - -(defun sp-ruby-maybe-one-space () - "Turn whitespace around point to just one space." - (while (looking-back " " nil) (backward-char)) - (when (or (looking-at-p " ") - (looking-at-p "}") - (looking-back "{" nil) - (and (looking-at-p "\\sw") - (looking-back ":" nil))) - (save-excursion (just-one-space))) - (when (and (not (looking-back "^.?" nil)) - (save-excursion - (backward-char 2) - (or (looking-at-p ".[^:] [.([,;]") - (looking-at-p ".. ::") - (looking-at-p ".[.@$] ") - (looking-at-p ":: ")))) - (delete-char 1))) - -(defun sp-ruby-delete-indentation (&optional arg) - "Better way of joining ruby lines. - -ARG is how many indentation to delete." - (delete-indentation arg) - (sp-ruby-maybe-one-space)) - -(defun sp-ruby-block-post-handler (id action context) - "Handler for ruby block-like insertions. -ID, ACTION, CONTEXT." - (when (equal action 'insert) - (save-excursion - (newline) - (indent-according-to-mode)) - (indent-according-to-mode)) - (sp-ruby-post-handler id action context)) - -(defun sp-ruby-def-post-handler (id action context) - "Handler for ruby def-like insertions. -ID, ACTION, CONTEXT." - (when (equal action 'insert) - (save-excursion - (insert "x") - (newline) - (indent-according-to-mode)) - (delete-char 1)) - (sp-ruby-post-handler id action context)) - -(defun sp-ruby-post-handler (_id action _context) - "Ruby post handler. -ID, ACTION, CONTEXT." - (-let (((&plist :arg arg :enc enc) sp-handler-context)) - (when (equal action 'barf-backward) - (sp-ruby-delete-indentation 1) - (indent-according-to-mode) - (save-excursion - (sp-backward-sexp) ; move to begining of current sexp - (sp-backward-sexp arg) - (sp-ruby-maybe-one-space))) - - (when (equal action 'barf-forward) - (sp-get enc - (let ((beg-line (line-number-at-pos :beg-in))) - (sp-forward-sexp arg) - (sp-ruby-maybe-one-space) - (when (not (= (line-number-at-pos) beg-line)) - (sp-ruby-delete-indentation -1)) - (indent-according-to-mode)))))) - -(defun sp-ruby-pre-handler (_id action _context) - "Handler for ruby slurp and barf. -ID, ACTION, CONTEXT." - (let ((enc (plist-get sp-handler-context :enc))) - (sp-get enc - (let ((beg-line (line-number-at-pos :beg-in)) - (end-line (line-number-at-pos :end-in))) - - (when (equal action 'slurp-backward) - (save-excursion - (sp-forward-sexp) - (when (looking-at-p ";") (forward-char)) - (sp-ruby-maybe-one-space) - (when (not (= (line-number-at-pos) end-line)) - (sp-ruby-delete-indentation -1))) - (when (looking-at-p "::") - (while (and (looking-back "\\sw" nil) - (--when-let (sp-get-symbol t) - (sp-get it (goto-char :beg-prf)))))) - (while (thing-at-point-looking-at "\\.[[:blank:]\n]*") - (sp-backward-sexp)) - (when (looking-back "[@$:&?!]" nil) - (backward-char) - (when (looking-back "[@&:]" nil) - (backward-char))) - (just-one-space) - (save-excursion - (if (= (line-number-at-pos) end-line) - (insert " ") - (newline)))) - - (when (equal action 'barf-backward) - ;; Barf whole method chains - (while (thing-at-point-looking-at "[(.:[][\n[:blank:]]*") - (sp-forward-sexp)) - (if (looking-at-p " *$") - (newline) - (save-excursion (newline)))) - - (when (equal action 'slurp-forward) - (save-excursion - (sp-backward-sexp) - (when (looking-back "\." nil) (backward-char)) - (sp-ruby-maybe-one-space) - (when (not (= (line-number-at-pos) beg-line)) - (if (thing-at-point-looking-at "\\.[[:blank:]\n]*") - (progn - (forward-symbol -1) - (sp-ruby-delete-indentation -1)) - (sp-ruby-delete-indentation)))) - (while (looking-at-p "::") (sp-forward-symbol)) - (when (looking-at-p "[?!;]") (forward-char)) - (if (= (line-number-at-pos) beg-line) - (insert " ") - (newline))) - - (when (equal action 'barf-forward) - (when (looking-back "\\." nil) (backward-char)) - (when (looking-at-p "::") - (while (and (looking-back "\\sw" nil) - (--when-let (sp-get-symbol t) - (sp-get it (goto-char :beg-prf)))))) - (if (= (line-number-at-pos) end-line) - (insert " ") - (if (looking-back "^[[:blank:]]*" nil) - (save-excursion (newline)) - (newline)))))))) - -(defun sp-ruby-inline-p (id) - "Test if ID is inline." - (save-excursion - (when (looking-back id nil) - (backward-word)) - (when (not (or (looking-back "^[[:blank:]]*" nil) - (looking-back "= *" nil))) - (or (save-excursion - (forward-symbol -1) - (forward-symbol 1) - (looking-at-p (concat " *" id))) - (save-excursion - ;; This does not seem to make emacs snapshot happy - (ignore-errors - (sp-ruby-backward-sexp) - (sp-ruby-forward-sexp) - (looking-at-p (concat "[^[:blank:]]* *" id)))))))) - -(defun sp-ruby-method-p (id) - "Test if ID is a method." - (save-excursion - (when (looking-back id nil) - (backward-word)) - (and (looking-at-p id) - (or - ;; fix for def_foo - (looking-at-p (concat id "[_?!:]")) - ;; fix for foo_def - (looking-back "[_:@$.]" nil) - ;; fix for def for; end - (looking-back "def \\|class \\|module " nil) - ;; Check if multiline method call - ;; But beware of comments! - (and (looking-back "\\.[[:blank:]\n]*" nil) - (not (save-excursion - (search-backward ".") - (sp-point-in-comment)))))))) - -(defun sp-ruby-skip-inline-match-p (ms _mb _me) - "If non-nil, skip inline match. -MS, MB, ME." - (or (sp-ruby-method-p ms) - (sp-ruby-inline-p ms))) - -(defun sp-ruby-skip-method-p (ms _mb _me) - "If non-nil, skip method. -MS, MB, ME." - (sp-ruby-method-p ms)) - -(defun sp-ruby-in-string-or-word-p (id action context) - "Test if point is inside string or word. -ID, ACTION, CONTEXT." - (or (sp-in-string-p id action context) - (and (looking-back id nil) - (not (looking-back (sp--strict-regexp-quote id) nil))) - (sp-ruby-method-p id))) - -(defun sp-ruby-in-string-word-or-inline-p (id action context) - "Test if point is inside string, word or inline. -ID, ACTION, CONTEXT." - (or (sp-ruby-in-string-or-word-p id action context) - (and (looking-back id nil) - (sp-ruby-inline-p id)))) - -(defun sp-ruby-pre-pipe-handler (id action _context) - "Ruby pipe handler. -ID, ACTION, CONTEXT." - (when (equal action 'insert) - (save-excursion - (just-one-space)) - (save-excursion - (search-backward id) - (just-one-space)))) - -(defun sp-ruby-should-insert-pipe-close (id action _context) - "Test whether to insert the closing pipe for a lambda-binding pipe pair. -ID, ACTION, CONTEXT" - (if (eq action 'insert) - (thing-at-point-looking-at - (rx-to-string `(and (or "do" "{") (* space) ,id))) - t)) - -(defun sp--ruby-skip-match (ms me mb) - "Ruby skip match. -MS, ME, MB." - (when (string= ms "end") - (or (sp-in-string-p ms me mb) - (sp-ruby-method-p "end")))) - -(add-to-list 'sp-navigate-skip-match - '((ruby-mode enh-ruby-mode motion-mode) . sp--ruby-skip-match)) - -(dolist (mode '(ruby-mode motion-mode)) - (add-to-list 'sp-sexp-suffix `(,mode syntax ""))) - -(sp-with-modes '(ruby-mode enh-ruby-mode motion-mode) - (sp-local-pair "do" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-block-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "{" "}" - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-post-handler) - :suffix "") - - (sp-local-pair "begin" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-block-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "def" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "class" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "module" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "case" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-method-p - :suffix "") - - (sp-local-pair "for" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-inline-match-p) - - (sp-local-pair "if" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-inline-match-p - :suffix "") - - (sp-local-pair "unless" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-inline-match-p - :suffix "") - - (sp-local-pair "while" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-inline-match-p - :suffix "") - - (sp-local-pair "until" "end" - :when '(("SPC" "RET" "")) - :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) - :actions '(insert navigate) - :pre-handlers '(sp-ruby-pre-handler) - :post-handlers '(sp-ruby-def-post-handler) - :skip-match 'sp-ruby-skip-inline-match-p - :suffix "") - - (sp-local-pair "|" "|" - :when '(sp-ruby-should-insert-pipe-close) - :pre-handlers '(sp-ruby-pre-pipe-handler) - :suffix "")) - -(provide 'smartparens-ruby) - -;;; smartparens-ruby.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-rust.el b/elpa/smartparens-20220623.1523/smartparens-rust.el deleted file mode 100644 index e3f46ceb..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-rust.el +++ /dev/null @@ -1,142 +0,0 @@ -;;; smartparens-rust.el --- Additional configuration for Rust based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015 Wilfred Hughes - -;; Created: 3 November 2015 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Rust. To use -;; it, simply add: -;; -;; (require 'smartparens-config) -;; -;; alternatively, you can explicitly load these preferences: -;; -;; (require 'smartparens-rust) -;; -;; in your configuration. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: -(require 'smartparens) - -(declare-function rust-mode "rust-mode") -(declare-function rustic-mode "rustic-mode") - -(defun sp-in-rust-lifetime-context (&rest _args) - "Return t if point is in a Rust context where ' represents a lifetime. -If we return nil, ' should be used for character literals. -ARGS." - (or - (condition-case nil - ;; If point is just after a &', it's probably a &'foo. - (save-excursion - (backward-char 2) - (looking-at "&")) - ;; If we're at the beginning of the buffer, just carry on. - (beginning-of-buffer)) - ;; If point is inside < > it's probably a parameterised function. - (let ((paren-pos (nth 1 (syntax-ppss)))) - (and paren-pos - (save-excursion - (goto-char paren-pos) - (looking-at "<")))))) - -(defun sp-rust-skip-match-angle-bracket (_ms _mb me) - "Non-nil if we should ignore the bracket as valid delimiter." - (save-excursion - (goto-char me) - (let ((on-fn-return-type - (sp--looking-back-p (rx "->") nil)) - (on-match-branch - (sp--looking-back-p (rx "=>") nil)) - (on-comparison - (sp--looking-back-p (rx (or - (seq space "<") - (seq space ">") - (seq space "<<") - (seq space ">>"))) - nil))) - (or on-comparison on-fn-return-type on-match-branch)))) - -(defun sp-rust-filter-angle-brackets (_id action context) - "Non-nil if we should allow ID's ACTION in CONTEXT for angle brackets." - ;; See the docstring for `sp-pair' for the possible values of ID, - ;; ACTION and CONTEXT. - (cond - ;; Inside strings, don't do anything with < or >. - ((eq context 'string) - nil) - ;; Don't do any smart pairing inside comments either. - ((eq context 'comment) - nil) - ;; Otherwise, we're in code. - ((eq context 'code) - (let ((on-fn-return-type - (looking-back (rx "->") nil)) - (on-match-branch - (looking-back (rx "=>") nil)) - (on-comparison - (looking-back (rx (or - (seq space "<") - (seq space ">") - (seq space "<<") - (seq space ">>"))) - nil))) - (cond - ;; Only insert a matching > if we're not looking at a - ;; comparison. - ((eq action 'insert) - (and (not on-comparison) (not on-fn-return-type) (not on-match-branch))) - ;; Always allow wrapping in a pair if the region is active. - ((eq action 'wrap) - (not on-match-branch)) - ;; When pressing >, autoskip if we're not looking at a - ;; comparison. - ((eq action 'autoskip) - (and (not on-comparison) (not on-fn-return-type) (not on-match-branch))) - ;; Allow navigation, highlighting and strictness checks if it's - ;; not a comparison. - ((eq action 'navigate) - (and (not on-comparison) (not on-fn-return-type) (not on-match-branch)))))))) - -(sp-with-modes '(rust-mode rustic-mode) - (sp-local-pair "'" "'" - :unless '(sp-in-comment-p sp-in-string-quotes-p sp-in-rust-lifetime-context) - :post-handlers'(:rem sp-escape-quotes-after-insert)) - (sp-local-pair "<" ">" - :when '(sp-rust-filter-angle-brackets) - :skip-match 'sp-rust-skip-match-angle-bracket)) - -;; Rust has no sexp suffices. This fixes slurping -;; (|foo).bar -> (foo.bar) -(add-to-list 'sp-sexp-suffix (list #'rust-mode 'regexp "")) -(add-to-list 'sp-sexp-suffix (list #'rustic-mode 'regexp "")) - -(provide 'smartparens-rust) - -;;; smartparens-rust.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-scala.el b/elpa/smartparens-20220623.1523/smartparens-scala.el deleted file mode 100644 index 96f8c7ef..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-scala.el +++ /dev/null @@ -1,83 +0,0 @@ -;;; smartparens-scala.el --- Additional configuration for Scala based modes. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015 Greg Nwosu - -;; Author: Greg Nwosu -;; Maintainer: Greg Nwosu -;; Created: 8 July 2015 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Scala based -;; modes. To use it, simply add: -;; -;; (require 'smartparens-scala) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. -;; -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -;; Scala has no sexp suffices. This fixes slurping -;; import scala.mutable{|} ListBuffer, Set ---the comma should not travel with the closing -;; paren -(--each '(scala-mode inferior-scala-mode) - (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) - -(defun sp-scala-wrap-with-indented-newlines (_1 action _2) - "Post handler for the wrap ACTION, putting the region on indented newlines." - (when (eq action 'wrap) - (indent-for-tab-command) - (sp-get sp-last-wrapped-region - (let ((beg :beg-in) - (end :end-in)) - (save-excursion - (goto-char end) - (newline-and-indent)) - (save-excursion - (goto-char beg) - (newline)) - (indent-region beg end))))) - -(sp-local-pair 'scala-mode "(" nil - :post-handlers '(("||\n[i]" "RET") - ("| " "SPC"))) - -(sp-local-pair 'scala-mode "{" nil - :post-handlers '(("||\n[i]" "RET") - ("| " "SPC") - sp-scala-wrap-with-indented-newlines)) - -(sp-local-pair 'scala-mode "\"\"\"" "\"\"\"") - -(provide 'smartparens-scala) -;;; smartparens-scala.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-swift.el b/elpa/smartparens-20220623.1523/smartparens-swift.el deleted file mode 100644 index a1efab10..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-swift.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; smartparens-swift.el --- Additional configuration for Swift language buffers. -*- lexical-binding: t; -*- - -;; Copyright (C) 2015 Wilfred Hughes, -;; 2022 Josh Caswell - -;; Created: 4 April 2022 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for Swift. To use -;; it, simply add: -;; -;; (require 'smartparens-config) -;; -;; alternatively, you can explicitly load these preferences: -;; -;; (require 'smartparens-swift) -;; -;; in your configuration. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: -(require 'smartparens) - -(declare-function swift-mode "swift-mode") - -(defun sp-swift-skip-match-angle-bracket (_ms _mb me) - "Non-nil if we should ignore the bracket as valid delimiter." - (save-excursion - (goto-char me) - (let ((on-fn-return-type - (sp--looking-back-p (rx "->") nil)) - (on-range-operator - (sp--looking-back-p (rx "..<") nil)) - (on-comparison - (sp--looking-back-p (rx (or - (seq space "<") - (seq space ">") - (seq space "<<") - (seq space ">>"))) - nil))) - (or on-comparison on-fn-return-type on-range-operator)))) - -(defun sp-swift-filter-angle-brackets (_id action context) - "Non-nil if we should allow ID's ACTION in CONTEXT for angle brackets." - ;; See the docstring for `sp-pair' for the possible values of ID, - ;; ACTION and CONTEXT. - (cond - ;; Inside strings, don't do anything with < or >. - ((eq context 'string) - nil) - ((or (eq context 'comment) - (eq context 'code)) - (let ((on-fn-return-type - (looking-back (rx "->") nil)) - (on-range-operator - (looking-back (rx "..<") nil)) - (on-comparison - (looking-back (rx (or - (seq space "<") - (seq space ">") - (seq space "<<") - (seq space ">>"))) - nil))) - (cond - ;; Only insert a matching > if we're not looking at one of the operators. - ((eq action 'insert) - (and (not on-comparison) (not on-fn-return-type) (not on-range-operator))) - ;; Allow wrapping in a pair if the region is active and we're not on a - ;; range operator. - ((eq action 'wrap) - (not on-range-operator)) - ;; When pressing >, autoskip if we're not looking at one of the - ;; operators. - ((eq action 'autoskip) - (and (not on-comparison) (not on-fn-return-type) (not on-range-operator))) - ;; Allow navigation, highlighting and strictness checks if it's - ;; not one of the operators. - ((eq action 'navigate) - (and (not on-comparison) (not on-fn-return-type) (not on-range-operator)))))))) - -(sp-with-modes '(swift-mode) - (sp-local-pair "<" ">" - :when '(sp-swift-filter-angle-brackets) - :skip-match 'sp-swift-skip-match-angle-bracket) - (sp-local-pair "\"\"\"" "\"\"\"")) - -;; Swift has no sexp suffices. This fixes slurping -;; (|foo).bar -> (foo.bar) -(add-to-list 'sp-sexp-suffix (list #'swift-mode 'regexp "")) - -(provide 'smartparens-swift) - -;;; smartparens-swift.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens-text.el b/elpa/smartparens-20220623.1523/smartparens-text.el deleted file mode 100644 index 91c07be1..00000000 --- a/elpa/smartparens-20220623.1523/smartparens-text.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; smartparens-latex.el --- Additional configuration for text-mode. -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 16 July 2017 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; This file provides some additional configuration for `text-mode'. -;; To use it, simply add: -;; -;; (require 'smartparens-text) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. - -;; If you have good ideas about what should be added please file an -;; issue on the github tracker. - -;; For more info, see github readme at -;; https://github.com/Fuco1/smartparens - -;;; Code: - -(require 'smartparens) - -(defun sp-text-mode-emoticon-p (_id action _context) - (when (memq action '(insert navigate)) - (sp--looking-back-p ":-?[()]" 3))) - -(defun sp-text-mode-skip-emoticon (ms mb _me) - (when (member ms '("(" ")")) - (save-excursion - (goto-char mb) - (sp--looking-back-p ":-?" 2)))) - -(sp-local-pair 'text-mode "(" nil - :unless '(:add sp-text-mode-emoticon-p) - :skip-match 'sp-text-mode-skip-emoticon) - -(provide 'smartparens-text) -;;; smartparens-text.el ends here diff --git a/elpa/smartparens-20220623.1523/smartparens.el b/elpa/smartparens-20220623.1523/smartparens.el deleted file mode 100644 index fd580645..00000000 --- a/elpa/smartparens-20220623.1523/smartparens.el +++ /dev/null @@ -1,9667 +0,0 @@ -;;; smartparens.el --- Automatic insertion, wrapping and paredit-like navigation with user defined pairs. -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2016 Matus Goljer - -;; Author: Matus Goljer -;; Maintainer: Matus Goljer -;; Created: 17 Nov 2012 -;; Keywords: abbrev convenience editing -;; URL: https://github.com/Fuco1/smartparens - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This file is part of Smartparens. - -;; Smartparens 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. - -;; Smartparens 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 Smartparens. If not, see . - -;;; Commentary: - -;; Smartparens is minor mode for Emacs that deals with parens pairs -;; and tries to be smart about it. It started as a unification effort -;; to combine functionality of several existing packages in a single, -;; compatible and extensible way to deal with parentheses, delimiters, -;; tags and the like. Some of these packages include autopair, -;; textmate, wrap-region, electric-pair-mode, paredit and others. With -;; the basic features found in other packages it also brings many -;; improvements as well as completely new features. - -;; For a basic overview, see github readme at -;; https://github.com/Fuco1/smartparens - -;; For the complete documentation visit the documentation wiki located -;; at https://github.com/Fuco1/smartparens/wiki - -;; If you like this project, you can donate here: -;; https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=CEYP5YVHDRX8C - -;;; Code: - -(eval-when-compile - (require 'subr-x) ; for `string-trim' - (require 'cl-lib)) - -(require 'dash) -(require 'thingatpt) -(require 'help-mode) ;; for help-xref-following #85 - -(declare-function cua-replace-region "cua-base") ; FIXME: remove this when we drop support for old emacs -(declare-function cua-delete-region "cua-base") -(declare-function cua--fallback "cua-base") -(declare-function package-version-join "package") -(declare-function package-desc-version "package") - -(declare-function subword-kill "subword") -(declare-function subword-forward "subword") -(declare-function subword-backward "subword") - -(declare-function hungry-delete-backward "hungry-delete") -(declare-function hungry-delete-forward "hungry-delete") - -(declare-function evil-get-register "evil-common") -(declare-function evil-set-register "evil-common") -(eval-when-compile - (defvar evil-this-register) - (defvar package-alist) - (defvar sp-autoskip-closing-pair) - (defvar sp-show-enclosing-pair-commands) - (defvar show-smartparens-mode)) - - -;;; backport for older emacsen - -;; introduced in 24.3 -(unless (fboundp 'defvar-local) - (defmacro defvar-local (var val &optional docstring) - "Define VAR as a buffer-local variable with default value VAL. -Like `defvar' but additionally marks the variable as being automatically -buffer-local wherever it is set." - (declare (debug defvar) (doc-string 3)) - ;; Can't use backquote here, it's too early in the bootstrap. - (list 'progn (list 'defvar var val docstring) - (list 'make-variable-buffer-local (list 'quote var))))) - -;;;###autoload -(defun sp-cheat-sheet (&optional arg) - "Generate a cheat sheet of all the smartparens interactive functions. - -Without a prefix argument, print only the short documentation and examples. - -With non-nil prefix argument ARG, show the full documentation for each function. - -You can follow the links to the function or variable help page. -To get back to the full list, use \\[help-go-back]. - -You can use `beginning-of-defun' and `end-of-defun' to jump to -the previous/next entry. - -Examples are fontified using the `font-lock-string-face' for -better orientation." - (interactive "P") - (setq arg (not arg)) - (let ((do-not-display '( - smartparens-mode - smartparens-global-mode - turn-on-smartparens-mode - turn-off-smartparens-mode - sp-wrap-cancel - sp-remove-active-pair-overlay - sp-splice-sexp-killing-around ;; is aliased to `sp-raise-sexp' - show-smartparens-mode - show-smartparens-global-mode - turn-on-show-smartparens-mode - turn-off-show-smartparens-mode - )) - (do-not-display-with-arg '( - sp-use-paredit-bindings - sp-use-smartparens-bindings - )) - (commands (cl-loop for i in (cdr - (assoc-string - (file-truename (locate-library "smartparens")) - (--map (cons (file-truename (car it)) (cdr it)) - load-history))) - if (and (consp i) (eq (car i) 'defun) (commandp (cdr i))) - collect (cdr i)))) - (with-current-buffer (get-buffer-create "*Smartparens cheat sheet*") - (let ((standard-output (current-buffer)) - (help-xref-following t)) - (read-only-mode -1) - (erase-buffer) - (help-mode) - (smartparens-mode 1) - (help-setup-xref (list #'sp-cheat-sheet) - (called-interactively-p 'interactive)) - (read-only-mode -1) - (--each (--remove (or (memq it do-not-display) - (and arg (memq it do-not-display-with-arg))) - commands) - (unless (equal (symbol-name it) "advice-compilation") - (let ((start (point)) kill-from) - (insert (propertize (symbol-name it) 'face 'font-lock-function-name-face)) - (insert " is ") - (describe-function-1 it) - (save-excursion - (when arg - (goto-char start) - (forward-paragraph 1) - (forward-line 1) - (if (looking-at "^It is bound") - (forward-paragraph 2) - (forward-paragraph 1)) - (setq kill-from (point)) - (when (re-search-forward "^Examples:" nil t) - (delete-region kill-from - (save-excursion - (forward-line 1) - (point)))))) - (insert (propertize (concat - "\n\n" - (make-string 72 ?―) - "\n\n") 'face 'font-lock-function-name-face))))) - (goto-char (point-min)) - (while (re-search-forward "\\(->\\|​\\)" nil t) - (let ((thing (bounds-of-thing-at-point 'line))) - (put-text-property (car thing) (cdr thing) 'face 'font-lock-string-face))) - (goto-char (point-min)) - (while (re-search-forward "|" nil t) - (put-text-property (1- (point)) (point) 'face 'font-lock-warning-face)) - (goto-char (point-min)) - (while (re-search-forward "^It is bound to \\(.*?\\)\\." nil t) - (put-text-property (match-beginning 1) (match-end 1) 'face 'font-lock-keyword-face)) - (goto-char (point-min)) - (while (re-search-forward ";;.*?$" nil t) - (put-text-property (match-beginning 0) (match-end 0) 'face 'font-lock-comment-face)) - (help-make-xrefs) - (goto-char (point-min)))) - (pop-to-buffer "*Smartparens cheat sheet*"))) - -(defun sp-describe-system (starterkit) - "Describe user's system. - -The output of this function can be used in bug reports." - (interactive - (list (completing-read "Starterkit/Distribution used: " - (list - "Spacemacs" - "Evil" - "Vanilla" - )))) - (let ((text (format "- `smartparens` version: %s -- Active `major-mode`: `%s` -- Smartparens strict mode: %s -- Emacs version (`M-x emacs-version`): %s -- Starterkit/Distribution: %s -- OS: %s" - (--if-let (cadr (assoc 'smartparens package-alist)) - (package-version-join (package-desc-version it)) - "") - (symbol-name major-mode) - (bound-and-true-p smartparens-strict-mode) - (replace-regexp-in-string "\n" "" (emacs-version)) - starterkit - (symbol-name system-type)))) - (pop-to-buffer - (with-current-buffer (get-buffer-create "*sp-describe-system*") - (erase-buffer) - (insert "The content of the buffer underneath the line was -copied to your clipboard. You can also edit it in this buffer -and then copy the results manually. ------------------------------------------------- -") - (insert text) - (current-buffer))) - (kill-new text))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables - -(defvar-local sp-forward-bound-fn nil - "Function to restrict the forward search") - -(defvar-local sp-backward-bound-fn nil - "Function to restrict the backward search") - -(defun sp--get-forward-bound () - "Get the bound to limit the forward search for looking for pairs. - -If it returns nil, the original bound passed to the search -function will be considered." - (and sp-forward-bound-fn (funcall sp-forward-bound-fn))) - -(defun sp--get-backward-bound () - "Get the bound to limit the backward search for looking for pairs. - -If it returns nil, the original bound passed to the search -function will be considered." - (and sp-backward-bound-fn (funcall sp-backward-bound-fn))) - - -(defvaralias 'sp-keymap 'smartparens-mode-map) -(make-obsolete-variable 'sp-keymap 'smartparens-mode-map "2015-01-01") - -;;;###autoload -(defvar smartparens-mode-map (make-sparse-keymap) - "Keymap used for `smartparens-mode'.") - -(defvar sp-paredit-bindings '( - ("C-M-f" . sp-forward-sexp) ;; navigation - ("C-M-b" . sp-backward-sexp) - ("C-M-u" . sp-backward-up-sexp) - ("C-M-d" . sp-down-sexp) - ("C-M-p" . sp-backward-down-sexp) - ("C-M-n" . sp-up-sexp) - ("M-s" . sp-splice-sexp) ;; depth-changing commands - ("M-" . sp-splice-sexp-killing-backward) - ("M-" . sp-splice-sexp-killing-forward) - ("M-r" . sp-splice-sexp-killing-around) - ("M-(" . sp-wrap-round) - ("C-)" . sp-forward-slurp-sexp) ;; barf/slurp - ("C-" . sp-forward-slurp-sexp) - ("C-}" . sp-forward-barf-sexp) - ("C-" . sp-forward-barf-sexp) - ("C-(" . sp-backward-slurp-sexp) - ("C-M-" . sp-backward-slurp-sexp) - ("C-{" . sp-backward-barf-sexp) - ("C-M-" . sp-backward-barf-sexp) - ("M-S" . sp-split-sexp) ;; misc - ("M-j" . sp-join-sexp) - ("M-?" . sp-convolute-sexp) - ) - "Paredit inspired bindings. - -Alist containing the default paredit bindings to corresponding -smartparens functions.") - -(defun sp--populate-keymap (bindings) - "Populates the `smartparens-mode-map' from the BINDINGS alist." - (--each bindings - (define-key smartparens-mode-map (read-kbd-macro (car it)) (cdr it)))) - -;;;###autoload -(defun sp-use-paredit-bindings () - "Initiate `smartparens-mode-map' with `sp-paredit-bindings'." - (interactive) - (sp--populate-keymap sp-paredit-bindings)) - -(defvar sp-smartparens-bindings '( - ("C-M-f" . sp-forward-sexp) - ("C-M-b" . sp-backward-sexp) - ("C-M-d" . sp-down-sexp) - ("C-M-a" . sp-backward-down-sexp) - ("C-S-d" . sp-beginning-of-sexp) - ("C-S-a" . sp-end-of-sexp) - ("C-M-e" . sp-up-sexp) - ("C-M-u" . sp-backward-up-sexp) - ("C-M-n" . sp-next-sexp) - ("C-M-p" . sp-previous-sexp) - ("C-M-k" . sp-kill-sexp) - ("C-M-w" . sp-copy-sexp) - ("M-" . sp-unwrap-sexp) - ("M-" . sp-backward-unwrap-sexp) - ("C-" . sp-forward-slurp-sexp) - ("C-" . sp-forward-barf-sexp) - ("C-M-" . sp-backward-slurp-sexp) - ("C-M-" . sp-backward-barf-sexp) - ("M-D" . sp-splice-sexp) - ("C-M-" . sp-splice-sexp-killing-forward) - ("C-M-" . sp-splice-sexp-killing-backward) - ("C-S-" . sp-splice-sexp-killing-around) - ("C-]" . sp-select-next-thing-exchange) - ("C-M-]" . sp-select-next-thing) - ("C-M-SPC" . sp-mark-sexp) - ("M-F" . sp-forward-symbol) - ("M-B" . sp-backward-symbol) - ) - "Alist containing the default smartparens bindings.") - -;;;###autoload -(defun sp-use-smartparens-bindings () - "Initiate `smartparens-mode-map' with `sp-smartparens-bindings'." - (interactive) - (sp--populate-keymap sp-smartparens-bindings)) - -(defun sp--set-base-key-bindings (&optional symbol value) - "Set up the default keymap based on `sp-base-key-bindings'. - -SYMBOL is the symbol being set, that is `sp-base-key-bindings'. - -VALUE is the saved value (as a symbol), can be one of: -- sp -- paredit - -This function is also used as a setter for this customize value." - (when symbol (set-default symbol value)) - (cond - ((eq value 'sp) - (sp-use-smartparens-bindings)) - ((eq value 'paredit) - (sp-use-paredit-bindings)))) - -(defun sp--update-override-key-bindings (&optional symbol value) - "Override the key bindings with values from `sp-override-key-bindings'. - -SYMBOL is `sp-override-key-bindings', VALUE is the value being set. - -This function is also used as a setter for this customize value." - (when symbol (set-default symbol value)) - ;; this also needs to reload the base set, if any is present. - (sp--set-base-key-bindings) - (sp--populate-keymap value)) - -(defcustom sp-base-key-bindings nil - "A default set of key bindings for commands provided by smartparens. - -Paredit binding adds the bindings in `sp-paredit-bindings' to the -corresponding smartparens commands. It does not add bindings to -any other commands, or commands that do not have a paredit -counterpart. - -Smartparens binding adds the bindings in -`sp-smartparens-bindings' to most common smartparens commands. -These are somewhat inspired by paredit, but in many cases differ. - -Note that neither \"paredit\" nor \"smartparens\" bindings add a -binding for all the provided commands." - :type '(radio - (const :tag "Don't use any default set of bindings" nil) - (const :tag "Use smartparens set of bindings" sp) - (const :tag "Use paredit set of bindings" paredit)) - :set 'sp--set-base-key-bindings - :group 'smartparens) - -(defcustom sp-override-key-bindings nil - "An alist of bindings and commands that should override the base key set. - -If you wish to override a binding from the base set, set the -value for the binding to the `kbd' recognizable string constant -and command to the command symbol you wish to bind there. - -If you wish to disable a binding from the base set, set the value -for the command to nil. - -Examples: - (\"C-M-f\" . sp-forward-sexp) - (\"C-\" . nil) - -See `sp-base-key-bindings'." - :type '(alist - :key-type string - :value-type symbol) - :set 'sp--update-override-key-bindings - :group 'smartparens) - -(defvar-local sp-escape-char nil - "Character used to escape quotes inside strings.") - -(defvar-local sp-comment-char nil - "Character used to start comments.") - -(defvar-local sp-pair-list nil - "List of pairs for autoinsertion or wrapping. - -Maximum length of opening or closing pair is -`sp-max-pair-length' characters.") - -(defvar-local sp-local-pairs nil - "List of pair definitions used for current buffer.") - -(defvar-local sp-last-operation nil - "Symbol holding the last successful operation.") - -(cl-defstruct sp-state - "Smartparens state for the current buffer." - ;; A "counter" to track delayed hook. When a pair is inserted, a - ;; cons of the form (:next . pair) is stored. On the next - ;; (immediately after insertion) invocation of post-command-hook, it - ;; is changed to (:this . pair). When the `car' is :this, the - ;; post-command-hook checks the delayed hooks for `pair' and - ;; executes them, then reset the "counter". - delayed-hook - ;; TODO - delayed-insertion - ;; The last point checked by sp--syntax-ppss and its result, used for - ;; memoization - last-syntax-ppss-point ;; a list (point point-min point-max) - last-syntax-ppss-result - ;; Value of `sp-pair-list' for this buffer. Note that this might - ;; differ from `sp-pair-list' which is often changed by dynamic - ;; binding - pair-list - ;; Value of `sp-local-pairs' for this buffer. Note that this might - ;; differ from `sp-local-pairs' which is often changed by dynamic - ;; binding - local-pairs - ) - -(defvar-local sp-state (make-sp-state) - "Smartparens state for the current buffer.") - -;; TODO: get rid of this -(defvar-local sp-previous-point -1 - "Location of point before last command. - -This is only updated when some pair-overlay is active. Do not -rely on the value of this variable anywhere else!") - -;; TODO: get rid of this -(defvar-local sp-wrap-point nil - "Save the value of point before attemt to wrap a region. - -Used for restoring the original state if the wrapping is -cancelled.") - -;; TODO: get rid of this -(defvar-local sp-wrap-mark nil - "Save the value of mark before attemt to wrap a region. - -Used for restoring the original state if the wrapping is -cancelled.") - -(defvar-local sp-last-inserted-characters "" - "Characters typed during the wrapping selection. - -If wrapping is cancelled, these characters are re-inserted to the -location of point before the wrapping.") - -(defvar-local sp-last-inserted-pair nil - "Last inserted pair.") - -(defvar-local sp-delayed-pair nil - "The pair whose insertion is being delayed. - -The insertion of this pair is delayed to be carried out in -`sp--post-command-hook-handler'. The format is (opening delim -. beg of the opening delim)") - -(defvar-local sp-last-wrapped-region nil - "Information about the last wrapped region. -The format is the same as returned by `sp-get-sexp'.") - -(defvar sp-point-inside-string nil - "Non-nil if point is inside a string. - -Used to remember the state from before `self-insert-command' is -run.") - -(defvar sp-buffer-modified-p nil - "Non-nil if buffer was modified before `pre-command-hook'.") - -(defvar sp-pre-command-point nil - "Position of `point' before `this-command' gets executed.") - -(defconst sp-max-pair-length 10 - "Maximum length of an opening or closing delimiter. - -Only the pairs defined by `sp-pair' are considered. Tag pairs -can be of any length.") - -(defconst sp-max-prefix-length 100 - "Maximum length of a pair prefix. - -Because prefixes for pairs can be specified using regular -expressions, they can potentially be of arbitrary length. This -settings solves the problem where the parser would decide to -backtrack the entire buffer which would lock up Emacs.") - -(defvar sp-pairs - '((t - . - ((:open "\\\\(" :close "\\\\)" :actions (insert wrap autoskip navigate)) - (:open "\\{" :close "\\}" :actions (insert wrap autoskip navigate)) - (:open "\\(" :close "\\)" :actions (insert wrap autoskip navigate)) - (:open "\\\"" :close "\\\"" :actions (insert wrap autoskip navigate)) - (:open "\"" :close "\"" - :actions (insert wrap autoskip navigate escape) - :unless (sp-in-string-quotes-p) - :post-handlers (sp-escape-wrapped-region sp-escape-quotes-after-insert)) - (:open "'" :close "'" - :actions (insert wrap autoskip navigate escape) - :unless (sp-in-string-quotes-p sp-point-after-word-p) - :post-handlers (sp-escape-wrapped-region sp-escape-quotes-after-insert)) - (:open "(" :close ")" :actions (insert wrap autoskip navigate)) - (:open "[" :close "]" :actions (insert wrap autoskip navigate)) - (:open "{" :close "}" :actions (insert wrap autoskip navigate)) - (:open "`" :close "`" :actions (insert wrap autoskip navigate))))) - "List of pair definitions. - -Maximum length of opening or closing pair is -`sp-max-pair-length' characters.") - -(defvar sp-tags nil - "List of tag definitions. See `sp-local-tag' for more information.") - -(defvar sp-prefix-tag-object nil - "If non-nil, only consider tags while searching for next thing.") - -(defvar sp-prefix-pair-object nil - "If non-nil, only consider pairs while searching for next thing. - -Pairs are defined as expressions delimited by pairs from -`sp-pair-list'.") - -(defvar sp-prefix-symbol-object nil - "If non-nil, only consider symbols while searching for next thing. - -Symbol is defined as a chunk of text recognized by -`sp-forward-symbol'.") - -(define-obsolete-variable-alias 'sp--lisp-modes 'sp-lisp-modes "2015-11-08") - -(defcustom sp-lisp-modes '( - cider-repl-mode - clojure-mode - clojurec-mode - clojurescript-mode - clojurex-mode - common-lisp-mode - emacs-lisp-mode - eshell-mode - fennel-mode - fennel-repl-mode - geiser-repl-mode - gerbil-mode - inf-clojure-mode - inferior-emacs-lisp-mode - inferior-lisp-mode - inferior-scheme-mode - lisp-interaction-mode - lisp-mode - monroe-mode - racket-mode - racket-repl-mode - scheme-interaction-mode - scheme-mode - slime-repl-mode - sly-mrepl-mode - stumpwm-mode - ) - "List of Lisp-related modes." - :type '(repeat symbol) - :group 'smartparens) - -(defcustom sp-clojure-modes '( - cider-repl-mode - clojure-mode - clojurec-mode - clojurescript-mode - clojurex-mode - inf-clojure-mode - ) - "List of Clojure-related modes." - :type '(repeat symbol) - :group 'smartparens) - -(defcustom sp-c-modes '( - c-mode - c++-mode - ) - "List of C-related modes." - :type '(repeat symbol) - :group 'smartparens) - -(defcustom sp-no-reindent-after-kill-modes '( - python-mode - coffee-mode - asm-mode - makefile-gmake-mode - haml-mode - ) - "List of modes that should not reindent after kill." - :type '(repeat symbol) - :group 'smartparens) - -(defcustom sp-no-reindent-after-kill-indent-line-functions - '( - insert-tab - ) - "List of `indent-line-function's that should not reindent after kill." - :type '(repeat symbol) - :group 'smartparens) - -(defvar sp--html-modes '( - sgml-mode - html-mode - rhtml-mode - nxhtml-mode - nxml-mode - web-mode - jinja2-mode - html-erb-mode - js-jsx-mode - js2-jsx-mode - rjsx-mode - ) - "List of HTML modes.") - -(defvar sp-message-alist - '((:unmatched-expression - "Search failed: there is an unmatched expression somewhere or we are at the beginning/end of file" - "Unmatched expression") - (:unbalanced-region - "Can not kill the region: the buffer would end up in an unbalanced state after deleting the active region" - "Killing the region would make the buffer unbalanced" - "Unbalanced region") - (:delimiter-in-string - "Ignored: opening or closing pair is inside a string or comment and matching pair is outside (or vice versa)") - (:no-matching-tag - "Search failed: no matching tag found" - "No matching tag") - (:invalid-context-prev - "Invalid context: previous h-sexp ends after the next one" - "Invalid context") - (:invalid-context-cur - "Invalid context: current h-sexp starts after the next one" - "Invalid context") - (:no-structure-found - "Previous sexp starts after current h-sexp or no structure was found" - "No valid structure found") - (:invalid-structure - "Ignored: this operation would result in invalid structure" - "Ignored because of invalid structure") - (:cant-slurp - "Ignored: we can not slurp without breaking strictly balanced expression" - "Can not slurp without breaking balance") - (:cant-slurp-context - "Ignored: we can not slurp into different context (comment -> code)" - "Can not slurp into different context") - (:cant-insert-closing-delimiter - "We can not insert unbalanced closing delimiter in strict mode" - "Can not insert unbalanced delimiter") - (:blank-sexp - "Point is in blank sexp, nothing to barf" - "Point is in blank sexp") - (:point-not-deep-enough - "Point has to be at least two levels deep to swap the enclosing delimiters" - "Point has to be at least two levels deep" - "Point not deep enough") - (:different-type - "The expressions to be joined are of different type" - "Expressions are of different type")) - "List of predefined messages to be displayed by `sp-message'. - -Each element is a list consisting of a keyword and one or more -strings, which are chosen based on the `sp-message-width' -variable. If the latter is t, the first string is chosen as -default, which should be the most verbose option available.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customize & Mode definitions - -(defgroup smartparens () - "Smartparens minor mode." - :group 'editing - :prefix "sp-") - -;;;###autoload -(define-minor-mode smartparens-mode - "Toggle smartparens mode. - -You can enable pre-set bindings by customizing -`sp-base-key-bindings' variable. The current content of -`smartparens-mode-map' is: - - \\{smartparens-mode-map}" - :init-value nil - :lighter (" SP" (:eval (if smartparens-strict-mode "/s" ""))) - :group 'smartparens - :keymap smartparens-mode-map - (if smartparens-mode - (progn - (sp--init) - (add-hook 'self-insert-uses-region-functions 'sp-wrap--can-wrap-p nil 'local) - (run-hooks 'smartparens-enabled-hook)) - (remove-hook 'self-insert-uses-region-functions 'sp-wrap--can-wrap-p 'local) - (run-hooks 'smartparens-disabled-hook))) - -(defvar smartparens-strict-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [remap delete-char] 'sp-delete-char) - (define-key map [remap delete-forward-char] 'sp-delete-char) - (define-key map [remap backward-delete-char-untabify] 'sp-backward-delete-char) - (define-key map [remap backward-delete-char] 'sp-backward-delete-char) - (define-key map [remap delete-backward-char] 'sp-backward-delete-char) - (define-key map [remap kill-word] 'sp-kill-word) - (define-key map [remap kill-line] 'sp-kill-hybrid-sexp) - (define-key map [remap backward-kill-word] 'sp-backward-kill-word) - (define-key map [remap kill-region] 'sp-kill-region) - (define-key map [remap delete-region] 'sp-delete-region) - (define-key map [remap kill-whole-line] 'sp-kill-whole-line) - map) - "Keymap used for `smartparens-strict-mode'.") - -;;;###autoload -(define-minor-mode smartparens-strict-mode - "Toggle the strict smartparens mode. - -When strict mode is active, `delete-char', `kill-word' and their -backward variants will skip over the pair delimiters in order to -keep the structure always valid (the same way as `paredit-mode' -does). This is accomplished by remapping them to -`sp-delete-char' and `sp-kill-word'. There is also function -`sp-kill-symbol' that deletes symbols instead of words, otherwise -working exactly the same (it is not bound to any key by default). - -When strict mode is active, this is indicated with \"/s\" -after the smartparens indicator in the mode list." - :init-value nil - :group 'smartparens - (if smartparens-strict-mode - (progn - (unless smartparens-mode - (smartparens-mode 1)) - (unless (assq 'smartparens-strict-mode minor-mode-overriding-map-alist) - (push `(smartparens-strict-mode . ,smartparens-strict-mode-map) - minor-mode-overriding-map-alist)) - (put 'sp-backward-delete-char 'delete-selection 'sp--delete-selection-supersede-p) - (put 'sp-delete-char 'delete-selection 'sp--delete-selection-supersede-p) - (add-hook 'self-insert-uses-region-functions 'sp--self-insert-uses-region-strict-p nil 'local) - (setq sp-autoskip-closing-pair 'always)) - (setq minor-mode-overriding-map-alist - (assq-delete-all 'smartparens-strict-mode minor-mode-overriding-map-alist)) - (put 'sp-backward-delete-char 'delete-selection 'supersede) - (put 'sp-delete-char 'delete-selection 'supersede) - (remove-hook 'self-insert-uses-region-functions 'sp--self-insert-uses-region-strict-p 'local) - (let ((std-val (car (plist-get (symbol-plist 'sp-autoskip-closing-pair) 'standard-value))) - (saved-val (car (plist-get (symbol-plist 'sp-autoskip-closing-pair) 'saved-value)))) - (setq sp-autoskip-closing-pair (eval (or saved-val std-val)))))) - -;;;###autoload -(define-globalized-minor-mode smartparens-global-strict-mode - smartparens-strict-mode - turn-on-smartparens-strict-mode - :group 'smartparens) - -(defcustom sp-ignore-modes-list '( - minibuffer-mode - minibuffer-inactive-mode - ) - "Modes where smartparens mode is inactive if allowed globally." - :type '(repeat symbol) - :group 'smartparens) - -;;;###autoload -(defun turn-on-smartparens-strict-mode () - "Turn on `smartparens-strict-mode'." - (interactive) - (unless (or (member major-mode sp-ignore-modes-list) - (and (not (derived-mode-p 'comint-mode)) - (eq (get major-mode 'mode-class) 'special))) - (smartparens-strict-mode 1))) - -;;;###autoload -(defun turn-off-smartparens-strict-mode () - "Turn off `smartparens-strict-mode'." - (interactive) - (smartparens-strict-mode -1)) - -(defun sp--init () - "Initialize the buffer local smartparens state. - - This includes pair bindings and other buffer local variables -that depend on the active `major-mode'." - (setq sp-state (make-sp-state)) - ;; setup local pair replacements - (sp--update-local-pairs) - ;; set the escape char - (dotimes (char 256) - (unless sp-escape-char - (when (= ?\\ (char-syntax char)) - (setq sp-escape-char (string char)))) - (unless sp-comment-char - (when (= ?< (char-syntax char)) - (setq sp-comment-char (string char))))) - ;; in case no escape syntax is found, just assume the backspace - (unless sp-escape-char (setq sp-escape-char "\\"))) - -(defun sp--maybe-init () - "Initialize the buffer if it is not already initialized. - -See `sp--init'." - (unless sp-pair-list - (sp--init))) - -(defun sp--remove-local-pair (open) - "Remove OPEN from `sp-local-pairs'." - (setq sp-local-pairs - (--remove (equal (plist-get it :open) open) - sp-local-pairs))) - -(defun sp--update-sp-pair-list () - "Update `sp-pair-list' according to current value of `sp-local-pairs'." - (setq sp-pair-list - (->> sp-local-pairs - (--map (cons (plist-get it :open) (plist-get it :close))) - (-sort (lambda (x y) (> (length (car x)) (length (car y)))))))) - -(defun sp--update-local-pairs () - "Update local pairs after change or at mode initialization. - -This commands load all the parent major mode definitions and -merges them into current buffer's `sp-local-pairs'." - ;; Combine all the definitions from the most ancient parent to the - ;; most recent parent - (-each (nreverse - (--unfold (when it - (cons it (get it 'derived-mode-parent))) - major-mode)) - #'sp-update-local-pairs)) - -(defun sp-update-local-pairs (configuration) - "Update `sp-local-pairs' with CONFIGURATION. - -The pairs are only updated in current buffer not in all buffers -with the same major mode! If you want to update all buffers of -the specific major-modes use `sp-local-pair'. - -CONFIGURATION can be a symbol to be looked up in `sp-pairs' or a -property list corresponding to the arguments of `sp-local-pair' -or a list of such property lists." - (setq sp-local-pairs - (cond - ((symbolp configuration) - (sp--merge-pair-configurations (cdr (assq configuration sp-pairs)))) - ((plist-member configuration :open) - (sp--merge-pair-configurations (list configuration))) - (t - (sp--merge-pair-configurations configuration)))) - - ;; Keep only those which have non-nil :actions - (setq sp-local-pairs (--filter (plist-get it :actions) sp-local-pairs)) - - ;; update the `sp-pair-list'. This is a list only containing - ;; (open.close) cons pairs for easier querying. We also must order - ;; it by length of opening delimiter in descending order (first - ;; value is the longest) - (sp--update-sp-pair-list) - (setf (sp-state-local-pairs sp-state) sp-local-pairs) - (setf (sp-state-pair-list sp-state) sp-pair-list)) - -(defmacro sp-with-buffers-using-mode (mode &rest body) - "Execute BODY in every existing buffer using `major-mode' MODE." - (declare (indent 1)) - `(--each (buffer-list) - (with-current-buffer it - (when (derived-mode-p ,mode) - ,@body)))) - -(defun sp--update-local-pairs-everywhere (&rest modes) - "Run `sp--update-local-pairs' in all buffers. - -This is necessary to update all the buffer-local definitions. If -MODES is non-nil, only update buffers with `major-mode' equal to -MODES." - (setq modes (-flatten modes)) - (--each (buffer-list) - (with-current-buffer it - (when (and smartparens-mode - (or (not modes) - (--any? (derived-mode-p it) modes))) - (sp--update-local-pairs))))) - -(defcustom smartparens-enabled-hook nil - "Called after `smartparens-mode' is turned on." - :type 'hook - :group 'smartparens) - -(defcustom smartparens-disabled-hook nil - "Called after `smartparens-mode' is turned off." - :type 'hook - :group 'smartparens) - -;;;###autoload -(define-globalized-minor-mode smartparens-global-mode - smartparens-mode - turn-on-smartparens-mode) - -;;;###autoload -(defun turn-on-smartparens-mode () - "Turn on `smartparens-mode'. - -This function is used to turn on `smartparens-global-mode'. - -By default `smartparens-global-mode' ignores buffers with -`mode-class' set to special, but only if they are also not comint -buffers. - -Additionally, buffers on `sp-ignore-modes-list' are ignored. - -You can still turn on smartparens in these mode manually (or -in mode's startup-hook etc.) by calling `smartparens-mode'." - (interactive) - (unless (or (member major-mode sp-ignore-modes-list) - (and (not (derived-mode-p 'comint-mode)) - (eq (get major-mode 'mode-class) 'special))) - (smartparens-mode t))) - -;;;###autoload -(defun turn-off-smartparens-mode () - "Turn off `smartparens-mode'." - (interactive) - (smartparens-mode -1)) - -;; insert custom -(defcustom sp-autoinsert-pair t - "If non-nil, autoinsert pairs. See `sp-insert-pair'." - :type 'boolean - :group 'smartparens) - -;; TODO: remove this in 1.12 -(defcustom sp-autoinsert-quote-if-followed-by-closing-pair nil - "If non-nil autoinsert quotes when the point is followed by closing delimiter. - -This option only changes behaviour of the insertion process if -point is inside a string. In other words, if string is not -closed and next character is a closing pair. - -For example, in a situation like this: - - [\"some text|] - -after pressing \", one would probably want to insert the closing -quote, not a nested pair (\\\"\\\"), to close the string literal -in the array. To enable such behaviour, set this variable to -nil. - -Note: the values of this varible seem to be backward, i.e. it is -\"enabled\" when the value is nil. This was an unfortunate -choice of wording. It is kept this way to preserve backward -compatibility. The intended meaning is \"insert the pair if -followed by closing pair?\", t = yes." - :type 'boolean - :group 'smartparens) -(make-obsolete-variable - 'sp-autoinsert-quote-if-followed-by-closing-pair - "the option was removed and no longer has any effect." "1.10") - -(defcustom sp-autoskip-closing-pair 'always-end - "Determine the behaviour when skipping closing delimiters. - -If t, skip the following closing pair if the expression is -active (that is right after insertion). This is controlled by -`sp-cancel-autoskip-on-backward-movement'. - -If set to \"always-end\", skip the closing pair even if the -expression is not active and point is at the end of the -expression. This only works for expressions with -single-character delimiters. - -If set to \"always\", `sp-up-sexp' is called whenever the closing -delimiter is typed inside a sexp of the same type. This is the -paredit-like behaviour. This setting only works for -single-character delimiters and does not work for string-like -delimiters. - -See `sp-autoskip-opening-pair' for similar setting for -string-like delimiters. - -See also `sp-skip-closing-pair'." - :type '(radio - (const :tag "Never skip closing delimiter" nil) - (const :tag "Skip closing delimiter in active expressions" t) - (const :tag "Always skip closing delimiter if at the end of sexp" always-end) - (const :tag "Always skip closing delimiter" always)) - :group 'smartparens) -(make-variable-buffer-local 'sp-autoskip-closing-pair) - -(defcustom sp-autoskip-opening-pair nil - "Determine the behaviour when skipping opening delimiters. - -If non-nil, skip into the following string-like expression -instead of inserting a new pair." - :type 'boolean - :group 'smartparens) -(make-variable-buffer-local 'sp-autoskip-opening-pair) - -;; TODO: rename to reflect what this actually does -(defcustom sp-cancel-autoskip-on-backward-movement t - "If non-nil, deactivate the active expression on backward movement. - -Note: the name of this variable is a historic coincidence and -will change in some future release to reflect its real purpose. - -See also `sp-skip-closing-pair'." - :type 'boolean - :group 'smartparens) - -;; delete custom -(defcustom sp-autodelete-pair t - "If non-nil, auto delete pairs. See `sp-delete-pair'." - :type 'boolean - :group 'smartparens) - -(defcustom sp-autodelete-closing-pair t - "If non-nil, auto delete the whole closing-pair. See `sp-delete-pair'." - :type 'boolean - :group 'smartparens) - -(defcustom sp-autodelete-opening-pair t - "If non-nil, auto delete the whole opening-pair. See `sp-delete-pair'." - :type 'boolean - :group 'smartparens) - -(defcustom sp-undo-pairs-separately nil - "If non-nil, put an `undo-boundary' before each inserted pair. - -Calling undo after smartparens complete a pair will remove only -the pair before undoing any previous insertion. - -WARNING: This option is implemented by hacking the -`buffer-undo-list'. Turning this option on might have -irreversible consequences on the buffer's undo information and in -some cases might remove important information. Usage of package -`undo-tree' is recommended if you ever need to revert to a state -unreachable by undo." - :type 'boolean - :group 'smartparens) - -(defcustom sp-successive-kill-preserve-whitespace 1 - "Control the behaviour of `sp-kill-sexp' on successive kills. - -In the description, we consider more than one space -\"superfluous\", however, newlines are preserved." - :type '(radio - (const :tag "Always preserve the whitespace" 0) - (const :tag "Remove superfluous whitespace after last kill" 1) - (const :tag "Remove superfluous whitespace after all kills" 2)) - :group 'smartparens) - -;; wrap custom -(defcustom sp-autowrap-region t - "If non-nil, wrap the active region with pair." - :type 'boolean - :group 'smartparens) - -(defcustom sp-wrap-show-possible-pairs t - "If non-nil, show possible pairs which can complete the wrapping." - :type 'boolean - :group 'smartparens) - -(defcustom sp-autodelete-wrap t - "If non-nil, autodelete opening and closing pair of most recent wrapping. - -Deletion command must be the very first command after the -insertion, otherwise normal behaviour is applied." - :type 'boolean - :group 'smartparens) - -(defcustom sp-wrap-repeat-last 1 - "Context in which smartparens repeats the last wrap. - -If the last operation was a wrap and we insert another pair at -the beginning or end of the last wrapped region, repeat the -wrap on this region with current pair." - :type '(radio - (const :tag "Do not repeat wrapping" 0) - (const :tag "Only repeat if current tag is the same as the last one" 1) - (const :tag "Always repeat if the point is after the opening/closing delimiter of last wrapped region" 2)) - :group 'smartparens) - -(defcustom sp-wrap-entire-symbol nil - "If non-nil, do NOT wrap the entire symbol, only the part after point. - -If set to \"Enable globally\", smart symbol wrapping is active -everywhere. This is the default option. - -If set to \"Disable globally\", smart symbol wrapping is disabled -everywhere. - -Otherwise, a list of major modes where smart symbol wrapping is -*disabled* can be supplied. - -Examples: - - foo-ba|r-baz -> (|foo-bar-baz) ;; if enabled - - foo-ba|r-baz -> foo-ba(|r-baz) ;; if disabled" - :type '(choice - (const :tag "Enable globally" nil) - (const :tag "Disable globally" globally) - (repeat :tag "Disable in these major modes" symbol)) - :group 'smartparens) - -(defcustom sp-wrap-from-point nil - "If non-nil, do not wrap from the beginning of next expression but from point. - -However, if the point is inside a symbol/word, the entire -symbol/word is wrapped. To customize this behaviour, see -variable `sp-wrap-entire-symbol'." - :type 'boolean - :group 'smartparens) - -(defcustom sp-wrap-respect-direction nil - "When non-nil respect the wrap direction. - -When non-nil, wrapping with opening pair always jumps to the -beginning of the region and wrapping with closing pair always -jumps to the end of the region. - - |fooM -> [ -> |[foo]M - Mfoo| -> [ -> |[foo]M - |fooM -> ] -> M[foo]| - Mfoo| -> ] -> M[foo]| - -When nil, closing pair places the point at the end of the region -and the opening pair leaves the point at its original -position (before or after the region). - - |fooM -> [ -> [|fooM] - Mfoo| -> [ -> M[foo]| - |fooM -> ] -> M[foo]| - Mfoo| -> ] -> M[foo]|" - :type 'boolean - :group 'smartparens) - -;; escaping custom -(defcustom sp-escape-wrapped-region t - "If non-nil, escape special chars inside the just wrapped region." - :type 'boolean - :group 'smartparens) - -(defcustom sp-escape-quotes-after-insert t - "If non-nil, escape string quotes if typed inside string." - :type 'boolean - :group 'smartparens) - -;; navigation & manip custom -(defcustom sp-navigate-consider-sgml-tags '( - html-mode - ) - "List of modes where sgml tags are considered to be sexps." - :type '(repeat symbol) - :group 'smartparens) - - -(defcustom sp-navigate-use-textmode-stringlike-parser '((derived . text-mode)) - "List of modes where textmode stringlike parser is used. - -See `sp-get-textmode-stringlike-expression'. - -Each element of the list can either be a symbol which is then -checked against `major-mode', or a cons (derived . PARENT-MODE), -where PARENT-MODE is checked using `derived-mode-p'." - :type '(repeat (choice - (symbol :tag "Major mode") - (cons :tag "Derived mode" - (const derived) - (symbol :tag "Parent major mode name")))) - :group 'smartparens) - -(defcustom sp-navigate-consider-symbols t - "If non-nil, consider symbols outside balanced expressions as such. - -Symbols are recognized by function `sp-forward-symbol'. This -setting affect all the navigation and manipulation functions -where it make sense. - -Also, special handling of strings is enabled, where the whole -string delimited with \"\" is considered as one token. - -WARNING: This is a legacy setting and changing its value to NIL -may break many things. It is kept only for backward -compatibility and will be removed in the next major release." - :type 'boolean - :group 'smartparens) - -(defcustom sp-navigate-comments-as-sexps t - "If non-nil, consider comments as sexps in `sp-get-enclosing-sexp'. - -If this option is enabled, unbalanced expressions in comments are -never automatically closed (see `sp-navigate-close-if-unbalanced')." - :type 'boolean - :group 'smartparens) - -;; TODO: add -alist suffix -(defcustom sp-navigate-skip-match `( - (,sp-lisp-modes . sp--elisp-skip-match) - ) - "Major-mode dependent specifications of skip functions. - -Alist where the key is a list of major-modes and the value is a -function used to skip over matches in `sp-get-paired-expression'. -This function takes three arguments: the currently matched -delimiter, beginning of match and end of match. If this function -returns true, the current match will be skipped. - -You can use this to skip over expressions that serve multiple -functions, such as if/end pair or unary if in Ruby or * in -markdown when it signifies list item instead of emphasis. If the -exception is only relevant to one pair, you should rather -use :skip-match option in `sp-local-pair'." - :type '(alist - :key-type (repeat symbol) - :value-type symbol) - :group 'smartparens) - -(defcustom sp-navigate-reindent-after-up `( - (interactive - ,@sp-lisp-modes - ) - ) - "Modes where sexps should be reindented after `sp-up-sexp'. - -The whitespace between the closing delimiter and last \"thing\" -inside the expression is removed. It works analogically for the -`sp-backward-up-sexp'. - -Note that this also happens when `sp-skip-closing-pair' is -invoked (usually in strict mode when the closing delimiter is -typed) as it calls `sp-up-sexp' internally. This behaviour can -be customized by various settings of `sp-autoskip-closing-pair' -and `sp-autoskip-opening-pair'. - -If the mode is in the list \"interactive\", only reindent the sexp -if the command was called interactively. This is recommended for -general use. - -If the mode is in the list \"always\", reindend the sexp even if the -command was called programatically." - :type '(alist - :options (interactive always) - :value-type (repeat symbol)) - :group 'smartparens) - -(defcustom sp-navigate-reindent-after-up-in-string t - "If non-nil, `sp-up-sexp' will reindent inside strings. - -If `sp-navigate-reindent-after-up' is enabled and the point is -inside a string, this setting determines if smartparens should -reindent the current (string) sexp or not." - :type 'boolean - :group 'smartparens) - -(defcustom sp-navigate-close-if-unbalanced nil - "If non-nil, insert the closing pair of the un-matched pair on `sp-up-sexp'. - -The closing delimiter is inserted after the symbol at -point (using `sp-previous-sexp')." - :type 'boolean - :group 'smartparens) - -(defcustom sp-navigate-interactive-always-progress-point nil - "Make point always move in the direction of navigation. - -If non-nil and the function is called interactively, -`sp-next-sexp' and `sp-previous-sexp' will always move the point -to the end/beg of such an expression where the point would end up -being further in the direction of travel. - -Note: this behaviour will become default in release 2.0 and will -cease to be configurable." - :type 'boolean - :group 'smartparens) - -(defcustom sp-sexp-prefix nil - "Alist of `major-mode' specific prefix specification. - -Each item is a list with three properties: -- major mode -- a constant symbol 'regexp or 'syntax -- a regexp or a string containing syntax class codes. - -If the second argument is 'regexp, the third argument is -interpreted as a regexp to search backward from the start of an -expression. - -If the second argument is 'syntax, the third argument is -interpreted as string containing syntax codes that will be -skipped. - -You can also override this property locally for a specific pair -by specifying its :prefix property." - :type '(repeat - (list symbol - (choice - (const :tag "Regexp" regexp) - (const :tag "Syntax class codes" syntax)) - string)) - :group 'smartparens) - -(defcustom sp-sexp-suffix nil - "Alist of `major-mode' specific suffix specification. - -Each item is a list with three properties: -- major mode -- a constant symbol 'regexp or 'syntax -- a regexp or a string containing syntax class codes. - -If the second argument is 'regexp, the third argument is -interpreted as a regexp to search forward from the end of an -expression. - -If the second argument is 'syntax, the third argument is -interpreted as string containing syntax codes that will be -skipped. - -You can also override this property locally for a specific pair -by specifying its :suffix property." - :type '(repeat - (list symbol - (choice - (const :tag "Regexp" regexp) - (const :tag "Syntax class codes" syntax)) - string)) - :group 'smartparens) - -(defcustom sp-split-sexp-always-split-as-string t - "Determine if sexp inside string is split. - -If the point is inside a sexp inside a string, the default -behaviour is now to split the string, such that: - - \"foo (|) bar\" - -becomes - - \"foo (\"|\") bar\" - -instead of - - \"foo ()|() bar\". - -Note: the old default behaviour was the reverse, it would split -the sexp, but this is hardly ever what you want. - -You can add a post-handler on string pair and check for -'split-string action to add concatenation operators of the -language you work in (in each `major-mode' you can have a separate -hook). - -For example, in PHP the string concatenation operator is a -dot (.), so you would add: - - (defun my-php-post-split-handler (_ action _) - (when (eq action 'split-sexp) - (just-one-space) - (insert \". . \") - (backward-char 3))) - - (sp-local-pair 'php-mode \"'\" nil - :post-handlers '(my-php-post-split-handler)) - -Then - - echo 'foo |baz'; - -results in - - echo 'foo' . | . 'baz';" - :type 'boolean - :group 'smartparens) - -;; hybrid lines -(defcustom sp-hybrid-kill-excessive-whitespace nil - "Determine how `sp-kill-hybrid-sexp' kills excessive whitespace. - -If non-nil, `sp-kill-hybrid-sexp' will delete all whitespace -up until next hybrid sexp if the point is at the end of line or -on a blank line. - -When it is set to 'kill, whitespace will be appended to the sexp -in kill ring." - :type '(choice - (const :tag "Delete" t) - (const :tag "Kill" kill) - (const :tag "Off" nil)) - :group 'smartparens) - -(defcustom sp-hybrid-kill-entire-symbol nil - "Governs how symbols under point are treated by `sp-kill-hybrid-sexp'. - -If t, always kill the symbol under point. - -If nil, never kill the entire symbol and only kill the part after point. - -If a function, this should be a zero-arg predicate. When it -returns non-nil value, we should kill from point." - :type '(radio - (const :tag "Always kill entire symbol" t) - (const :tag "Always kill from point" nil) - (const :tag "Kill from point only inside strings" sp-point-in-string) - (function :tag "Custom predicate")) - :group 'smartparens) - -(defcustom sp-comment-string nil - "String that is inserted after calling `sp-comment'. - -It is an alist of list of major modes to a string. - -The value of `comment-start' is used if the major mode is not found." - :type '(alist - :key-type (repeat symbol) - :value-type string) - :group 'smartparens) - -;; ui custom -(defcustom sp-highlight-pair-overlay t - "If non-nil, autoinserted pairs are highlighted while point is inside the pair." - :type 'boolean - :group 'smartparens) - -(defcustom sp-highlight-wrap-overlay t - "If non-nil, wrap overlays are highlighted during editing of the wrapping pair." - :type 'boolean - :group 'smartparens) - -(defcustom sp-highlight-wrap-tag-overlay t - "If non-nil, wrap tag overlays are highlighted during editing of the wrapping tag pair." - :type 'boolean - :group 'smartparens) - -(defcustom sp-echo-match-when-invisible t - "If non-nil, show-smartparens-mode prints the line of the -matching paren in the echo area if not visible on screen." - :type 'boolean - :group 'smartparens) - -(defcustom sp-message-width 'frame - "Length of information and error messages to display. - -If set to 'frame (the default), messages are chosen based of the -frame width. t means chose the default (verbose) message, nil -means mute. Integers specify the maximum width." - :type '(choice (const :tag "Fit to frame" frame) - (const :tag "Verbose" t) - (const :tag "Mute" nil) - (integer :tag "Max width")) - :group 'smartparens) - -;; TODO: this should be true by default > then the behaviour is -;; controlled by subword-mode... and this is a hard override -(defcustom sp-use-subword nil - "Override of `subword-mode' killing behaviour. - -If non-nill, `sp-kill-word' and `sp-backward-kill-word' only -kill \"subwords\" when `subword-mode' is active." - :type 'boolean - :group 'smartparens) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Selection mode handling - -(defun sp--delete-selection-p () - "Return t if `delete-selection-mode' or `cua-delete-selection' is enabled." - (or (and (boundp 'delete-selection-mode) delete-selection-mode) - (and (boundp 'cua-delete-selection) cua-delete-selection cua-mode))) - -(defun sp--delete-selection-supersede-p () - "Decide if the current command should delete the region or not. - -This check is used as value of 'delete-selection property on the -command symbol." - (if (or (equal current-prefix-arg '(4)) - (sp-region-ok-p (region-beginning) (region-end))) - 'supersede - (sp-message :unbalanced-region) - ;; Since this check runs in the pre-command-hook we can change the - ;; command to be executed... in this case we set it to ignore - ;; because we don't want to do anything. - (setq this-command 'ignore) - nil)) - -(defun sp--self-insert-uses-region-strict-p () - "Decide if the current `self-insert-command' should be able to -replace the region. - -This check is added to the special hook -`self-insert-uses-region-functions' which is checked by -`delete-selection-uses-region-p'." - (if (or (equal current-prefix-arg '(4)) - (sp-region-ok-p (region-beginning) (region-end))) - ;; region is OK or we are allowed to replace it, just say nil so - ;; that delsel handles this - nil - ;; in case region is bad we interrupt the insertion - (setq this-command 'ignore) - t)) - -;; TODO: this function was removed from Emacs, we should get rid of -;; the advice in time. -(defadvice cua-replace-region (around fix-sp-wrap activate) - "Fix `sp-wrap' in `cua-selection-mode'." - (if (sp-wrap--can-wrap-p) - (cua--fallback) - ad-do-it)) - -(defadvice cua-delete-region (around fix-sp-delete-region activate) - "If `smartparens-strict-mode' is enabled, perform a region -check before deleting." - (if smartparens-strict-mode - (progn - (unless (or current-prefix-arg - (sp-region-ok-p (region-beginning) (region-end))) - (user-error (sp-message :unbalanced-region :return))) - ad-do-it) - ad-do-it)) - - - -(cl-eval-when (compile eval load) - (defun sp--get-substitute (struct list) - "Only ever call this from sp-get! This function does the -replacement of all the keywords with actual calls to sp-get." - (if (listp list) - (if (eq (car list) 'sp-get) - list - (mapcar (lambda (x) (sp--get-substitute struct x)) - (let ((command (car list))) - (cond - ((eq command 'sp-do-move-op) - (let ((argument (make-symbol "--sp-argument--"))) - `(let ((,argument ,(cadr list))) - (if (< ,argument :beg-prf) - (progn - (goto-char :beg-prf) - (delete-char (+ :op-l :prefix-l)) - (goto-char ,argument) - (insert :prefix :op)) - (goto-char ,argument) - (insert :prefix :op) - (goto-char :beg-prf) - (delete-char (+ :op-l :prefix-l)))))) - ((eq command 'sp-do-move-cl) - (let ((argument (make-symbol "--sp-argument--"))) - `(let ((,argument ,(cadr list))) - (if (> ,argument :end-in) - (progn - (goto-char ,argument) - (insert :cl :suffix) - (goto-char :end-in) - (delete-char (+ :cl-l :suffix-l))) - (goto-char :end-in) - (delete-char (+ :cl-l :suffix-l)) - (goto-char ,argument) - (insert :cl :suffix))))) - ((eq command 'sp-do-del-op) - `(progn - (goto-char :beg-prf) - (delete-char (+ :op-l :prefix-l)))) - ((eq command 'sp-do-del-cl) - `(progn - (goto-char :end-in) - (delete-char (+ :cl-l :suffix-l)))) - ((eq command 'sp-do-put-op) - `(progn - (goto-char ,(cadr list)) - (insert :prefix :op))) - ((eq command 'sp-do-put-cl) - `(progn - (goto-char ,(cadr list)) - (insert :cl :suffix))) - (t list))))) - (if (keywordp list) - (sp--get-replace-keyword struct list) - list))) - - (defun sp--get-replace-keyword (struct keyword) - (cl-case keyword - ;; point in buffer before the opening delimiter - (:beg `(plist-get ,struct :beg)) - ;; point in the buffer after the closing delimiter - (:end `(plist-get ,struct :end)) - ;; point in buffer after the opening delimiter - (:beg-in `(+ (plist-get ,struct :beg) (length (plist-get ,struct :op)))) - ;; point in buffer before the closing delimiter - (:end-in `(- (plist-get ,struct :end) (length (plist-get ,struct :cl)))) - ;; point in buffer before the prefix of this expression - (:beg-prf `(- (plist-get ,struct :beg) (length (plist-get ,struct :prefix)))) - ;; point in the buffer after the suffix of this expression - (:end-suf `(+ (plist-get ,struct :end) (length (plist-get ,struct :suffix)))) - ;; opening delimiter - (:op `(plist-get ,struct :op)) - ;; closing delimiter - (:cl `(plist-get ,struct :cl)) - ;; length of the opening pair - (:op-l `(length (plist-get ,struct :op))) - ;; length of the closing pair - (:cl-l `(length (plist-get ,struct :cl))) - ;; length of the entire expression, including enclosing - ;; delimiters and the prefix and suffix - (:len `(- (plist-get ,struct :end) - (plist-get ,struct :beg) - (- (length (plist-get ,struct :prefix))) - (- (length (plist-get ,struct :suffix))))) - ;; length of the the pair ignoring the prefix, including delimiters - (:len-out `(- (plist-get ,struct :end) (plist-get ,struct :beg))) - ;; length of the pair inside the delimiters - (:len-in `(- (plist-get ,struct :end) - (plist-get ,struct :beg) - (length (plist-get ,struct :op)) - (length (plist-get ,struct :cl)))) - ;; expression prefix - (:prefix `(plist-get ,struct :prefix)) - ;; expression prefix length - (:prefix-l `(length (plist-get ,struct :prefix))) - (:suffix `(plist-get ,struct :suffix)) - (:suffix-l `(length (plist-get ,struct :suffix))) - ;; combined op/cl and suffix/prefix - (:opp `(concat (plist-get ,struct :prefix) - (plist-get ,struct :op))) - (:opp-l `(+ (length (plist-get ,struct :prefix)) - (length (plist-get ,struct :op)))) - (:cls `(concat (plist-get ,struct :cl) - (plist-get ,struct :suffix))) - (:cls-l `(+ (length (plist-get ,struct :cl)) - (length (plist-get ,struct :suffix)))) - (t keyword)))) - - -;; TODO: rewrite this in terms of `symbol-macrolet' ?? -(defmacro sp-get (struct &rest forms) - "Get a property from a structure. - -STRUCT is a plist with the format as returned by `sp-get-sexp'. -Which means this macro also works with `sp-get-symbol', -`sp-get-string' and `sp-get-thing'. - -FORMS is an attribute we want to query. Currently supported -attributes are: - -:beg - point in buffer before the opening delimiter -:end - point in the buffer after the closing delimiter -:beg-in - point in buffer after the opening delimiter -:end-in - point in buffer before the closing delimiter -:beg-prf - point in buffer before the prefix of this expression -:end-suf - point in buffer after the suffix of this expression -:op - opening delimiter -:cl - closing delimiter -:op-l - length of the opening pair -:cl-l - length of the closing pair -:len - length of the entire expression, including enclosing - delimiters, the prefix and the suffix -:len-out - length of the the pair ignoring the prefix and suffix, - including delimiters -:len-in - length of the pair inside the delimiters -:prefix - expression prefix -:prefix-l - expression prefix length -:suffix - expression suffix -:suffix-l - expression suffix length - -These special \"functions\" are expanded to do the selected -action in the context of currently queried pair: - -Nullary: -\(sp-do-del-op) - remove prefix and opening delimiter -\(sp-do-del-cl) - remove closing delimiter and suffix - -Unary: -\(sp-do-move-op p) - move prefix and opening delimiter to point p -\(sp-do-move-cl p) - move closing delimiter and suffix to point p -\(sp-do-put-op p) - put prefix and opening delimiter at point p -\(sp-do-put-cl p) - put closing delimiter and suffix at point p - -In addition to these simple queries and commands, this macro -understands arbitrary forms where any of the aforementioned -attributes are used. Therefore, you can for example query for -\"(+ :op-l :cl-l)\". This query would return the sum of lengths -of opening and closing delimiter. A query -\"(concat :prefix :op)\" would return the string containing -expression prefix and the opening delimiter. - -Special care is taken to only evaluate the STRUCT argument once." - (declare (indent 1) - (debug (form body))) - (let ((st (make-symbol "struct"))) - (sp--get-substitute st `(let ((,st ,struct)) ,@forms)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Misc/Utility functions - -(defun sp--indent-region (start end &optional column) - "Call `indent-region' unless `aggressive-indent-mode' is enabled. - -START, END and COLUMN are the same as in `indent-region'." - (unless (bound-and-true-p aggressive-indent-mode) - ;; Don't issue "Indenting region..." message. - (cl-letf (((symbol-function 'message) #'ignore)) - (indent-region start end column)))) - -(defmacro sp-with-modes (arg &rest forms) - "Add ARG as first argument to each form in FORMS. - -This can be used with `sp-local-pair' calls to automatically -insert the modes." - (declare (indent 1) - (debug (form body))) - (let ((modes (make-symbol "modes"))) - `(let ((,modes ,arg)) - (progn - ,@(mapcar (lambda (form) (append (list (car form) modes) (cdr form))) forms))))) - -(font-lock-add-keywords 'emacs-lisp-mode `((,(concat "(" - (regexp-opt '("sp-with-modes" - "sp-get" - "sp-compare-sexps") t) - "\\_>") - (1 font-lock-keyword-face)))) - -(defmacro sp--with-case-sensitive (&rest body) - "Ensure that searching done within BODY is case-sensitive. - -Bind `case-fold-search' to nil if it is not already and avoid the -bind if it is already. Any function that needs to use any of the -sp--looking-* functions more than once should wrap them all in -`sp--with-case-sensitive'." - (declare (indent 0) - (debug (body))) - `(if case-fold-search - (let ((case-fold-search nil)) - ,@body) - ,@body)) - -(defun sp--evil-normal-state-p () - "Check to see if the current `evil-state' is in normal mode." - (and (fboundp 'evil-normal-state-p) (evil-normal-state-p))) - -(defun sp--evil-motion-state-p () - "Check to see if the current `evil-state' is in motion mode." - (and (fboundp 'evil-motion-state-p) (evil-motion-state-p))) - -(defun sp--evil-visual-state-p () - "Check to see if the current `evil-state' is in visual mode." - (and (fboundp 'evil-visual-state-p) (evil-visual-state-p))) - -(defun sp-point-in-blank-line (&optional p) - "Return non-nil if line at point is blank (whitespace only). - -If optional argument P is present test this instead of point." - (save-excursion - (when p (goto-char p)) - (beginning-of-line) - (looking-at "[ \t]*$"))) - -(defun sp-point-in-blank-sexp (&optional p) - "Return non-nil if point is inside blank (whitespace only) sexp. - -If optional argument P is present test this instead of point. - -Warning: it is only safe to call this when point is inside a -sexp, otherwise the call may be very slow." - (save-excursion - (when p (goto-char p)) - (-when-let (enc (sp-get-enclosing-sexp)) - (sp-get enc (string-match-p - "\\`[ \t\n]*\\'" - (buffer-substring-no-properties :beg-in :end-in)))))) - -(defun sp-char-is-escaped-p (&optional point) - "Test if the char at POINT is escaped or not. - -POINT defaults to `point'." - (setq point (or point (point))) - (save-match-data - (when (save-excursion - (goto-char point) - (looking-back (concat sp-escape-char sp-escape-char "+") nil t)) - (eq (logand (length (match-string 0)) 1) 1)))) - -(defun sp--syntax-ppss (&optional p) - "Memoize the last result of `syntax-ppss'. - -P is the point at which we run `syntax-ppss'" - (let ((p (or p (point))) - (mem-p (sp-state-last-syntax-ppss-point sp-state))) - (if (and (eq p (nth 0 mem-p)) - (eq (point-min) (nth 1 mem-p)) - (eq (point-max) (nth 2 mem-p))) - (sp-state-last-syntax-ppss-result sp-state) - ;; Add hook to reset memoization if necessary - (unless (sp-state-last-syntax-ppss-point sp-state) - (add-hook 'before-change-functions 'sp--reset-memoization t t)) - (setf (sp-state-last-syntax-ppss-point sp-state) - (list p (point-min) (point-max)) - (sp-state-last-syntax-ppss-result sp-state) (syntax-ppss p))))) - -(defun sp-point-in-string (&optional p) - "Return non-nil if point is inside string or documentation string. - -This function actually returns the 3rd element of `syntax-ppss' -which can be a number if the string is delimited by that -character or t if the string is delimited by general string -fences. - -If optional argument P is present test this instead of point." - (ignore-errors - (save-excursion - (nth 3 (sp--syntax-ppss p))))) - -(defun sp-point-in-comment (&optional p) - "Return non-nil if point is inside comment. - -If optional argument P is present test this instead off point." - (setq p (or p (point))) - (ignore-errors - (save-excursion - ;; We cannot be in a comment if we are inside a string - (unless (nth 3 (sp--syntax-ppss p)) - (or (nth 4 (sp--syntax-ppss p)) - ;; this also test opening and closing comment delimiters... we - ;; need to chack that it is not newline, which is in "comment - ;; ender" class in elisp-mode, but we just want it to be - ;; treated as whitespace - (and (< p (point-max)) - (memq (char-syntax (char-after p)) '(?< ?>)) - (not (eq (char-after p) ?\n))) - ;; we also need to test the special syntax flag for comment - ;; starters and enders, because `syntax-ppss' does not yet - ;; know if we are inside a comment or not (e.g. / can be a - ;; division or comment starter...). - (-when-let (s (car (syntax-after p))) - (or (and (/= 0 (logand (lsh 1 16) s)) - (nth 4 (syntax-ppss (+ p 2)))) - (and (/= 0 (logand (lsh 1 17) s)) - (nth 4 (syntax-ppss (+ p 1)))) - (and (/= 0 (logand (lsh 1 18) s)) - (nth 4 (syntax-ppss (- p 1)))) - (and (/= 0 (logand (lsh 1 19) s)) - (nth 4 (syntax-ppss (- p 2))))))))))) - -(defun sp-point-in-string-or-comment (&optional p) - "Return non-nil if point is inside string, documentation string or a comment. - -If optional argument P is present, test this instead of point." - (or (sp-point-in-string p) - (sp-point-in-comment p))) - -;; TODO: add -p suffix -(defun sp-point-in-symbol (&optional p) - "Return non-nil if `point' is inside symbol. - -If P is non-nil, interpret it as buffer position and test there. - -Point is inside symbol if characters on both sides of the point -are in either word or symbol class." - (setq p (or p (point))) - (save-excursion - (goto-char p) - (and (/= 0 (following-char)) - (memq (char-syntax (following-char)) '(?w ?_)) - (memq (char-syntax (preceding-char)) '(?w ?_))))) - -(defun sp--single-key-description (event) - "Return a description of the last EVENT. - -Replace all the function key symbols with garbage character (ň). - -TODO: fix this!" - (let ((original (single-key-description event))) - (cond - ((string-match-p "<.*?>" original) "ň") - ((string-match-p "SPC" original) " ") - (t original)))) - -;; see https://github.com/Fuco1/smartparens/issues/125#issuecomment-20356176 -(defun sp--current-indentation () - "Get the indentation offset of the current line." - (save-excursion - (back-to-indentation) - (current-column))) - -(defun sp--calculate-indentation-offset (old-column old-indentation) - "Calculate correct indentation after re-indent. - -OLD-COLUMN is the column before reindent. - -OLD-INDENTATION is the indentation depth before reindent." - (let ((indentation (sp--current-indentation))) - (cond - ;; Point was in code, so move it along with the re-indented code - ((>= old-column old-indentation) - (+ old-column (- indentation old-indentation))) - ;; Point was indentation, but would be in code now, so move to - ;; the beginning of indentation - ((<= indentation old-column) indentation) - ;; Point was in indentation, and still is, so leave it there - (:else old-column)))) - -(defun sp--back-to-indentation (old-column old-indentation) - "Set the current column to proper value. - -See `sp--keep-indentation'. - -OLD-COLUMN is the column before reindent. - -OLD-INDENTATION is the indentation depth before reindent." - (let ((offset (sp--calculate-indentation-offset old-column old-indentation))) - (move-to-column offset))) - -;; TODO: rename to preserve-current-column -(defmacro sp--keep-indentation (&rest body) - "Execute BODY and restore the column. - -If point was in code move it along if the line is reinvented so -it is the same distance relative to first code column. - -If point was previously in the indentation region but would end -up in code, move it to the first code column. - -If point was in the indentation region and is still there after -BODY, do nothing." - (declare (indent 0) - (debug (body))) - (let ((c (make-symbol "c")) - (i (make-symbol "i"))) - `(let ((,c (current-column)) - (,i (sp--current-indentation))) - ,@body - (sp--back-to-indentation ,c ,i)))) - -;; Please contribute these if you come across some! -(defvar sp--self-insert-commands - '(self-insert-command - org-self-insert-command - LaTeX-insert-left-brace) - "List of commands that are some sort of `self-insert-command'. - -Many modes rebind \"self-inserting\" keys to \"smart\" versions -which do some additional processing before delegating the -insertion to `self-insert-command'. Smartparens needs to be able -to distinguish these to properly handle insertion and reinsertion -of pairs and wraps.") - -;; Please contribute these if you come across some! -(defvar sp--special-self-insert-commands - '( - TeX-insert-dollar - TeX-insert-quote - quack-insert-opening-paren - quack-insert-closing-paren - quack-insert-opening-bracket - quack-insert-closing-bracket - racket-insert-closing-paren - racket-insert-closing-bracket - racket-insert-closing-brace - ) - "List of commands which are handled as if they were `self-insert-command's. - -Some modes redefine \"self-inserting\" keys to \"smart\" versions -which do some additional processing but do _not_ delegate the -insertion to `self-insert-command', instead inserting via -`insert'. Smartparens needs to be able to distinguish these to -properly handle insertion and reinsertion of pairs and wraps. - -The `sp--post-self-insert-hook-handler' is called in the -`post-command-hook' for these commands.") - -(defun sp--self-insert-command-p () - "Return non-nil if `this-command' is some sort of `self-insert-command'." - (memq this-command sp--self-insert-commands)) - -(defun sp--special-self-insert-command-p () - "Return non-nil if `this-command' is \"special\" self insert command. - -A special self insert command is one that inserts a character but -does not trigger `post-self-insert-hook'." - (memq this-command sp--special-self-insert-commands)) - -(defun sp--signum (x) - "Return 1 if X is positive, -1 if negative, 0 if zero." - (cond ((> x 0) 1) ((< x 0) -1) (t 0))) - -;; The structure returned by sp-get-sexp is a plist with following properties: -;; -;; :beg - point in the buffer before the opening delimiter (ignoring prefix) -;; :end - point in the buffer after the closing delimiter -;; :op - opening delimiter -;; :cl - closing delimiter -;; :prefix - expression prefix -;; -;; This structure should never be accessed directly and should only be -;; exposed by the sp-get macro. This way, we can later change the -;; internal representation without much trouble. - -(defmacro sp-compare-sexps (a b &optional fun what-a what-b) - "Return non-nil if the expressions A and B are equal. - -Two expressions are equal if their :beg property is the same. - -If optional argument FUN is non-nil, it is the comparison -function. - -If optional argument WHAT-A is non-nil, use it as a keyword on -which to do the comparsion (default to :beg). - -If optional argument WHAT-B is non-nil, use it as a keyword on -which to do the comparsion (default to WHAT-A)." - (declare (debug (form form &optional functionp keywordp keywordp))) - (setq fun (or fun 'equal)) - (setq what-a (or what-a :beg)) - (setq what-b (or what-b what-a)) - `(,fun (sp-get ,a ,what-a) (sp-get ,b ,what-b))) - -(defun sp-message (key &optional return) - "Display a message. - -KEY is either a string or list of strings, or a keyword, -in which case the string list is looked up in -`sp-message-alist'. The string to be displayed is chosen based on -the `sp-message-width' variable. - -If RETURN is non-nil return the string instead of printing it." - (let ((msgs (cond ((listp key) key) - ((stringp key) (list key)) - (t (cdr (assq key sp-message-alist)))))) - (when (and msgs sp-message-width) - (if (eq sp-message-width t) - (if return (car msgs) (message "%s." (car msgs))) - (let ((maxlen (if (eq sp-message-width 'frame) - (frame-width) - sp-message-width)) - (s nil)) - (dolist (msg msgs) - (if (and (<= (length msg) maxlen) - (> (length msg) (length s))) - (setf s msg))) - (when s - (if return s (message "%s." s)))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Adding/removing of pairs/bans/allows etc. - -(defun sp--merge-prop (prop new-pair old-pair) - "Merge a property PROP from NEW-PAIR into OLD-PAIR. - -The list OLD-PAIR must not be nil." - (let ((new-val (plist-get new-pair prop))) - (cl-case prop - (:close (plist-put old-pair :close new-val)) - (:prefix (plist-put old-pair :prefix new-val)) - (:suffix (plist-put old-pair :suffix new-val)) - (:skip-match (plist-put old-pair :skip-match new-val)) - (:trigger (plist-put old-pair :trigger new-val)) - (:trigger-wrap (plist-put old-pair :trigger-wrap new-val)) - ((:actions :when :unless :pre-handlers :post-handlers) - (cl-case (car new-val) - (:add (plist-put old-pair prop (-union (plist-get old-pair prop) (cdr new-val)))) - (:rem (plist-put old-pair prop (-difference (plist-get old-pair prop) (cdr new-val)))) - (t - (cond - ;; this means we have ((:add ...) (:rem ...)) argument - ((and new-val - (listp (car new-val)) - (memq (caar new-val) '(:add :rem))) - (let ((a (assq :add new-val)) - (r (assq :rem new-val))) - (plist-put old-pair prop (-union (plist-get old-pair prop) (cdr a))) - (plist-put old-pair prop (-difference (plist-get old-pair prop) (cdr r))))) - (t - (plist-put old-pair prop (plist-get new-pair prop)))))))))) - -(defun sp--merge-pairs (old-pair new-pair) - "Merge OLD-PAIR and NEW-PAIR. -This modifies the OLD-PAIR by side effect." - (--each new-pair - ;; In plists, items at even positions are keys - (when (= 0 (% it-index 2)) - (sp--merge-prop it new-pair old-pair))) - old-pair) - -(defun sp--update-pair (new-pair old-pair) - "Copy properties from NEW-PAIR to OLD-PAIR. - -The list OLD-PAIR must not be nil." - (--each new-pair - ;; In plists, items at even positions are keys - (when (= 0 (% it-index 2)) - (when (or (not (plist-get old-pair it)) - ;; HACK: we don't want to overwrite list properties - ;; that aren't just :add with :add because this - ;; would break the "idempotency". - (not (equal '(:add) (plist-get new-pair it)))) - (plist-put old-pair it (plist-get new-pair it))))) - old-pair) - -(defun sp--update-pair-list (pair mode) - "Update the PAIR for major mode MODE. - -If this pair is not defined yet for this major mode, add it. If -this pair is already defined, replace all the properties in the -old definition with values from PAIR." - ;; get the structure relevant to mode. t means global setting - (let ((struct (--first (eq mode (car it)) sp-pairs))) - (if (not struct) - (!cons (cons mode (list pair)) sp-pairs) - ;; this does NOT merge changes, only replace the values at - ;; properties. Open delimiter works as ID as usual. - (let ((old-pair (--first (equal (plist-get pair :open) - (plist-get it :open)) - (cdr struct))) - (open (plist-get pair :open))) - (if (not old-pair) - (progn - (unless (or (plist-get pair :close) - (sp--get-pair open (assq t sp-pairs))) - (error "Pair %s was never defined, please specify closing delimiter in instead of passing `nil'" open)) - (setcdr struct (cons pair (cdr struct)))) - (sp--update-pair pair old-pair))))) - sp-pairs) - -(defun sp--get-pair (open list) - "Get the pair with id OPEN from list LIST." - (--first (equal open (plist-get it :open)) list)) - -(defun sp--get-pair-definition (open list &optional prop) - "Get the definition of a pair identified by OPEN from list LIST. - -If PROP is non-nil, return the value of that property instead." - (let ((pair (sp--get-pair open list))) - (cl-case prop - ((nil) pair) - (:op-l (length (plist-get pair :open))) - (:cl-l (length (plist-get pair :close))) - (:len (+ (length (plist-get pair :open)) - (length (plist-get pair :close)))) - (:post-handlers - (-remove #'listp (plist-get pair :post-handlers))) - (:post-handlers-cond - (-filter #'listp (plist-get pair :post-handlers))) - (:when - (-remove #'listp (plist-get pair :when))) - (:when-cond - (-flatten (-concat (-filter #'listp (plist-get pair :when))))) - (t (plist-get pair prop))))) - -(defun sp-get-pair-definition (open mode &optional prop) - "Get the definition of pair identified by OPEN. - -OPEN is the opening delimiter, MODE is the major mode symbol or t -for global definition. - -If PROP is non-nil, return the value of that property instead." - (sp--get-pair-definition open (cdr (assq mode sp-pairs)) prop)) - -(defun sp-get-pair (open &optional prop) - "Return the definition of pair defined by OPEN in the current buffer. - -The value is fetched from `sp-local-pairs'. - -If PROP is non-nil, return the value of that property instead." - (sp--get-pair-definition open sp-local-pairs prop)) - -(defun sp--merge-pair-configurations (specific &optional current) - "Merge SPECIFIC pair configuration to the CURRENT configuration. - -CURRENT defaults to `sp-local-pairs' if it is non-nil or the -global definition from `sp-pairs' if `sp-local-pairs' is nil." - (let* ((global (or current sp-local-pairs (cdr (assq t sp-pairs)))) - (local specific) - (result nil)) - ;; copy the pairs on global list first. This creates new plists - ;; so we can modify them without changing the global "template" - ;; values. - (dolist (old-pair global) - (!cons (list :open (plist-get old-pair :open)) result)) - - ;; merge the global list with result. This basically "deep copy" - ;; global list. We use `sp--merge-pairs' because it also clones - ;; the list properties (actions, filters etc.) - (dolist (new-pair global) - (let ((old-pair (sp--get-pair (plist-get new-pair :open) result))) - (sp--merge-pairs old-pair new-pair))) - - ;; for each local pair, merge it into the global definition - (dolist (new-pair local) - (let ((old-pair (sp--get-pair (plist-get new-pair :open) result))) - (if old-pair - (sp--merge-pairs old-pair new-pair) - ;; pair does not have global definition, simply copy it over - (!cons - ;; this "deep copy" the new-pair - (sp--merge-pairs (list :open (plist-get new-pair :open)) new-pair) - ;; TODO: remove the nil lists from the definitions - result)))) - result)) - -(defun sp-wrap-with-pair (pair) - "Wrap the following expression with PAIR. - -This function is a non-interactive helper. To use this function -interactively, bind the following lambda to a key: - - (lambda (&optional arg) (interactive \"P\") (sp-wrap-with-pair \"(\")) - -This lambda accepts the same prefix arguments as -`sp-select-next-thing'. - -If region is active and `use-region-p' returns true, the region -is wrapped instead. This is useful with selection functions in -`evil-mode' to wrap regions with pairs." - (let* ((arg (or current-prefix-arg 1)) - (sel (and (not (use-region-p)) - (sp-select-next-thing-exchange - arg - (cond - ;; point is inside symbol and smart symbol wrapping is disabled - ((and (sp-point-in-symbol) - (or (eq sp-wrap-entire-symbol 'globally) - (memq major-mode sp-wrap-entire-symbol))) - (point)) - ;; wrap from point, not the start of the next expression - ((and sp-wrap-from-point - (not (sp-point-in-symbol))) - (point)))))) - (active-pair (--first (equal (car it) pair) sp-pair-list)) - (rb (region-beginning)) - (re (region-end))) - (goto-char re) - (insert (cdr active-pair)) - (goto-char rb) - (insert (car active-pair)) - (if (use-region-p) - (sp--indent-region rb re) - (sp-get sel (sp--indent-region :beg :end))))) - -(cl-defun sp-pair (open - close - &key - trigger - trigger-wrap - (actions '(wrap insert autoskip navigate)) - when - unless - pre-handlers - post-handlers - wrap - bind - insert) - "Add a pair definition. - -OPEN is the opening delimiter. Every pair is uniquely determined -by this string. - -CLOSE is the closing delimiter. You can use nil for this -argument if you are updating an existing definition. In this -case, the old value is retained. - -TRIGGER is an optional trigger for the pair. The pair will be -inserted if either OPEN or TRIGGER is typed. This is usually -used as a shortcut for longer pairs or for pairs that can't be -typed easily. - -TRIGGER-WRAP is the same as TRIGGER but used for wrapping. - -ACTIONS is a list of actions that smartparens will perform with -this pair. Possible values are: - -- insert - autoinsert the closing pair when opening pair is - typed. -- wrap - wrap an active region with the pair defined by opening - delimiter if this is typed while region is active. -- autoskip - if the sexp is active or `sp-autoskip-closing-pair' is - set to 'always, skip over the closing delimiter if user types its - characters in order. -- navigate - enable this pair for navigation/highlight and strictness - checks -- escape - allow autoescaping of this delimiter in string contexts - -If the ACTIONS argument has value :rem, the pair is removed. -This can be used to remove default pairs you don't want to use. -For example: (sp-pair \"[\" nil :actions :rem) - -WHEN is a list of predicates that test whether the action -should be performed in current context. The values in the list -should be names of the predicates (that is symbols, not -lambdas!). They should accept three arguments: opening -delimiter (which uniquely determines the pair), action and -context. The context argument can have values: - -- string - if point is inside string. -- comment - if point is inside comment. -- code - if point is inside code. This context is only - recognized in programming modes that define string semantics. - -If *any* filter returns t, the action WILL be performed. A number -of filters are predefined: `sp-point-after-word-p', -`sp-point-before-word-p', `sp-in-string-p', -`sp-point-before-eol-p' etc. - -When clause also supports a special format for delayed insertion. -The condition is a list with commands, predicates (with three -arguments as regular when form) or strings specifying the last -event. All three types can be combined in one list. The pair -will be inserted *after* the next command if it matches the any -command on the list, if the last event matches any string on the -list or if any predicate returns true. If the pair's :when -clause contains this special form, it will never be immediately -inserted and will always test for delayed insertion. - -UNLESS is a list of predicates. The conventions are the same as -for the WHEN list. If *any* filter on this list returns t, the -action WILL NOT be performed. The predicates in the WHEN list -are checked first, and if any of them succeeds, the UNLESS list -is not checked. - -Note: the functions on the WHEN/UNLESS lists are also called -\"filters\" in the documentation. - -All the filters are run *after* the trigger character is -inserted. - -PRE-HANDLERS is a list of functions that are called before there -has been some action caused by this pair. The arguments are the -same as for filters. Context is relative to the point *before* -the last inserted character. Because of the nature of the -wrapping operation, this hook is not called if the action is -wrapping. - -POST-HANDLERS is a list of functions that are called after there -has been some action caused by this pair. The arguments are the -same as for filters. Context is relative to current position of -point *after* the closing pair was inserted. - -After a wrapping action, the point might end on either side of -the wrapped region, depending on the original direction. You can -use the variable `sp-last-wrapped-region' to retrieve information -about the wrapped region and position the point to suit your -needs. - -A special syntax for conditional execution of hooks is also -supported. If the added item is a list (function command1 -command2...), where function is a 3 argument function described -above and command(s) can be either name of a command or a string -representing an event. If the last command or event as described -by `single-key-description' matches any on the list, the hook -will be executed. This means these hooks are run not after the -insertion, but after the *next* command is executed. - -Example: - ((lambda (id act con) - (save-excursion - (newline))) \"RET\" newline) - -This function will move the closing pair on its own line only if -the next command is `newline' or is triggered by RET. Otherwise -the pairs stay on the same line. - -WRAP is a key binding to which a \"wrapping\" action is bound. -The key should be in format that is accepted by `kbd'. This -option binds a lambda form: - - `(lambda (&optional arg) - (interactive \"P\") - (sp-wrap-with-pair ,OPEN)) - -to the specified key sequence. The binding is added to global -keymap. When executed, it wraps ARG (default 1) expressions with -this pair (like `paredit-wrap-round' and friends). Additionally, -it accepts the same prefix arguments as `sp-select-next-thing'. - -BIND is equivalent to WRAP. It is a legacy setting and will be -removed soon. - -INSERT is a key binding to which an \"insert\" action is bound. -The key should be in format that is accepted by `kbd'. This is -achieved by binding a lambda form: - - (lambda () (interactive) (sp-insert-pair \"pair-id\")) - -to the supplied key, where pair-id is the open delimiter of the -pair. The binding is added to the global map. You can also bind -a similar lambda manually. To only bind this in specific major -modes, use this property on `sp-local-pair' instead." - (if (eq actions :rem) - (let ((global-list (assq t sp-pairs))) - (setcdr global-list (--remove (equal (plist-get it :open) open) (cdr global-list))) - (--each (buffer-list) - (with-current-buffer it (sp--remove-local-pair open)))) - (let ((pair nil)) - (setq pair (plist-put pair :open open)) - (when close (plist-put pair :close close)) - (when trigger (plist-put pair :trigger trigger)) - (when trigger-wrap (plist-put pair :trigger-wrap trigger-wrap)) - (dolist (arg `((:actions . ,actions) - (:when . ,when) - (:unless . ,unless) - (:pre-handlers . ,pre-handlers) - (:post-handlers . ,post-handlers))) - ;; We only consider "nil" as a proper value if the property - ;; already exists in the pair. In that case, we will set it to - ;; nil. This allows for removing properties in global - ;; definitions. - (when (or (cdr arg) - (sp-get-pair-definition open t (car arg))) - (plist-put pair (car arg) (cdr arg)))) - (sp--update-pair-list pair t)) - (when (or wrap bind) (global-set-key (read-kbd-macro (or wrap bind)) - `(lambda (&optional arg) - (interactive "P") - (sp-wrap-with-pair ,open)))) - (when insert (global-set-key (kbd insert) `(lambda () (interactive) (sp-insert-pair ,open))))) - (sp--update-local-pairs-everywhere) - sp-pairs) - -(cl-defun sp-local-pair (modes - open - close - &key - trigger - trigger-wrap - (actions '(:add)) - (when '(:add)) - (unless '(:add)) - (pre-handlers '(:add)) - (post-handlers '(:add)) - wrap - bind - insert - prefix - suffix - skip-match) - "Add a local pair definition or override a global definition. - -MODES can be a single mode or a list of modes where these settings -should be applied. - -PREFIX is a regular expression matching an optional prefix for -this pair in the specified major modes. If not specified, the -characters of expression prefix syntax class are automatically -considered instead. This can be used to attach custom prefixes -to pairs, such as prefix \"\\function\" in \\function{arg} in -`LaTeX-mode'. - -SUFFIX is a regular expression matching an optional suffix for -this pair in the specified major modes. If not specified, the -characters of punctuation syntax class are automatically -considered instead. - -The rest of the arguments have same semantics as in `sp-pair'. - -If the pair is not defined globally, ACTIONS defaults to (wrap -insert) instead of (:add) (which inherits global settings) - -The pairs are uniquely identified by the opening delimiter. If you -replace the closing one with a different string in the local -definition, this will override the global closing delimiter. - -The list arguments can optionally be of form starting with -\":add\" or \":rem\" when these mean \"add to the global list\" -and \"remove from the global list\" respectively. Otherwise, -the global list is replaced. If you wish to both add and remove -things with single call, use \"((:add ...) (:rem ...))\" as an -argument. Therefore, - - :when '(:add my-test) - -would mean \"use the global settings for this pair, but also this -additional test\". If no value is provided for list arguments, -they default to \"(:add)\" which means they inherit the list from -the global definition. - -To disable a pair in a major mode, simply set its actions set to -nil. This will ensure the pair is not even loaded when the mode is -activated. - -If WRAP is non-nil, the binding is added into major mode keymap -called \"foo-mode-map\". If the mode does not follow this -convention, you will need to bind the function manually (see -`sp-pair' to how the function is named for each particular pair). -The bindings are not added into `smartparens-mode-map' to prevent -clashes between different modes. - -BIND is equivalent to WRAP. It is a legacy setting and will be -removed soon. - -The binding for INSERT follows the same convention as BIND. See -`sp-pair' for more info. - -You can provide a function SKIP-MATCH, that will take three -arguments: the currently matched delimiter, beginning of match -and end of match. If this function returns true, the -`sp-get-paired-expression' matcher will ignore this match. You -can use this to skip over expressions that serve multiple -functions, such as if/end pair or unary if in Ruby or * in -markdown when it signifies list item instead of emphasis. In -addition, there is a global per major-mode option, see -`sp-navigate-skip-match'." - (if (eq actions :rem) - (dolist (m (-flatten (list modes))) - (let ((mode-pairs (assq m sp-pairs))) - (setcdr mode-pairs - (--remove (equal (plist-get it :open) open) - (cdr mode-pairs)))) - (sp-with-buffers-using-mode m - (sp--remove-local-pair open))) - (dolist (m (-flatten (list modes))) - (let* ((pair nil)) - (setq pair (plist-put pair :open open)) - (when close (plist-put pair :close close)) - (when trigger (plist-put pair :trigger trigger)) - (when trigger-wrap (plist-put pair :trigger-wrap trigger-wrap)) - (when prefix (plist-put pair :prefix prefix)) - (when suffix (plist-put pair :suffix suffix)) - (when skip-match (plist-put pair :skip-match skip-match)) - (when (and (not (sp-get-pair-definition open t)) - (equal actions '(:add))) - (setq actions '(wrap insert autoskip navigate))) - (plist-put pair :actions actions) - (plist-put pair :when when) - (plist-put pair :unless unless) - (plist-put pair :pre-handlers pre-handlers) - (plist-put pair :post-handlers post-handlers) - (sp--update-pair-list pair m) - (-when-let* ((symbol (intern (concat (symbol-name m) "-map"))) - (map (and (boundp symbol) (symbol-value symbol)))) - (when (or wrap bind) (define-key map - (read-kbd-macro (or wrap bind)) - `(lambda (&optional arg) - (interactive "P") - (sp-wrap-with-pair ,open)))) - (when insert (define-key map - (kbd insert) - `(lambda () (interactive) (sp-insert-pair ,open)))))))) - (sp--update-local-pairs-everywhere (-flatten (list modes))) - sp-pairs) - -(cl-defun sp-local-tag (modes trig open close &key - (transform 'identity) - (actions '(wrap insert)) - post-handlers) - "Add a tag definition. - -MODES is a mode or a list of modes where this tag should -activate. It is impossible to define global tags. - -TRIG is the trigger sequence. It can be a string of any length. -If more triggers share a common prefix, the shortest trigger is -executed. - -OPEN is the format of the opening tag. This is inserted before -the active region. - -CLOSE is the format of the closing tag. This is inserted after -the active region. - -Opening and closing tags can optionally contain the _ character. - -If the opening tag contains the _ character, after you type the -trigger, the region is wrapped with \"skeleton\" tags and a -special tag editing mode is entered. The text you now type is -substituted for the _ character in the opening tag. - -If the closing tag contains the _ character, the text from the -opening pair is mirrored to the closing pair and substituted for -the _ character. - -TRANSFORM is a function name (symbol) that is called to perform a -transformation of the opening tag text before this is inserted to -the closing tag. For example, in html tag it might simply select -the name of the tag and cut off the tag attributes (like -class/style etc.). Defaults to identity. - -ACTIONS is a list of actions this tag should support. Currently, -only \"wrap\" action is supported. Usually, you don't need to -specify this argument. - -POST-HANDLERS is a list of functions that are called after the -tag is inserted. If the tag does contain the _ character, these -functions are called after the tag editing mode is exited. Each -function on this list should accept two arguments: the trigger -string and the action." - (dolist (mode (-flatten (list modes))) - (let* ((tag-list (assq mode sp-tags)) - (tag (--first (equal trig (plist-get it :trigger)) (cdr tag-list))) - (new-tag nil)) - (setq new-tag (plist-put new-tag :trigger trig)) - (plist-put new-tag :open open) - (plist-put new-tag :close close) - (when transform (plist-put new-tag :transform transform)) - (when actions (plist-put new-tag :actions actions)) - (when post-handlers (plist-put new-tag :post-handlers post-handlers)) - (if tag-list - (if (not actions) - (setcdr tag-list (--remove (equal trig (plist-get it :trigger)) (cdr tag-list))) - (if (not tag) - (setcdr tag-list (cons new-tag (cdr tag-list))) - (sp--update-pair new-tag tag))) - ;; mode doesn't exist - (when actions - (!cons (cons mode (list new-tag)) sp-tags)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Overlay management - -;; burlywood4 -(defface sp-pair-overlay-face - '((t (:inherit highlight))) - "The face used to highlight pair overlays." - :group 'smartparens) - -(defface sp-wrap-overlay-face - '((t (:inherit sp-pair-overlay-face))) - "The face used to highlight wrap overlays. - -When the user wraps a region with multi-character pair a special -insertion mode is entered. This face is used for the overlays -where the possible wrappings are displayed. - -The opening and closing delimiters use -`sp-wrap-overlay-opening-pair' and `sp-wrap-overlay-closing-pair' -respectively." - :group 'smartparens) - -(defface sp-wrap-overlay-opening-pair - '((t (:inherit sp-wrap-overlay-face - :foreground "green"))) - "The face used to highlight opening pairs for wrapping. - -See `sp-wrap-overlay-face'." - :group 'smartparens) - -(defface sp-wrap-overlay-closing-pair - '((t (:inherit sp-wrap-overlay-face - :foreground "red"))) - "The face used to highlight closing pairs for wrapping. - -See `sp-wrap-overlay-face'." - :group 'smartparens) - -(defface sp-wrap-tag-overlay-face - '((t (:inherit sp-pair-overlay-face))) - "The face used to highlight wrap tag overlays." - :group 'smartparens) - -(defvar-local sp-pair-overlay-list '() - "List of overlays used for tracking inserted pairs. - -When a pair is inserted, an overlay is created over it. When the -user starts typing the closing pair we will not insert it again. -If user leaves the overlay, it is canceled and the insertion -works again as usual.") - -(defvar-local sp-wrap-overlays nil - "Cons pair of wrap overlays.") - -(defvar-local sp-wrap-tag-overlays nil - "Cons pair of tag wrap overlays.") - -(defvar sp-pair-overlay-keymap (make-sparse-keymap) - "Keymap for the pair overlays.") -(define-key sp-pair-overlay-keymap (kbd "C-g") - '(menu-item nil sp-remove-active-pair-overlay :filter - (lambda (cmd) - (unless (bound-and-true-p company-my-keymap) - cmd)))) - -(defvar sp-wrap-overlay-keymap (make-sparse-keymap) - "Keymap for the wrap overlays.") -(define-key sp-wrap-overlay-keymap (kbd "C-g") 'sp-wrap-cancel) - -(defun sp--overlays-at (&optional pos) - "Wrapper around `overlays-at' to get smartparens overlays. - -POS is the same as for `overlays-at'. - -Smartparens functions must use this function instead of -`overlays-at' directly." - ;; TODO: we should probably also check the returned value - (--filter (overlay-get it 'type) (overlays-at (or pos (point))))) - -(defun sp--point-in-overlay-p (overlay) - "Return t if point is in OVERLAY." - (and (< (point) (overlay-end overlay)) - (> (point) (overlay-start overlay)))) - -(defun sp--get-overlay-length (overlay) - "Compute the length of OVERLAY." - (- (overlay-end overlay) (overlay-start overlay))) - -(defun sp--get-active-overlay (&optional type) - "Get active overlay. - -Active overlay is the shortest overlay at point. Optional -argument TYPE restrict overlays to only those with given type." - (let ((overlays (sp--overlays-at))) - (when type - (setq overlays (--filter (eq (overlay-get it 'type) type) overlays))) - (cond - ((not overlays) nil) - ((not (cdr overlays)) (car overlays)) - (t - (--reduce (if (< (sp--get-overlay-length it) (sp--get-overlay-length acc)) it acc) overlays))))) - -(defun sp--pair-overlay-create (start end id) - "Create an overlay over the currently inserted pair. - -This overlay is used for tracking the position of the point and -marks the active expression. START and END are the boundaries of -the overlay, ID is the id of the pair." - (let ((overlay (make-overlay start end))) - ;; set priority to 99 so that yasnippet with 100 overloads the - ;; keymap #625 - (overlay-put overlay 'priority 99) - (overlay-put overlay 'keymap sp-pair-overlay-keymap) - (overlay-put overlay 'pair-id id) - (overlay-put overlay 'type 'pair) - (!cons overlay sp-pair-overlay-list) - (sp--pair-overlay-fix-highlight) - (add-hook 'post-command-hook 'sp--pair-overlay-post-command-handler nil t))) - -(defun sp-wrap-cancel () - "Cancel the active wrapping." - (interactive) - (unwind-protect - (-let (((obeg . oend) sp-wrap-overlays)) - (when (and (not (called-interactively-p 'any)) - (sp--delete-selection-p)) - (kill-region (overlay-end obeg) (overlay-start oend))) - (delete-region (overlay-start oend) (overlay-end oend)) - (when (> sp-wrap-point sp-wrap-mark) - (let ((beg (delete-and-extract-region (overlay-start obeg) (overlay-end obeg)))) - (goto-char (overlay-start oend)) - (insert beg)))) - (sp-wrap--clean-overlays))) - -(defun sp-wrap--clean-overlays () - "Delete wrap overlays." - (-let [(obeg . oend) sp-wrap-overlays] - (delete-overlay obeg) - (delete-overlay oend) - (setq sp-wrap-overlays nil))) - -(defun sp--pair-overlay-fix-highlight () - "Fix highlighting of the pair overlays. - -Only the active overlay should be highlighted." - (--each (sp--overlays-at) (overlay-put it 'face nil)) - (let* ((active (sp--get-active-overlay)) - (type (and active (overlay-get active 'type)))) - (if active - (cond - ((eq 'wrap-tag type) - (when sp-highlight-wrap-tag-overlay - (overlay-put active 'face 'sp-wrap-tag-overlay-face))) - ((eq 'pair type) - (when sp-highlight-pair-overlay - (overlay-put active 'face 'sp-pair-overlay-face)))) - ;; edge case where we're at the end of active overlay. If - ;; there is a wrap-tag overlay, restore it's face - (when sp-wrap-tag-overlays - (overlay-put (car sp-wrap-tag-overlays) 'face 'sp-wrap-tag-overlay-face))))) - -(defun sp--pair-overlay-post-command-handler () - "Remove all invalid pair overlays. - -An invalid overlay is one that doesn't have point inside it or -is of zero length. - -Also remove all pair overlays if point moved backwards and -`sp-cancel-autoskip-on-backward-movement' is non-nil." - ;; if the point moved backwards, remove all overlays - (if (and sp-cancel-autoskip-on-backward-movement - (< (point) sp-previous-point)) - (dolist (o sp-pair-overlay-list) (sp--remove-overlay o)) - ;; else only remove the overlays where point is outside them or - ;; their length is zero - (dolist (o (--remove (and (sp--point-in-overlay-p it) - (> (sp--get-overlay-length it) 0)) - sp-pair-overlay-list)) - (sp--remove-overlay o))) - (when sp-pair-overlay-list - (setq sp-previous-point (point)))) - -(defun sp--reset-memoization (&rest ignored) - "Reset memoization as a safety precaution. - -IGNORED is a dummy argument used to eat up arguments passed from -the hook where this is executed." - (setf (sp-state-last-syntax-ppss-point sp-state) nil - (sp-state-last-syntax-ppss-result sp-state) nil)) - -(defun sp-remove-active-pair-overlay () - "Deactivate the active overlay. See `sp--get-active-overlay'." - (interactive) - (-when-let (active-overlay (sp--get-active-overlay 'pair)) - (sp--remove-overlay active-overlay))) - -(defun sp--remove-overlay (overlay) - "Remove OVERLAY." - ;; if it's not a pair overlay, nothing happens here anyway - (setq sp-pair-overlay-list (--remove (equal it overlay) sp-pair-overlay-list)) - ;; if we have zero pair overlays, remove the post-command hook - (when (not sp-pair-overlay-list) - (remove-hook 'post-command-hook 'sp--pair-overlay-post-command-handler t) - ;; this is only updated when sp--pair-overlay-post-command-handler - ;; is active. Therefore, we need to reset this to 1. If not, newly - ;; created overlay could be removed right after creation - if - ;; sp-previous-point was greater than actual point - (setq sp-previous-point -1)) - (delete-overlay overlay) - (sp--pair-overlay-fix-highlight)) - -(defun sp--replace-overlay-text (o string) - "Replace text inside overlay O with STRING." - (save-excursion - (goto-char (overlay-start o)) - (insert string) - (delete-region (point) (overlay-end o)))) - -(defun sp--get-overlay-text (o) - "Get text inside overlay O." - (buffer-substring (overlay-start o) (overlay-end o))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Action predicates - -(defun sp-in-string-p (_id _action context) - "Return t if point is inside string or comment, nil otherwise." - (eq context 'string)) - -(defun sp-in-string-quotes-p (_id action context) - "Special string test for quotes. - -On insert action, test the string context one character back from -point. Return nil at `bobp'. - -On escape action use the value of CONTEXT." - (cond - ((eq action 'insert) - (if (bobp) nil - (save-excursion (backward-char 1) (sp-point-in-string)))) - ((eq action 'escape) - (eq context 'string)))) - -(defun sp-in-docstring-p (_id _action context) - "Return t if point is inside elisp docstring, nil otherwise." - (and (eq context 'string) - (save-excursion - (--when-let (car (sp-get-quoted-string-bounds)) - (goto-char it) - (ignore-errors (backward-sexp 3)) - (looking-at-p (regexp-opt '("defun" "defmacro" - "cl-defun" "cl-defmacro" - "defun*" "defmacro*" - "lambda" "-lambda"))))))) - -(defun sp-in-code-p (_id _action context) - "Return t if point is inside code, nil otherwise." - (eq context 'code)) - -(defun sp-in-comment-p (_id _action context) - "Return t if point is inside comment, nil otherwise." - (eq context 'comment)) - -(defun sp-in-math-p (_id _action _context) - "Return t if point is inside code, nil otherwise." - (when (functionp 'texmathp) - (texmathp))) - -(defun sp-point-before-eol-p (_id action _context) - "Return t if point is followed by optional white spaces and end of line, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-at-p "\\s-*$"))) - -(defun sp-point-after-bol-p (id action _context) - "Return t if point follows beginning of line and possibly white spaces, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-back-p (concat "^\\s-*" (regexp-quote id))))) - -(defun sp-point-at-bol-p (id action _context) - "Return t if point is at the beginning of line, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-back-p (concat "^" (regexp-quote id))))) - -(defun sp-point-before-symbol-p (_id action _context) - "Return t if point is followed by a symbol, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-at-p "\\s_"))) - -(defun sp-point-before-word-p (_id action _context) - "Return t if point is followed by a word, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-at-p "\\sw\\|\\s_"))) - -(defun sp-point-after-word-p (id action _context) - "Return t if point is after a word, nil otherwise. -This predicate is only tested on \"insert\" action." - ;; TODO: remove condition with sp-defpair - (when (memq action '(insert escape)) - (sp--looking-back-p (concat "\\(\\sw\\|\\s_\\)" (regexp-quote id))))) - -(defun sp-point-before-same-p (id action _context) - "Return t if point is followed by ID, nil otherwise. -This predicate is only tested on \"insert\" action." - (when (eq action 'insert) - (sp--looking-at-p (regexp-quote id)))) - -(defun sp-point-in-empty-line-p (id _action _context) - "Return t if point is on an empty line, nil otherwise." - (and (sp--looking-at-p "\\s-*$") - (sp--looking-back-p (concat "^\\s-*" (regexp-quote id))))) - -(defun sp-char-escaped-p (_id action _context) - "Return non-nil if character before point is escaped with \\." - (when (eq action 'insert) - (unless (= (point) (point-min)) - (save-excursion - (backward-char 1) - (looking-back "\\\\" 1))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Pair insertion/deletion/skipping - -(defun sp--do-action-p (id action &optional use-inside-string) - "Return t if pair ID can perform ACTION. - -If ACTION is a list, return t if at least one action from the -list can be performed. - -If USE-INSIDE-STRING is non-nil, use value of -`sp-point-inside-string' instead of testing with -`sp-point-in-string-or-comment'." - (setq action (-flatten (list action))) - (let* ((actions (sp-get-pair id :actions)) - (when-l (sp-get-pair id :when)) - (unless-l (sp-get-pair id :unless)) - (in-string (if use-inside-string - sp-point-inside-string - (sp-point-in-string))) - (context (cond - (in-string 'string) - ((sp-point-in-comment) 'comment) - (t 'code))) - a r) - (while (and action (not r)) - (setq a (car action)) - (setq r (when (memq a actions) - ;;(and (when-clause) (not (unless-clause))) - (and (or (not when-l) - (--some (funcall it id a context) when-l)) - (or (not unless-l) - (not (--some (funcall it id a context) unless-l)))))) - (!cdr action)) - r)) - -(defun sp--get-handler-context (type) - "Return the context constant. TYPE is type of the handler." - (let ((in-string (cl-case type - (:pre-handlers - (save-excursion - (unless (bobp) (backward-char 1)) - (sp-point-in-string-or-comment))) - (:post-handlers - (sp-point-in-string-or-comment))))) - (if in-string 'string 'code))) - -(defun sp--get-context (&optional point in-string in-comment) - "Return the context of POINT. - -If the optional arguments IN-STRING or IN-COMMENT non-nil, their -value is used instead of a test." - (save-excursion - (goto-char (or point (point))) - (cond - ((or in-string (sp-point-in-string)) 'string) - ((or in-comment (sp-point-in-comment)) 'comment) - (t 'code)))) - -(defun sp--parse-insertion-spec (fun) - "Parse the insertion specification FUN and return a form to evaluate." - (let ((spec nil) - (after nil) - (last 1)) - (cl-labels ((push-non-empty - (what) - (unless (equal (cadr what) "") - (push what spec)))) - (with-temp-buffer - (insert fun) - (goto-char (point-min)) - (while (re-search-forward "\\(|\\|\\[\\)" nil t) - (cond - ((equal (match-string 0) "[") - (if (save-excursion (backward-char 1) (eq (preceding-char) 92)) - (push-non-empty `(insert ,(concat (buffer-substring-no-properties last (- (point) 2)) "["))) - (push-non-empty `(insert ,(buffer-substring-no-properties last (1- (point))))) - (let* ((p (point)) - (fun-end (progn - (re-search-forward "]" nil t) - (1- (point)))) - (fun-spec (buffer-substring-no-properties p fun-end)) - (instruction (cond - ((equal fun-spec "i") - '(indent-according-to-mode)) - ((equal (aref fun-spec 0) ?d) - `(delete-char ,(string-to-number (substring fun-spec 1))))))) - (when instruction (push instruction spec))))) - ((equal (match-string 0) "|") - (cond - ((save-excursion (backward-char 1) (eq (preceding-char) 92)) - (push-non-empty `(insert ,(concat (buffer-substring-no-properties last (- (point) 2)) "|")))) - (t - (push-non-empty `(insert ,(buffer-substring-no-properties last (1- (point))))) - (push 'save-excursion spec) - (when (eq (following-char) 124) - (forward-char 1) - (setq after '(indent-according-to-mode))))))) - (setq last (point))) - (push-non-empty `(insert ,(buffer-substring-no-properties last (point-max))))) - (let* ((specr (nreverse spec)) - (specsplit (--split-with (not (eq it 'save-excursion)) specr)) - (re (-concat (car specsplit) (if (cadr specsplit) (cdr specsplit) nil)))) - (cons 'progn (if after (-snoc re after) re)))))) - -(defun sp--run-function-or-insertion (fun id action context) - "Run a function or insertion. - -If FUN is a function, call it with `funcall' with ID, ACTION and -CONTEXT as arguments. - -If FUN is a string, interpret it as \"insertion specification\", -see `sp-pair' for description." - (cond - ((functionp fun) - (funcall fun id action context)) - ((stringp fun) - (eval (sp--parse-insertion-spec fun))))) - - -(defvar sp-handler-context nil - "Special variable holding context during handler execution.") - -;; TODO: get rid of `sp-handler-context' and make all the handlers (we -;; should call them hooks) take better arguments, what we pass now is -;; useless almost always -(defun sp--run-hook-with-args (id type action &optional context-values) - "Run all the hooks for pair ID of type TYPE on action ACTION. - -CONTEXT-VALUES is a plist with arbitrary values (depending on the -action). A dynamic varable `sp-handler-context' will be bound to -this value during execution of the handler." - (ignore-errors - (let ((hook (sp-get-pair id type)) - (context (sp--get-handler-context type))) - (if hook - (let ((sp-handler-context context-values)) - (--each hook (sp--run-function-or-insertion it id action context))) - (run-hook-with-args 'tag-hook id action context))))) - -;; TODO: add a test for a symbol property that would tell this handler -;; not to re=set `sp-last-operation'. Useful for example in "macro -;; functions" like `my-wrap-with-paren'. -(defun sp--post-command-hook-handler () - "Handle the situation after some command has executed." - (sp--with-case-sensitive - (when (sp--special-self-insert-command-p) - (sp--post-self-insert-hook-handler)) - (ignore-errors - (when smartparens-mode - ;; handle the wrap overlays - (when sp-wrap-overlays - (let* ((overlay (car sp-wrap-overlays)) - (start (overlay-start overlay)) - (end (overlay-end overlay)) - (p (point))) - (when (or (< p sp-previous-point) - (> p end) - (< p start)) - (sp-wrap-cancel)))) - (when sp-wrap-overlays - (setq sp-previous-point (point))) - - ;; Here we run the delayed hooks. See issue #80 - (cond - ((eq (car-safe (sp-state-delayed-hook sp-state)) :next) - (setf (car (sp-state-delayed-hook sp-state)) :this)) - ((eq (car-safe (sp-state-delayed-hook sp-state)) :this) - (let* ((pair (cdr (sp-state-delayed-hook sp-state))) - (hooks (sp-get-pair pair :post-handlers-cond))) - (--each hooks - (let ((fun (car it)) - (conds (cdr it))) - (when (or (--any? (eq this-command it) conds) - (--any? (equal (single-key-description last-command-event) it) conds)) - (sp--run-function-or-insertion - fun pair 'insert - (sp--get-handler-context :post-handlers))))) - (setf (sp-state-delayed-hook sp-state) nil) - (setq sp-last-inserted-pair nil)))) - - ;; Here we run the delayed insertion. Some details in issue #113 - (when (and (not (eq sp-last-operation 'sp-insert-pair-delayed)) - sp-delayed-pair) - (let* ((pair (car sp-delayed-pair)) - (beg (cdr sp-delayed-pair)) - (conds (sp-get-pair pair :when-cond)) - (open-pair pair) - (close-pair (sp-get-pair pair :close))) - (when (and conds - (--any? (cond - ((and (commandp it) - (not (stringp it))) - (eq this-command it)) - ((stringp it) - (equal (single-key-description last-command-event) it)) - ((ignore-errors (funcall it pair 'insert (sp--get-handler-context :post-handlers))))) conds)) - ;; TODO: refactor this and the same code in - ;; `sp-insert-pair' to a separate function - (sp--run-hook-with-args open-pair :pre-handlers 'insert) - (insert close-pair) - (backward-char (length close-pair)) - (sp--pair-overlay-create beg - (+ (point) (length close-pair)) - open-pair) - ;; no auto-escape here? Should be fairly safe - (sp--run-hook-with-args open-pair :post-handlers 'insert) - (setq sp-last-inserted-pair open-pair) - ;; TODO: this is probably useless - (setq sp-last-operation 'sp-insert-pair))) - (setq sp-delayed-pair nil)) - - (when (eq sp-last-operation 'sp-insert-pair-delayed) - (setq sp-last-operation nil)) - - (unless (or (sp--self-insert-command-p) - (sp--special-self-insert-command-p)) - ;; unless the last command was a self-insert, remove the - ;; information about the last wrapped region. It is only used - ;; for: 1. deleting the wrapping immediately after the wrap, - ;; 2. re-wrapping region immediatelly after a sucessful wrap. - ;; Therefore, the deletion should have no ill-effect. If the - ;; necessity will arise, we can add a different flag. - (setq sp-last-wrapped-region nil) - (setq sp-last-operation nil)) - - (when show-smartparens-mode - (if (member this-command sp-show-enclosing-pair-commands) - (sp-show--pair-enc-function) - (when (not (eq this-command 'sp-highlight-current-sexp)) - (sp-show--pair-delete-enc-overlays)))))))) - -(defmacro sp--setaction (action &rest forms) - "Use ACTION as a flag to evaluating FORMS. - -If ACTION is nil, evaluate FORMS and set it to the value of the -last form; otherwise do nothing." - (declare (debug (form body))) - `(unless ,action - (setq ,action (progn ,@forms)))) - -;; TODO: this introduces a regression, where doing C-4 [ inserts [[[[] -;; figure out how to detect the argument to self-insert-command that -;; resulted to this insertion -(defun sp--post-self-insert-hook-handler () - "Handler for `post-self-insert-hook'." - (with-demoted-errors "sp--post-self-insert-hook-handler: %S" - (when smartparens-mode - (sp--with-case-sensitive - (catch 'done - (let (action) - (when (region-active-p) - (condition-case err - (sp-wrap--initialize) - (user-error - (message (error-message-string err)) - ;; we need to remove the undo record of the insertion - (unless (eq buffer-undo-list t) - ;; pop all undo info until we hit an insertion node - (sp--undo-pop-to-last-insertion-node) - ;; get rid of it and insert an undo boundary marker - (pop buffer-undo-list) - (undo-boundary)) - (restore-buffer-modified-p sp-buffer-modified-p) - (throw 'done nil)))) - (cond - (sp-wrap-overlays - (sp-wrap)) - (t - ;; TODO: this does not pick correct pair!! it uses insert and not wrapping code - (sp--setaction - action - (-when-let ((_ . open-pairs) (sp--all-pairs-to-insert nil 'wrap)) - (catch 'done - (-each open-pairs - (-lambda ((&keys :open open :close close)) - (--when-let (sp--wrap-repeat-last (cons open close)) - (throw 'done it))))))) - (unless overwrite-mode (sp--setaction action (sp-insert-pair))) - (sp--setaction action (sp-skip-closing-pair)) - (unless action (sp-escape-open-delimiter)) - ;; if nothing happened, we just inserted a character, so - ;; set the apropriate operation. - (unless action - (setq sp-last-operation 'sp-self-insert)))))))))) - -;; Unfortunately, some modes rebind "inserting" keys to their own -;; handlers but do not hand over the insertion back to -;; `self-insert-command', rather, they insert via `insert'. -;; Therefore, we need to call this handler in `post-command-hook' too. -;; The list `sp--special-self-insert-commands' specifies which -;; commands to handle specially. -(add-hook 'post-self-insert-hook 'sp--post-self-insert-hook-handler) - -;; TODO: make a proper data structure for state tracking and describe -;; why we need each of these. -(defun sp--save-pre-command-state () - "Save some of the buffer state before `pre-command-hook'." - (when smartparens-mode - (setq sp-point-inside-string (sp-point-in-string)) - (setq sp-pre-command-point (point)) - (setq sp-buffer-modified-p (buffer-modified-p)))) - -(add-hook 'pre-command-hook 'sp--save-pre-command-state) - -(defun sp--get-pair-list () - "Get all non-stringlike pairs. - -Return all pairs that are recognized in this `major-mode' and do -not have same opening and closing delimiter. This is used for -navigation functions." - (--filter (not (string= (car it) (cdr it))) sp-pair-list)) - -(defun sp--get-stringlike-list () - "Get all string-like pairs. - -Return all pairs that are recognized in this `major-mode' that -have same opening and closing delimiter." - (--filter (string= (car it) (cdr it)) sp-pair-list)) - -(defun sp--get-allowed-pair-list () - "Get all allowed non string-like pairs. - -Return all pairs that are recognized in this `major-mode', do not -have same opening and closing delimiter and are allowed in the -current context. See also `sp--get-pair-list'." - (--filter (and (sp--do-action-p (car it) 'navigate) - (not (equal (car it) (cdr it)))) sp-pair-list)) - -(defun sp--get-allowed-stringlike-list () - "Get all allowed string-like pairs. - -Return all pairs that are recognized in this `major-mode', -have the same opening and closing delimiter and are allowed in -the current context." - (--filter (and (sp--do-action-p (car it) 'navigate) - (equal (car it) (cdr it))) sp-pair-list)) - -(defun sp--get-pair-list-context (&optional action) - "Return all pairs that are recognized in this `major-mode' and -are allowed in the current context." - (setq action (or action 'insert)) - (--filter (sp--do-action-p (car it) action) sp-pair-list)) - -(defun sp--get-pair-list-wrap () - "Return the list of all pairs that can be used for wrapping." - (--filter (sp--do-action-p (car it) 'wrap) sp-pair-list)) - -(defun sp--wrap-regexp (string start end) - "Wraps regexp with start and end boundary conditions to avoid -matching symbols in symbols." - (concat "\\(?:" (when start "\\<") string (when end "\\>") "\\)")) - -(defun sp--regexp-for-group (parens &rest strings) - "Generates an optimized regexp matching all string, but with -extra boundary conditions depending on parens." - (let* ((start (car parens)) - (end (cadr parens))) - (sp--wrap-regexp (regexp-opt strings) start end))) - -(defun sp--strict-regexp-opt (strings &optional ignored) - "Like regexp-opt, but with extra boundary conditions to ensure -that the strings are not matched in-symbol." - (if strings - (with-syntax-table - ;; HACK: this is a terrible hack to make ' be treated as a - ;; punctuation. Many text modes set it as word character which - ;; messes up the regexps - (let ((table (make-syntax-table (syntax-table)))) - (modify-syntax-entry ?' "." table) - table) - (--> strings - (-group-by (lambda (string) - (list (and (string-match-p "\\`\\<" string) t) - (and (string-match-p "\\>\\'" string) t))) - it) - (mapconcat (lambda (g) (apply 'sp--regexp-for-group g)) it "\\|") - (concat "\\(?:" it "\\)"))) - "^\\<$")) - -(defun sp--strict-regexp-quote (string) - "Like regexp-quote, but make sure that the string is not -matched in-symbol." - (sp--wrap-regexp (regexp-quote string) - (string-match-p "\\`\\<" string) - (string-match-p "\\>\\'" string))) - -(cl-defun sp--get-opening-regexp (&optional (pair-list (sp--get-pair-list))) - "Return regexp matching any opening pair." - (sp--strict-regexp-opt (--map (car it) pair-list))) - -(cl-defun sp--get-closing-regexp (&optional (pair-list (sp--get-pair-list))) - "Return regexp matching any closing pair." - (sp--strict-regexp-opt (--map (cdr it) pair-list))) - -(cl-defun sp--get-allowed-regexp (&optional (pair-list (sp--get-allowed-pair-list))) - "Return regexp matching any opening or closing -delimiter for any pair allowed in current context." - (sp--strict-regexp-opt (--mapcat (list (car it) (cdr it)) pair-list))) - -(cl-defun sp--get-stringlike-regexp (&optional (pair-list (sp--get-allowed-stringlike-list))) - "Return a regexp matching any string-like delimiter. - -In case PAIR-LIST is empty return a regexp that never matches -anything." - (if (consp pair-list) - (regexp-opt (--map (car it) pair-list)) - "^\\<$")) - -(defun sp--get-last-wraped-region (beg end open close) - "Return `sp-get-sexp' style plist about the last wrapped region. - -Note: this function does not retrieve the actual value of -`sp-last-wrapped-region', it merely construct the plist from the -provided values." - (let ((b (make-marker)) - (e (make-marker))) - (set-marker b beg) - (set-marker e end) - (set-marker-insertion-type e t) - `(:beg ,b :end ,e :op ,open :cl ,close :prefix ""))) - -;; Wrapping is basically the same thing as insertion, only the closing -;; pair is placed at a distance. - -;; However, we want to be able to insert the *closing* delimiter and -;; go to the end of block. This will only work with delimiters which -;; are unique wrt their opening one. For more complex wrapping, there -;; will probably be an IDO/minibuffer interface. Openings are checked -;; first. - -;; Inserting the opening delimiter should put the point wherever it -;; was when we started insertion. - -(defun sp-wrap--can-wrap-p () - "Return non-nil if we can wrap a region. - -This is used in advices on various pre-command-hooks from -\"selection deleting\" modes to intercept their actions. - -Also added to `self-insert-uses-region-functions' to prevent -`delete-selection-mode' from replacing the region." - (let* ((list (sp--get-pair-list-wrap)) - (desc (sp--single-key-description last-command-event))) - (--any? (or (string-prefix-p desc (car it)) - (string-prefix-p desc (cdr it))) - list))) - -(defun sp--pair-to-wrap-comparator (prop a b) - "Comparator for wrapping pair selection. - -PROP specifies wrapping-end. A and B are pairs to be compared." - (< (length (plist-get a prop)) (length (plist-get b prop)))) - -(defun sp--pair-to-wrap (&optional prefix) - "Return information about possible wrapping pairs. - -If optional PREFIX is non-nil, this is used to determine the -possible wrapping pairs instead of the text in the wrapping -overlay." - (let* ((working-pairs - ;; TODO: abstract this into a new "sp--get-..." hierarchy - (--filter (sp--do-action-p (plist-get it :open) 'wrap) sp-local-pairs)) - (obeg (car sp-wrap-overlays)) - (prefix (or prefix (sp--get-overlay-text obeg))) - (opening-pairs (--filter (string-prefix-p prefix (plist-get it :open)) working-pairs)) - ;; HACK: Here, we will add special "trigger pairs" to the - ;; opening list. We set the opening delimiter to the - ;; trigger, leave the rest alone and put the real open into - ;; :open-real property. When we get the pair back, we will - ;; check this property, and if present, fix the pair back to - ;; the regular form - (wrapper-pairs (->> (--filter (string-prefix-p prefix (or (plist-get it :trigger-wrap) "")) working-pairs) - (-map (-lambda ((pair &as &plist :open open :trigger-wrap trigger-wrap)) - (setq pair (copy-sequence pair)) - (setq pair (plist-put pair :open trigger-wrap)) - (setq pair (plist-put pair :open-real open)) - pair)))) - (opening-pairs (-concat wrapper-pairs opening-pairs)) - (closing-pairs (--filter (string-prefix-p prefix (plist-get it :close)) working-pairs)) - (open (car (--sort (sp--pair-to-wrap-comparator :open it other) opening-pairs))) - ;; TODO: do we need the special sorting here? - (close (car (--sort (sp--pair-to-wrap-comparator :close it other) closing-pairs)))) - (list :open open - :close close - :opening opening-pairs - :closing closing-pairs))) - -(defun sp-wrap--initialize () - "Initialize wrapping." - (when (and sp-autowrap-region - (sp-wrap--can-wrap-p)) - ;; This is the length of string which was inserted by the last - ;; "self-insert" action. Typically this is 1, but sometimes a - ;; single key inserts two or more characters, such as " in latex - ;; where it translates into `` or ''. - (let ((inserted-string-length (- (point) sp-pre-command-point))) - ;; TODO: get rid of the following variables - (setq sp-wrap-point (- (point) inserted-string-length)) - (setq sp-wrap-mark (mark)) - ;; balance check - (with-silent-modifications - (let ((inserted-string - (prog1 (delete-and-extract-region sp-wrap-point (point)) - ;; HACK: in modes with string fences, the insertion - ;; of the delimiter causes `syntax-propertize' to - ;; fire, but the above deletion doesn't re-run it - ;; because the cache tells it the state is OK. We - ;; need to destroy the cache and re-run the - ;; `syntax-propertize' on the buffer. This might be - ;; expensive, but we only done this on wrap-init so - ;; it's fine, I guess. - (setq syntax-propertize--done -1) - (syntax-propertize (point-max)))) - (point-string-context (sp-get-quoted-string-bounds sp-wrap-point)) - (mark-string-context (sp-get-quoted-string-bounds (mark)))) - ;; If point and mark are inside the same string, we don't - ;; need to check if the region is OK. If both are outisde - ;; strings, we have to. If one is inside and the other is - ;; not, no matter what we would break, so we exit. - (cond - ;; inside the same string - ((and point-string-context mark-string-context - (eq (car point-string-context) - (car mark-string-context)))) - ;; neither is inside string - ((and (not point-string-context) - (not mark-string-context)) - (unless (sp-region-ok-p sp-wrap-point (mark)) - (user-error "Mismatched sexp state: wrapping would break structure"))) - ;; one is in and the other isn't - ((if point-string-context (not mark-string-context) mark-string-context) - (user-error "Mismatched string state: point %sin string, mark %sin string" - (if (car-safe point-string-context) "" "not ") - (if (car-safe mark-string-context) "" "not "))) - ;; both are in but in different strings - (t (user-error "Mismatched string state: point and mark are inside different strings"))) - (insert inserted-string))) - ;; if point > mark, we need to move point to mark and reinsert the - ;; just inserted character. - (when (> (point) (mark)) - (let ((char (delete-and-extract-region (- (point) inserted-string-length) (point)))) - (exchange-point-and-mark) - (insert char))) - (let* ((oleft (make-overlay (- (region-beginning) inserted-string-length) - (region-beginning) nil nil t)) - (oright (make-overlay (region-end) (region-end) nil nil t))) - (setq sp-wrap-overlays (cons oleft oright)) - (when sp-highlight-wrap-overlay - (overlay-put oleft 'face 'sp-wrap-overlay-face) - (overlay-put oright 'face 'sp-wrap-overlay-face)) - (overlay-put oleft 'priority 100) - (overlay-put oright 'priority 100) - (overlay-put oleft 'keymap sp-wrap-overlay-keymap) - (overlay-put oleft 'type 'wrap) - (setq sp-previous-point (point)) - (goto-char (1+ (overlay-start oleft))))))) - -(defun sp-wrap--finalize (wrapping-end open close) - "Finalize a successful wrapping. - -WRAPPING-END specifies the wrapping end. If we wrapped using -opening delimiter it is :open. If we wrapped using closing -delimiter it is :close. Position of point after wrapping depends -on this value---if :open, go where the wrapping was initalized, -if :close, go after the newly-formed sexp. - -OPEN and CLOSE are the delimiters." - (-let (((obeg . oend) sp-wrap-overlays)) - (sp--replace-overlay-text obeg open) - (sp--replace-overlay-text oend close) - (setq sp-last-operation 'sp-wrap-region) - (setq sp-last-wrapped-region - (sp--get-last-wraped-region - (overlay-start obeg) (overlay-end oend) - open close)) - (cond - ((eq wrapping-end :open) - (if sp-wrap-respect-direction - (progn - (set-mark (overlay-end oend)) - (goto-char (overlay-start obeg))) - (when (> sp-wrap-point sp-wrap-mark) - (set-mark (overlay-start obeg)) - (goto-char (overlay-end oend))))) - ((eq wrapping-end :close) - (set-mark (overlay-start obeg)) - (goto-char (overlay-end oend)))) - (sp-wrap--clean-overlays) - (sp--run-hook-with-args open :post-handlers 'wrap))) - -(defun sp-wrap () - "Try to wrap the active region with some pair. - -This function is not ment to be used to wrap sexps with pairs -programatically. Use `sp-wrap-with-pair' instead." - (-let* (((&plist :open open :close close - :opening opening-pairs - :closing closing-pairs) (sp--pair-to-wrap)) - ((obeg . oend) sp-wrap-overlays)) - (cond - (open - (-let (((&plist :open open :close close :open-real open-real) open)) - (when sp-wrap-show-possible-pairs - (overlay-put - oend 'after-string - (mapconcat (lambda (x) - (if sp-highlight-wrap-overlay - (concat - (propertize - (plist-get x :open) 'face - 'sp-wrap-overlay-opening-pair) - (propertize - (plist-get x :close) - 'face 'sp-wrap-overlay-closing-pair)) - (concat (plist-get x :open) (plist-get x :close)))) - opening-pairs " "))) - (when (equal (sp--get-overlay-text obeg) open) - (sp-wrap--finalize :open (or open-real open) close)))) - ((and close (= 1 (length closing-pairs))) - (-let (((&plist :open open :close close) close)) - (when (equal (sp--get-overlay-text obeg) close) - (sp-wrap--finalize :close open close)))) - (t - (sp-wrap-cancel))))) - -(defun sp--escape-region (chars-to-escape beg end) - "Escape instances of CHARS-TO-ESCAPE between BEG and END. - -Return non-nil if at least one escaping was performed." - (save-excursion - (goto-char beg) - (let ((pattern (regexp-opt chars-to-escape)) - (end-marker (set-marker (make-marker) end)) - (re nil)) - (while (re-search-forward pattern end-marker t) - (setq re t) - (save-excursion - (goto-char (match-beginning 0)) - (insert sp-escape-char))) - re))) - -;; TODO: refactor the rewrap-sexp dependent parts out so that this -;; function has less dependencies on the action -;; TODO: add mode-dependent escape/unescape actions? -(defun sp-escape-wrapped-region (id action _context) - "Escape quotes and special chars when a region is (re)wrapped." - (when (and sp-escape-wrapped-region - (memq action '(wrap rewrap-sexp))) - (sp-get sp-last-wrapped-region - (let* ((parent-delim (save-excursion - (goto-char :beg) - (sp-get (sp-get-string) - (cond - ((and (< :beg (point)) - (< (point) :end)) - :op) - ((eq action 'rewrap-sexp) - (plist-get sp-handler-context :parent))))))) - (cond - ((equal parent-delim id) - (sp--escape-region (list id sp-escape-char) :beg :end)) - (parent-delim - (sp--escape-region (list id) :beg-in :end-in)) - (t - (sp--escape-region (list id sp-escape-char) :beg-in :end-in))))))) - -(defun sp-escape-quotes-after-insert (id action context) - "Escape quotes inserted via `sp-insert-pair'." - (when (and sp-escape-quotes-after-insert - (eq action 'insert) - ;; we test not being inside string because if we were - ;; before inserting the "" pair it is now split into two - ;; -> which moves us outside the pair - (not (eq context 'string)) - ;; the inserted character must have string syntax, - ;; otherwise no "context" flip happens - (eq (syntax-class - (syntax-after - (save-excursion - (backward-char (length id)) - (point)))) 7)) - (let ((open id) - (close (sp-get-pair id :close))) - (sp--escape-region (list open close) - (- (point) (length open)) - (+ (point) (length close)))))) - -(defun sp--buffer-is-string-balanced-p () - "Check if the buffer is string-balanced. - -A string-balanced buffer is one where where is no unclosed -string, that is, the string state at the end of the buffer is -\"closed\"." - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (let ((syntax (sp--syntax-ppss))) - (or (< (car syntax) 0) - (nth 3 syntax)))))) - -(defun sp-escape-open-delimiter () - "Escape just inserted opening pair if `sp-insert-pair' was skipped. - -This is useful for escaping of \" inside strings when its pairing -is disabled. This way, we can control autoescape and closing -delimiter insertion separately." - (-when-let (open (plist-get (sp--pair-to-insert 'escape) :open)) - (when (and (sp--do-action-p open 'escape) - sp-point-inside-string - ;; do not escape if we are looking at a closing - ;; delimiter, that means we closed an opened string, - ;; most likely. - (sp--buffer-is-string-balanced-p) - ;; in some text modes like org-mode which do not - ;; respect escapes, an "escaped" quote will still - ;; behave as regular quote, but we want to ignore it to - ;; be logically consistent. This will prevent a buffer - ;; with \" followed by newly inserted " auto-escaping - ;; the inserted quotes (which actually closes the - ;; string and makes the buffer balanced) - (save-excursion - (backward-char (length open)) - (-when-let (string-start (nth 8 (sp--syntax-ppss))) - (goto-char string-start) - (not (sp-char-is-escaped-p))))) - (sp--escape-region (list open) (- (point) (length open)) (point))))) - -;; kept to not break people's config... remove later -(defun sp-match-sgml-tags (tag) - "Split the html tag TAG at the first space and return its name." - (let* ((split (split-string tag " ")) - (close (car split))) - close)) -(make-obsolete 'sp-match-sgml-tags "do not use this function as the tag system has been removed." "2015-02-07") - -(defun sp--is-number-cons (c) - "Return non-nil if C is a cons cell with numbers at `car' and `cdr'." - (and (consp c) (numberp (car c)) (numberp (cdr c)))) - -;; TODO: more research is needed -(defun sp--undo-pop-to-last-insertion-node () - "Pop all undo info until an insertion node (beg . end) is found. - -This can potentially remove some undo important information." - (while (and buffer-undo-list - (or (null (car buffer-undo-list)) ;; is nil - ;; is not undo action we're interested in - (not (sp--is-number-cons (car buffer-undo-list))))) - (pop buffer-undo-list))) - -;; modified from: https://github.com/Fuco1/smartparens/issues/90#issuecomment-18800369 -(defun sp--split-last-insertion-undo (len) - "Split the last insertion node in the `buffer-undo-list' to -include separate pair node." - (sp--undo-pop-to-last-insertion-node) - (when buffer-undo-list - (let* ((previous-undo-actions (cdr buffer-undo-list)) - (beg (caar buffer-undo-list)) - (end (cdar buffer-undo-list)) - first-action second-action) - (unless (< beg (- end len)) - ;; We need to go back more than one action. Given the pairs - ;; are limited to 10 chars now and the chunks seem to be 20 - ;; chars, we probably wouldn't need more. - (pop buffer-undo-list) - (sp--undo-pop-to-last-insertion-node) - (when buffer-undo-list - (setq beg (caar buffer-undo-list)) - (setq previous-undo-actions (cdr buffer-undo-list)))) - (setq first-action (cons beg (- end len))) - (setq second-action (cons (- end len) end)) - (setq buffer-undo-list - (append (list nil second-action nil first-action) - previous-undo-actions))))) - -;; TODO: remove ACTION argument and make the selection process more -;; unified (see also sp--pair-to-wrap which depends on buffer state -;; among other things) -(defun sp--all-pairs-to-insert (&optional looking-fn action) - "Return all pairs that can be inserted at point. - -Return nil if such pair does not exist. - -Pairs inserted using a trigger have higher priority over pairs -without a trigger and only one or the other list is returned. - -In other words, if any pair can be inserted using a trigger, only -pairs insertable by trigger are returned. - -ACTION is an implementation detail. Usually it has the value -'insert when we determine pairs to insert. On repeated wrapping -however we pass the value 'wrap. This will be refactored away in -the upcoming version." - (setq looking-fn (or looking-fn 'sp--looking-back-p)) - (setq action (or action 'insert)) - (let ((working-pairs - ;; TODO: abstract this into a new "sp--get-..." hierarchy - (--filter (sp--do-action-p (plist-get it :open) action) sp-local-pairs))) - (-if-let (trigs (--filter (and (plist-get it :trigger) - (funcall looking-fn (sp--strict-regexp-quote (plist-get it :trigger)))) - working-pairs)) - (cons :trigger trigs) - (-when-let (pairs (--filter (funcall looking-fn (sp--strict-regexp-quote (plist-get it :open))) working-pairs)) - (cons :open pairs))))) - -(defun sp--pair-to-insert-comparator (prop a b) - (cond - ;; in case of triggers shorter always wins - ((eq prop :trigger) - (< (length (plist-get a :trigger)) (length (plist-get b :trigger)))) - ;; Shorter wins only if the shorter's closing is a prefix of the - ;; longer's closing. In other words, if we are looking at - ;; shorter's closing and we are trying to nest it. - (t - (if (< (length (plist-get a :open)) (length (plist-get b :open))) - (and (string-prefix-p (plist-get a :close) (plist-get b :close)) - (sp--looking-at-p (plist-get a :close))) - (not (and (string-prefix-p (plist-get b :close) (plist-get a :close)) - (sp--looking-at-p (plist-get b :close)))))))) - -(defun sp--pair-to-insert (&optional action) - "Return pair that can be inserted at point. - -Return nil if such pair does not exist. - -If more triggers or opening pairs are possible select the -shortest one." - (-when-let ((property . pairs) (sp--all-pairs-to-insert nil action)) - (car (--sort (sp--pair-to-insert-comparator property it other) pairs)))) - -(defun sp--longest-prefix-to-insert () - "Return pair with the longest :open which can be inserted at point." - (-when-let (pairs (--filter (sp--looking-back-p (sp--strict-regexp-quote (plist-get it :open))) sp-local-pairs)) - (car (--sort (> (length (plist-get it :open)) (length (plist-get other :open))) pairs)))) - -(defun sp--pair-to-uninsert () - "Return pair to uninsert. - -If the current to-be-inserted pair shares a prefix with -another (shorter) pair, we must first remove the effect of -inserting its closing pair before inserting the current one. - -The previously inserted pair must be the one with the longest -common prefix excluding the current pair." - (-when-let (lp (sp--longest-prefix-to-insert)) - (save-excursion - (backward-char (length (plist-get lp :open))) - (-when-let ((property . pairs) (sp--all-pairs-to-insert 'sp--looking-at-p)) - (car (--sort (> (length (plist-get it property)) (length (plist-get other property))) - ;; remove pairs whose open is longer than the - ;; current longest possible prefix---otherwise - ;; they would overflow to the closing pair - ;; TODO: this ignores the possibility when lp is - ;; inserted by trigger. We assume triggers are - ;; shorter than the openings and this situation, - ;; if ever, should be very rare - (--remove (>= (length (plist-get it :open)) - (length (plist-get lp :open))) pairs))))))) - -(defun sp--insert-pair-get-pair-info (active-pair) - "Get basic info about the to-be-inserted pair." - (let ((open-pair (plist-get active-pair :open))) - (list - open-pair - (plist-get active-pair :close) - (-if-let (tr (plist-get active-pair :trigger)) - (if (sp--looking-back-p (sp--strict-regexp-quote tr)) tr open-pair) - open-pair)))) - -(defun sp-insert-pair (&optional pair) - "Automatically insert the closing pair if it is allowed in current context. - -If PAIR is provided, use this as pair ID instead of looking -through the recent history of pressed keys. - -You can disable this feature completely for all modes and all pairs by -setting `sp-autoinsert-pair' to nil. - -You can globally disable insertion of closing pair if point is -followed by the matching opening pair. It is disabled by -default." - (sp--with-case-sensitive - (catch 'done - (-let* ((active-pair (unwind-protect - ;; This fake insertion manufactures proper - ;; context for the tests below... in effect - ;; we must make it look as if the user - ;; typed in the opening part themselves - ;; TODO: it is duplicated in the test - ;; below, maybe it wouldn't hurt to - ;; restructure this function a bit - (progn - (when pair (insert pair)) - (sp--pair-to-insert)) - (when pair (delete-char (- (length pair)))))) - ((open-pair close-pair trig) (sp--insert-pair-get-pair-info active-pair))) - ;; We are not looking at a closing delimiter which might mean we - ;; are in an already existing sexp. If the to-be-inserted pair - ;; has a prefix which is also a pair we migth be extending the - ;; opener of a sexp with this opener. In which case we should - ;; probably rewrap. - (unless (sp--looking-at-p (sp--get-closing-regexp)) - (when (and open-pair - (= 1 (- (point) sp-pre-command-point))) - (-when-let (prefix-pair (sp-get-pair (substring open-pair 0 -1))) - (let ((last-char-of-open-pair (substring open-pair -1))) - (unwind-protect - (progn - (delete-char -1) - (--when-let (sp-get-thing t) - (save-excursion - (sp-get it - (delete-region :end-in :end) - (goto-char :end-in) - (insert close-pair))) - (throw 'done t))) - (insert last-char-of-open-pair)))))) - (if (not (unwind-protect - (progn - (when pair (insert pair)) - ;; TODO: all these tests must go into `sp--pair-to-insert' - (and sp-autoinsert-pair - active-pair - (if (memq sp-autoskip-closing-pair '(always always-end)) - (or (not (equal open-pair close-pair)) - (not (sp-skip-closing-pair nil t))) - t) - (sp--do-action-p open-pair 'insert t) - ;; was sp-autoinsert-if-followed-by-same - (or (not (sp--get-active-overlay 'pair)) - (not (sp--looking-at (sp--strict-regexp-quote open-pair))) - (and (equal open-pair close-pair) - (eq sp-last-operation 'sp-insert-pair) - (save-excursion - (backward-char (length trig)) - (sp--looking-back (sp--strict-regexp-quote open-pair)))) - (not (equal open-pair close-pair))))) - (when pair (delete-char (- (length pair)))))) - ;; if this pair could not be inserted, we try the procedure - ;; again with this pair removed from sp-pair-list to give - ;; chance to other pairs sharing a common suffix (for - ;; example \[ and [) - (let ((new-sp-pair-list (--remove (equal (car it) open-pair) sp-pair-list)) - (new-sp-local-pairs (--remove (equal (plist-get it :open) open-pair) sp-local-pairs))) - (when (> (length sp-pair-list) (length new-sp-pair-list)) - (let ((sp-pair-list new-sp-pair-list) - (sp-local-pairs new-sp-local-pairs)) - (sp-insert-pair)))) - ;; setup the delayed insertion here. - (if (sp-get-pair open-pair :when-cond) - (progn - (setq sp-delayed-pair (cons open-pair (- (point) (length open-pair)))) - (setq sp-last-operation 'sp-insert-pair-delayed)) - (unless pair (delete-char (- (length trig)))) - (insert open-pair) - (sp--run-hook-with-args open-pair :pre-handlers 'insert) - ;; The re-binding of these dynamic variables is a hack to - ;; combat the similar rebinding in the branch above where - ;; we retry `sp-insert-pair' with some pairs removed. - ;; This however causes them to be uninserted improperly, - ;; so for this one operation we need to restore the state - ;; to the "full" pair list. TODO: in the future we might - ;; want to pass the state around explicitly so we have - ;; better control. - (--when-let (let ((sp-pair-list (sp-state-pair-list sp-state)) - (sp-local-pairs (sp-state-local-pairs sp-state))) - (sp--pair-to-uninsert)) - (let ((cl (plist-get it :close))) - (when (and (sp--looking-at-p (sp--strict-regexp-quote cl)) - (> (- (length close-pair) (length cl)) 0)) - (delete-char (length cl))))) - (insert close-pair) - (backward-char (length close-pair)) - (sp--pair-overlay-create (- (point) (length open-pair)) - (+ (point) (length close-pair)) - open-pair) - (when sp-undo-pairs-separately - (sp--split-last-insertion-undo (+ (length open-pair) (length close-pair))) - ;; TODO: abc\{abc\} undo undo \{asd\} . next undo removes the - ;; entire \{asd\} if we do not insert two nils here. - ;; Normally, repeated nils are ignored so it shouldn't - ;; matter. It would still be useful to inspect further. - (push nil buffer-undo-list) - (push nil buffer-undo-list)) - (sp--run-hook-with-args open-pair :post-handlers 'insert) - (setq sp-last-inserted-pair open-pair) - (setf (sp-state-delayed-hook sp-state) (cons :next open-pair)) - (setq sp-last-operation 'sp-insert-pair))))))) - -(defun sp--wrap-repeat-last (active-pair) - "If the last operation was a wrap and `sp-wrap-repeat-last' is -non-nil, repeat the wrapping with this pair around the last -active region." - (unless (= 0 sp-wrap-repeat-last) - (when sp-last-wrapped-region - (let* ((b (sp-get sp-last-wrapped-region :beg)) - (e (sp-get sp-last-wrapped-region :end)) - (op (sp-get sp-last-wrapped-region :op)) - (oplen (length op)) - (cllen (sp-get sp-last-wrapped-region :cl-l)) - (acolen (length (car active-pair)))) - (when (and - (cond - ((= 1 sp-wrap-repeat-last) - (equal (car active-pair) op)) - ((= 2 sp-wrap-repeat-last))) - (memq sp-last-operation '(sp-self-insert sp-wrap-region)) - (or (= (point) (+ b oplen acolen)) - (= (point) e))) - (delete-char (- acolen)) - (if (< (point) e) - (progn (goto-char (+ b oplen)) - (insert (car active-pair)) - (goto-char (- e cllen)) - (insert (cdr active-pair)) - (setq sp-last-wrapped-region - (sp--get-last-wraped-region - (+ b oplen) (point) - (car active-pair) (cdr active-pair))) - (goto-char (+ b oplen acolen))) - (goto-char b) - (insert (car active-pair)) - (goto-char e) - (insert (cdr active-pair)) - (setq sp-last-wrapped-region - (sp--get-last-wraped-region - b e (car active-pair) (cdr active-pair)))) - (setq sp-last-operation 'sp-wrap-region) - (sp--run-hook-with-args (car active-pair) :post-handlers 'wrap) - sp-last-operation))))) - -(defun sp--char-is-part-of-stringlike (char) - "Return non-nil if CHAR is part of a string-like delimiter of length 1." - (->> (sp--get-stringlike-list) - (--filter (= 1 (length (cdr it)))) - (-map 'car) - (--any? (string-match-p (regexp-quote char) it)))) - -(defun sp--char-is-part-of-closing (char &optional pair-list) - "Return non-nil if CHAR is part of a pair delimiter of length 1. -Specifically, return the pair for which CHAR is the closing -delimiter." - (let ((regexp (regexp-quote char))) - (->> (or pair-list (sp--get-pair-list)) - (--filter (= 1 (length (cdr it)))) - (--find (string-match-p regexp (cdr it)))))) - -;; TODO: this only supports single-char delimiters. Maybe it should -;; that that way. -(defun sp-skip-closing-pair (&optional last test-only) - "Automatically skip the closing delimiters of pairs. - -If point is inside an inserted pair, and the user only moved -forward with point (that is, only inserted text), if the closing -pair is typed, we shouldn't insert it again but skip forward. We -call this state \"active sexp\". The setting -`sp-cancel-autoskip-on-backward-movement' controls when an active -expression become inactive. - -For example, pressing ( is followed by inserting the pair (|). If -we then type 'word' and follow by ), the result should be (word)| -instead of (word)|). - -This behaviour can be customized by various settings of -`sp-autoskip-closing-pair' and `sp-autoskip-opening-pair'. - -Additionally, this behaviour can be selectively disabled for -specific pairs by removing their \"autoskip\" action. You can -achieve this by using `sp-pair' or `sp-local-pair' with -\":actions '(:rem autoskip)\"." - (sp--with-case-sensitive - (when (or (and (eq sp-autoskip-closing-pair t) - sp-pair-overlay-list - (sp--get-active-overlay 'pair)) - (memq sp-autoskip-closing-pair '(always always-end))) - ;; TODO: ugly hack to override 'navigate with 'autoskip. Each of - ;; these submodules should set-up their own environment somehow - ;; and thread it through the entire computation - (cl-letf (((symbol-function 'sp--get-allowed-stringlike-list) - (lambda () - (--filter (and (sp--do-action-p (car it) 'autoskip) - (equal (car it) (cdr it))) sp-pair-list)))) - ;; these two are pretty hackish ~_~ - (cl-labels ((get-sexp - (last) - (delete-char -1) - (insert " ") - (prog1 (sp-get-sexp) - (delete-char -1) - (insert last))) - (get-enclosing-sexp - (last) - (delete-char -1) - (insert " ") - (prog1 (sp-get-enclosing-sexp) - (delete-char -1) - (insert last)))) - (let ((last (or last (sp--single-key-description last-command-event)))) - (-if-let (active-sexp - (cond - ((-when-let* ((ov (sp--get-active-overlay 'pair)) - (op (overlay-get ov 'pair-id)) - (cl (cdr (assoc op sp-pair-list)))) - ;; if the sexp is active, we are inside it. - (when (and (= 1 (length op)) - (equal last cl)) - (list :beg (overlay-start ov) - :end (overlay-end ov) - :op op - :cl cl - :prefix "" - :suffix "")))) - ((sp--char-is-part-of-stringlike last) - ;; a part of closing delimiter is typed. There are four - ;; options now: - ;; - we are inside the sexp, at its end - ;; - we are inside the sexp, somewhere in the middle - ;; - we are outside, in front of a sexp - ;; - we are outside, somewhere between sexps - (cond - ((and (sp--looking-at (sp--get-stringlike-regexp)) - (not (sp--skip-match-p (match-string-no-properties 0) - (match-beginning 0) - (match-end 0)))) - ;; if we're looking at the delimiter, and it is valid in - ;; current context, get the sexp. - (get-sexp last)) - ;; here comes the feature when we're somewhere in the - ;; middle of the sexp (or outside), if ever supported. - )) - ((sp--char-is-part-of-closing last) - (cond - ((and (sp--looking-at (sp--get-closing-regexp)) - (not (sp--skip-match-p (match-string-no-properties 0) - (match-beginning 0) - (match-end 0)))) - (get-sexp last)) - ((eq sp-autoskip-closing-pair 'always) - (get-enclosing-sexp last)))))) - (if (and active-sexp - (equal (sp-get active-sexp :cl) last) - (sp--do-action-p (sp-get active-sexp :op) 'autoskip) - ;; if the point is inside string and preceded - ;; by an odd number of `sp-escape-char's, we - ;; should not skip as that would leave the - ;; string broken. - (or (not (sp-point-in-string)) - (not (sp-char-is-escaped-p (1- (point)))))) - (-when-let (re (cond - ((= (point) (sp-get active-sexp :beg)) - ;; we are in front of a string-like sexp - (when sp-autoskip-opening-pair - (if test-only t - (delete-char -1) - (forward-char) - (setq sp-last-operation 'sp-skip-closing-pair)))) - ((= (point) (sp-get active-sexp :end-in)) - (if test-only t - (delete-char 1) - (setq sp-last-operation 'sp-skip-closing-pair))) - ((sp-get active-sexp - (and (> (point) :beg-in) - (< (point) :end-in))) - (if test-only t - (delete-char -1) - (sp-up-sexp nil t))))) - (unless (or test-only - sp-buffer-modified-p) - (set-buffer-modified-p nil)) - (unless test-only - (sp--run-hook-with-args (sp-get active-sexp :op) :post-handlers 'skip-closing-pair)) - re) - ;; if we can't skip and are in strict mode we must not - ;; insert anything if it is a closing character - (sp--inhibit-insertion-of-closing-delim last)) - (sp--inhibit-insertion-of-closing-delim last)))))))) - -(defun sp--inhibit-insertion-of-closing-delim (last) - "Inhibit insertion of closing delimiter in `smartparens-strict-mode'. - -If we are not inserting inside string or a comment, and the LAST -inserted character is closing delimiter for a pair that performs -autoskip, and we can not jump out of its enclosing sexp (i.e. it -does not match), we are not allowed to insert it literally -because it would break the balance; so we delete the -just-inserted character." - (when (and smartparens-strict-mode - (-when-let (pair (sp--char-is-part-of-closing - last (sp--get-allowed-pair-list))) - (memq 'autoskip (sp-get-pair (car pair) :actions))) - (not (sp-point-in-string-or-comment))) - (delete-char -1) - (set-buffer-modified-p sp-buffer-modified-p) - (sp-message :cant-insert-closing-delimiter) - nil)) - -(defun sp-delete-pair (&optional arg) - "Automatically delete opening or closing pair, or both, depending on -position of point. - -If the point is inside an empty pair, automatically delete both. That -is, [(|) turns to [|, [{|} turns to [|. Can be disabled by setting -`sp-autodelete-pair' to nil. - -If the point is behind a closing pair or behind an opening pair delete -it as a whole. That is, {}| turns to {|, {| turns to |. Can be -disabled by setting `sp-autodelete-closing-pair' and -`sp-autodelete-opening-pair' to nil. - -If the last operation was a wrap and `sp-autodelete-wrap' is -enabled, invoking this function will unwrap the expression, that -is remove the just added wrapping." - ;; NOTE: Only use delete-char inside this function, so we - ;; don't activate the advice recursively! - - ;; only activate if argument is 1 (this is 0-th argument of the - ;; delete-backward-char), otherwise the user wants to delete - ;; multiple character, so let him do that - (sp--with-case-sensitive - (when (and (= arg 1) - smartparens-mode) - (if (and sp-autodelete-wrap - (eq sp-last-operation 'sp-wrap-region)) - (let ((p (point)) - (b (sp-get sp-last-wrapped-region :beg)) - (e (sp-get sp-last-wrapped-region :end)) - (o (sp-get sp-last-wrapped-region :op-l)) - (c (sp-get sp-last-wrapped-region :cl-l))) - ;; if the last operation was `sp-wrap-region', and we are at - ;; the position of either opening or closing pair, delete the - ;; just-inserted pair - (when (or (= p (+ b o)) - (= p e)) - (insert "x") ;dummy char to account for the regularly deleted one - (save-excursion - (goto-char e) - (delete-char (- c)) - (goto-char b) - (delete-char o)) - (setq sp-last-operation 'sp-delete-pair-wrap))) - (let ((p (point)) - (inside-pair (--first (and (sp--looking-back (sp--strict-regexp-quote (car it))) - (sp--looking-at (concat "[ \n\t]*" (sp--strict-regexp-quote (cdr it))))) - sp-pair-list)) - (behind-pair (--first (sp--looking-back (sp--strict-regexp-quote (cdr it))) sp-pair-list)) - (opening-pair (--first (sp--looking-back (sp--strict-regexp-quote (car it))) sp-pair-list))) - - (cond - ;; we're just before the closing quote of a string. If there - ;; is an opening or closing pair behind the point, remove - ;; it. This is only really relevant if the pair ends in the - ;; same character as string quote. We almost never want to - ;; delete it as an autopair (it would "open up the string"). - ;; So, word\"|" and should produce word\|" or - ;; word|" (if \" is autopair) instead of word\|. - ((and (sp-point-in-string) - (not (sp-point-in-string (1+ p))) - (sp-point-in-string (1- p))) ;; the string isn't empty - (cond ;; oh, you ugly duplication :/ - ((and behind-pair sp-autodelete-closing-pair) - (delete-char (- (1- (length (car behind-pair))))) - (setq sp-last-operation 'sp-delete-pair-closing)) - ((and opening-pair sp-autodelete-opening-pair) - (delete-char (- (1- (length (car opening-pair))))) - (setq sp-last-operation 'sp-delete-pair-opening)))) - ;; we're inside a pair - ((and inside-pair sp-autodelete-pair) - (let* ((beg (save-excursion - (search-backward (car inside-pair)))) - (end (save-excursion - (search-forward (cdr inside-pair)))) - (cs (sp--get-context p)) - (ce (sp--get-context end)) - (current-sexp (sp-get-sexp))) - (when (and (or (not (eq cs 'comment)) ;; a => b <=> ~a v b - (eq ce 'comment)) - (eq beg (sp-get current-sexp :beg)) - (eq end (sp-get current-sexp :end)) - (equal (sp-get current-sexp :op) (car inside-pair)) - (equal (sp-get current-sexp :cl) (cdr inside-pair))) - (delete-char (- end p)) - (delete-char (- (1- (length (car inside-pair))))) - (setq sp-last-operation 'sp-delete-pair)))) - ;; we're behind a closing pair - ((and behind-pair sp-autodelete-closing-pair) - (delete-char (- (1- (length (cdr behind-pair))))) - (setq sp-last-operation 'sp-delete-pair-closing)) - ;; we're behind an opening pair and there's no closing pair - ((and opening-pair sp-autodelete-opening-pair) - (delete-char (- (1- (length (car opening-pair))))) - (setq sp-last-operation 'sp-delete-pair-opening)))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Navigation - -(defun sp--looking-at (regexp) - "Like `looking-at', but always case sensitive." - (sp--with-case-sensitive - (looking-at regexp))) - -(defun sp--looking-at-p (regexp) - "Like `looking-at-p', but always case sensitive." - (sp--with-case-sensitive - (looking-at-p regexp))) - -(defun sp--looking-back (regexp &optional limit not-greedy) - "Return non-nil if text before point matches regular expression REGEXP. - -With optional argument LIMIT search only that many characters -backward. If LIMIT is nil, default to `sp-max-pair-length'. - -If optional argument NON-GREEDY is t search for any matching -sequence, not necessarily the longest possible." - (setq limit (or limit sp-max-pair-length)) - (sp--with-case-sensitive - (let ((from (max 1 (- (point) limit))) - (to (point)) - (greedy (not not-greedy)) - has-match) - (if greedy - (save-excursion - (goto-char from) - (save-match-data - (while (and (not has-match) (< (point) to)) - ;; don't use looking-at because we can't limit that search - (if (and (save-excursion (re-search-forward regexp to t)) - (= (match-end 0) to)) - (setq has-match (match-data)) - (forward-char 1)))) - (when has-match - (set-match-data has-match) - t)) - (save-excursion - (not (null (search-backward-regexp (concat "\\(?:" regexp "\\)\\=") from t)))))))) - -(defun sp--looking-back-p (regexp &optional limit not-greedy) - "Same as `sp--looking-back' but do not change the match data." - (save-match-data - (sp--looking-back regexp limit not-greedy))) - -(defun sp--search-backward-regexp (regexp &optional bound noerror count) - "Works just like `search-backward-regexp', but returns the -longest possible match. That means that searching for -\"defun|fun\" backwards would return \"defun\" instead of -\"fun\", which would be matched first. - -This is an internal function. Only use this for searching for -pairs!" - (setq count (or count 1)) - (setq bound (or (sp--get-backward-bound) bound)) - (sp--with-case-sensitive - (let (r) - (while (> count 0) - (when (search-backward-regexp regexp bound noerror) - (goto-char (match-end 0)) - (if (sp--looking-back regexp) - (setq r (goto-char (match-beginning 0))) - (if noerror nil (error "Search failed: %s" regexp)))) - (setq count (1- count))) - r))) - -(defun sp--search-forward-regexp (regexp &optional bound noerror count) - "Just like `search-forward-regexp', but always case sensitive." - (setq bound (or (sp--get-forward-bound) bound)) - (sp--with-case-sensitive - (search-forward-regexp regexp bound noerror count))) - -(defun sp--search-forward-in-context (regexp &optional bound noerror count) - "Just like `sp--search-forward-regexp' but only accept results in same context. - -The context at point is considered the reference context." - (let ((context (sp--get-context)) - (re)) - (--dotimes (or count 1) - (save-excursion - (while (and (setq re (sp--search-forward-regexp regexp bound noerror)) - (not (eq (sp--get-context) context))))) - (when re (goto-char re))) - re)) - -(defun sp--search-backward-in-context (regexp &optional bound noerror count) - "Just like `sp--search-backward-regexp' but only accept results in same context. - -The context at point is considered the reference context." - (let ((context (sp--get-context)) - (re)) - (--dotimes (or count 1) - (save-excursion - (while (and (setq re (sp--search-backward-regexp regexp bound noerror)) - (not (eq (sp--get-context) context)))) - (when re (goto-char re)))) - re)) - -(defun sp-get-quoted-string-bounds (&optional point) - "Return the bounds of the string around POINT. - -POINT defaults to `point'. - -If the point is not inside a quoted string, return nil." - (setq point (or point (point))) - (save-excursion - (goto-char point) - (let ((parse-data (syntax-ppss))) - (when (nth 3 parse-data) - (let* ((open (nth 8 parse-data)) - (close (save-excursion - (parse-partial-sexp - (point) (point-max) - nil nil parse-data 'syntax-table) - (point)))) - (cons open close)))))) - -;; TODO: the repeated conditions are ugly, refactor this! -(defun sp-get-comment-bounds () - "If the point is inside a comment, return its bounds." - (when (or (sp-point-in-comment) - (looking-at "[[:space:]]+\\s<")) - (let ((open (save-excursion - (--when-let (nth 8 (sp--syntax-ppss)) - (goto-char it)) - (while (and (not (bobp)) - (or (when (sp-point-in-comment) - (backward-char 1) - t) - (when (save-excursion - (beginning-of-line) - (looking-at "^[[:space:]]+\\s<")) - (when (>= (forward-line -1) 0) - (end-of-line)) - t)))) - ;; this means we got here by `sp-point-in-comment' condition - (unless (and (bobp) (sp-point-in-comment)) - (forward-char)) - (point))) - (close (save-excursion - (while (and (not (eobp)) - (or (sp-point-in-comment) - (looking-at "[[:space:]]+\\s<"))) - (forward-char 1)) - (let ((pp (1- (point)))) - (when (not (or (eobp) - (sp-point-in-comment) - (looking-at "[[:space:]]+\\s<") - (and (eq (char-syntax - (char-after pp)) ?>) - (not (eq (char-after pp) ?\n))) - (/= (logand - (lsh 1 18) - (car (syntax-after pp))) 0) - (/= (logand - (lsh 1 19) - (car (syntax-after pp))) 0))) - (backward-char 1))) - (point)))) - (cons open close)))) - -(defun sp--get-string-or-comment-bounds () - "Get the bounds of string or comment the point is in." - (or (sp-get-quoted-string-bounds) - (sp-get-comment-bounds))) - -(defmacro sp--search-and-save-match (search-fn pattern bound res beg end str) - "Save the last match info." - `(progn - (setq ,res (funcall ,search-fn ,pattern ,bound t)) - (when ,res - (setq ,beg (match-beginning 0)) - (setq ,end (match-end 0)) - (setq ,str (match-string 0))) - ,res)) - -(cl-defun sp--skip-match-p (ms mb me - &key - (global-skip (cdr (--first (memq major-mode (car it)) sp-navigate-skip-match))) - (pair-skip (sp-get-pair ms :skip-match))) - "Return non-nil if this match should be skipped. - -This function uses two tests, one specified in -`sp-navigate-skip-match' (this is global setting for all pairs in -given major mode) and by a function specified in :skip-match -property of the pair. - -If you are calling this function in a heavy loop, you can supply -the test functions as keyword arguments to speed up the lookup." - (save-match-data - (or (when global-skip (funcall global-skip ms mb me)) - (when pair-skip (funcall pair-skip ms mb me))))) - -(defmacro sp--valid-initial-delimiter-p (form) - "Test the last match using `sp--skip-match-p'. The form should -be a function call that sets the match data." - (declare (debug (form))) - (let ((match (make-symbol "match")) - (pair-skip (make-symbol "pair-skip"))) - `(and ,form - (let* ((,match (match-string 0)) - (,pair-skip (or (sp-get-pair ,match :skip-match) - (sp-get-pair (car (--first - (equal (cdr it) ,match) - sp-pair-list)) - :skip-match)))) - (not (sp--skip-match-p - ,match - (match-beginning 0) - (match-end 0) - :pair-skip ,pair-skip)))))) - -(defun sp--elisp-skip-match (ms mb _me) - "Function used to test for escapes in lisp modes. - -Non-nil return value means to skip the result." - (and ms - (> mb 1) - (save-excursion - (goto-char mb) - (save-match-data - (or (and (sp--looking-back "\\\\" 1 t) - ;; it might be a part of ?\\ token - (not (sp--looking-back "\\?\\\\\\\\" 3 t))) - (and (not (sp-point-in-string-or-comment)) - (sp--looking-back "\\?" 1 t) ;;TODO surely we can do better - (not (sp--looking-back "\\\\\\?" 2 t)) - (not (sp--looking-back "\\s_\\?" 2 t)) - (not (sp--looking-back "\\sw\\?" 2 t)))))))) - -(defun sp--backslash-skip-match (ms mb _me) - (and ms - (save-excursion - (goto-char mb) - (sp--looking-back "\\\\" 1 t)))) - -;; TODO: since this function is used for all the navigation, we should -;; optimize it a lot! Get some elisp profiler! Also, we should split -;; this into smaller functions (esp. the "first expression search" -;; business) -(defun sp-get-paired-expression (&optional back) - "Find the nearest balanced pair expression after point. - -The expressions considered are those delimited by pairs on -`sp-pair-list'." - (sp--with-case-sensitive - (save-excursion - (let* ((search-fn (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (global-skip-fn (cdr (--first (memq major-mode (car it)) sp-navigate-skip-match))) - (pair-list (sp--get-allowed-pair-list)) - ;; TODO UGLY HACK!!! When the situation is: - ;; ..)|;; comment - ;; the context the point gets is the comment. But if we - ;; are searching backward, that is incorrect, because in - ;; that case we want the context of the closing pair. - ;; Therefore, if the direction is backward, we need to move - ;; one point backward, then test the comment/string thing, - ;; then compute the correct bounds, and then restore the - ;; point so the search will pick up the ) - - ;; However, we need to distinguish the cases where we are - ;; in comment and trying to get out, and when we are in any - ;; context and we jump into string (in that case, we should - ;; report code context!). For example: - ;; "foo"|;bar - ;; or - ;; "foo"|bar - ;; should both report code context - ;; and "|(foo)" should report string context. - - ;; Beware the case when we have a string inside a comment, like - ;; (foo) ;; bar "baz"| qux - ;; In this case we want to report comment context even when - ;; backing into the "" (which however is commented) - - ;; Yet another case is when we are not in a comment but - ;; directly after one and we search backwards, consider: - ;; /* foo bar */| - ;; in C-like language. In this case, we want to report the - ;; context as comment. - - ;; In some languages, special paren syntax with a prefix - ;; serves to mark strings. This means that regular - ;; delimiters, like () are used to delimit strings. For - ;; example, in ruby the sequence %w(...) signifies a - ;; string. If the point is after such a sequence and we - ;; are searching back, we must use the string context, - ;; because the paren is now a string delimiter. This is - ;; usually implemented with "string fence" syntax, so we - ;; will simply check for that. - - ;; Thanks for being consistent at handling syntax bounds Emacs! - (in-string-or-comment (if back - (let ((in-comment (sp-point-in-comment)) - (in-string (sp-point-in-string))) - (save-excursion - (unless (= (point) (point-min)) - (backward-char) - (cond - ((eq (car (syntax-after (point))) 15) (point)) - (in-comment (when (sp-point-in-comment) (1+ (point)))) - ((and (not in-comment) (sp-point-in-comment)) (1+ (point))) - ((or in-comment in-string) (1+ (point))))))) - (when (sp-point-in-string-or-comment) (point)))) - (string-bounds (and in-string-or-comment - (progn - (goto-char in-string-or-comment) - (sp--get-string-or-comment-bounds)))) - (fw-bound (if in-string-or-comment (cdr string-bounds) (point-max))) - (bw-bound (if in-string-or-comment (car string-bounds) (point-min))) - s e forward mb me ms r done - possible-pairs possible-interfering-pairs possible-ops possible-cls) - (while (and (not done) - (sp--search-and-save-match - search-fn - ;; #556 The regexp we use here might exclude or - ;; include extra pairs in case the next match is in - ;; a different context. There's no way to know - ;; beforehand where we land, so we need to consider - ;; *all* pairs in the search and then re-check with - ;; a regexp based on the context of the found pair - (sp--get-allowed-regexp - ;; use all the pairs! - (sp--get-pair-list)) - (if back bw-bound fw-bound) - r mb me ms)) - ;; search for the first opening pair. Here, only consider tags - ;; that are allowed in the current context. - (unless (or (not (save-excursion - (if back - (progn - (goto-char me) - (sp--looking-back-p (sp--get-allowed-regexp))) - (goto-char mb) - (sp--looking-at-p (sp--get-allowed-regexp))))) - (sp--skip-match-p ms mb me :global-skip global-skip-fn)) - ;; if the point originally wasn't inside of a string or comment - ;; but now is, jump out of the string/comment and only search - ;; the code. This ensures that the comments and strings are - ;; skipped if we search inside code. - (if (and (not in-string-or-comment) - (if back - ;; When searching back, the point lands on the - ;; first character of whatever pair we've found - ;; and it is in the proper context, for example - ;; "|(foo)" - (sp-point-in-string-or-comment) - ;; However, when searching forward, the point - ;; lands after the last char of the pair so to get - ;; its context we must back up one character - (sp-point-in-string-or-comment (1- (point))))) - (-if-let (bounds (sp--get-string-or-comment-bounds)) - (let ((jump-to (if back (car bounds) (cdr bounds)))) - (goto-char jump-to) - ;; Can't move out of comment because eob, #427 - (when (eobp) - (setq done t))) - (setq done t)) - (setq done t)))) - (when r - (setq possible-pairs (--filter (or (equal ms (car it)) - (equal ms (cdr it))) - pair-list)) - (setq possible-ops (-map 'car possible-pairs)) - (setq possible-cls (-map 'cdr possible-pairs)) - (setq pair-list (-difference pair-list possible-pairs)) - (setq possible-interfering-pairs pair-list) - (while possible-interfering-pairs - (setq possible-interfering-pairs - (--filter (or (-contains? possible-ops (car it)) - (-contains? possible-cls (cdr it))) - pair-list)) - (setq pair-list (-difference pair-list possible-interfering-pairs)) - (setq possible-ops (append possible-ops (-map 'car possible-interfering-pairs))) - (setq possible-cls (append possible-cls (-map 'cdr possible-interfering-pairs)))) - (when (--any? (equal ms it) possible-ops) - (setq forward t) - (setq s mb) - (when back - (forward-char (length ms)))) - (when (--any? (equal ms it) possible-cls) - (setq forward nil) - (setq e me) - (when (not back) - (backward-char (length ms)))) - (let* ((opens (if forward possible-ops possible-cls)) - (closes (if forward possible-cls possible-ops)) - (needle (sp--strict-regexp-opt (append possible-ops possible-cls))) - (search-fn (if forward 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (depth 1) - (eof (if forward 'eobp 'bobp)) - (b (if forward fw-bound bw-bound)) - (open (substring-no-properties ms)) - (close (substring-no-properties ms)) - (failure (funcall eof)) - (skip-match-pair-fns (->> possible-ops - (--mapcat (-when-let (smf (sp-get-pair it :skip-match)) - (list (cons it smf) (cons (sp-get-pair it :close) smf))))))) - (while (and (> depth 0) (not (funcall eof))) - (sp--search-and-save-match search-fn needle b r mb me ms) - (if r - (unless (or (and (not in-string-or-comment) - (if forward (save-excursion - (backward-char) - (sp-point-in-string-or-comment)) - (sp-point-in-string-or-comment))) - ;; check the individual pair skipper. We - ;; need to test all the possible-ops, - ;; which makes it a bit ugly :/ - (let ((skip-match-pair-fn - (cdr (--first (equal (car it) ms) skip-match-pair-fns)))) - (sp--skip-match-p ms mb me :global-skip global-skip-fn :pair-skip skip-match-pair-fn))) - (when (--any? (equal ms it) opens) (setq depth (1+ depth))) - (when (--any? (equal ms it) closes) (setq depth (1- depth)))) - (unless (minibufferp) - (sp-message :unmatched-expression)) - (setq depth -1) - (setq failure t))) - (if forward - (setq e me) - (setq s mb)) - (setq close (substring-no-properties ms)) - (if (or failure - (/= depth 0)) - (progn - (unless (minibufferp) - (sp-message :unmatched-expression)) - nil) - (let ((end-in-cos (sp-point-in-string-or-comment (1- e)))) ;; fix the "point on comment" issue - (cond - ((or (and (sp-point-in-string-or-comment s) (not end-in-cos)) - (and (not (sp-point-in-string-or-comment s)) end-in-cos)) - (unless (minibufferp) - (sp-message :delimiter-in-string)) - nil) - (t - (let* ((op (if forward open close))) - (list :beg s - :end e - :op op - :cl (if forward close open) - :prefix (sp--get-prefix s op) - :suffix (sp--get-suffix e op))))))))))))) - -;; TODO: this does not consider unbalanced quotes in comments!!! -(defun sp--find-next-stringlike-delimiter (needle search-fn-f &optional limit skip-fn) - "Find the next string-like delimiter, considering the escapes -and the skip-match predicate." - (let (hit match) - (while (and (not hit) - (funcall search-fn-f needle limit t)) - (save-match-data - (setq match (match-string-no-properties 0)) - (unless (or (save-match-data - (save-excursion - (goto-char (match-beginning 0)) - (or (sp--looking-back-p "\\\\" 2) ;; assumes \ is always the escape... bad? - (and (eq major-mode 'emacs-lisp-mode) - (not (sp-point-in-string)) - (sp--looking-back-p "?" 1))))) - ;; TODO: HACK: global-skip is hack here!!! - (sp--skip-match-p match (match-beginning 0) (match-end 0) - :pair-skip (or skip-fn - (sp-get-pair match :skip-match)) - :global-skip nil)) - (setq hit (match-data))))) - hit)) - -(defun sp-get-stringlike-expression (&optional back) - "Find the nearest string-like expression after point. - -String-like expression is expression enclosed with the same -opening and closing delimiter, such as *...*, \"...\", `...` etc." - (sp--with-case-sensitive - (save-excursion - (let ((needle (sp--get-stringlike-regexp)) - (search-fn-f (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (search-fn-b (if back 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (count 0) - m b e skip-match-fn limit ok) - (when (not (equal needle "")) - (when (sp--find-next-stringlike-delimiter needle search-fn-f) - ;; assumes \ is always the escape... bad? - (setq m (match-string-no-properties 0)) - (setq needle (regexp-quote m)) - (setq skip-match-fn (sp-get-pair m :skip-match)) - (cond - ((sp-point-in-string) - (setq limit (sp-get-quoted-string-bounds))) - ((sp-point-in-comment) - (setq limit (sp-get-comment-bounds)))) - (save-excursion - (while (sp--find-next-stringlike-delimiter needle 'search-backward-regexp (car limit) skip-match-fn) - (setq count (1+ count)))) - (when (= (mod count 2) 0) - (sp--find-next-stringlike-delimiter needle search-fn-b nil)) - (save-excursion - (setq ok (sp--find-next-stringlike-delimiter needle 'sp--search-backward-regexp (car limit))) - (setq e (match-beginning 0))) - (setq ok (and ok (sp--find-next-stringlike-delimiter needle 'search-forward-regexp (cdr limit)))) - (setq b (match-end 0)) - (when ok - (let ((mb b) (me e)) - (setq b (min mb me)) - (setq e (max mb me))) - (list :beg b :end e :op m :cl m :prefix (sp--get-prefix b m) :suffix (sp--get-suffix e m))))))))) - -(defun sp--textmode-stringlike-regexp (delimiters &optional direction) - "Get a regexp matching text-mode string-like DELIMITERS. - -Capture group 1 or 2 has the delimiter itself, depending on the -direction (forward, backward). - -If DIRECTION is :open, create a regexp matching opening only. - -If DIRECTION is :close, create a regexp matching closing only. - -If DIRECTION is nil, create a regexp matching both directions." - (let* ((delims (regexp-opt delimiters)) - (re (concat - (if (or (not direction) - (eq direction :open)) - (concat "\\(?:" "\\(?:\\`\\|[ \t\n\r]\\)" "\\(" delims "\\)" "[^ \t\n\r]\\)") "") - (if (not direction) "\\|" "") - (if (or (not direction) - (eq direction :close)) - (concat "\\(?:[^ \t\n\r]" "\\(" delims "\\)" "\\(?:[ \t\n\r[:punct:]]\\|\\'\\)" "\\)") "")))) - re)) - -(defun sp--find-next-textmode-stringlike-delimiter (needle search-fn-f &optional limit) - "Find the next string-like delimiter, considering the escapes -and the skip-match predicate." - (let (hit) - (while (and (not hit) - (funcall search-fn-f needle limit t)) - (save-match-data - (let* ((group (if (match-string 1) 1 2)) - (match (match-string-no-properties group)) - (mb (match-beginning group)) - (me (match-end group)) - (skip-fn (sp-get-pair match :skip-match))) - (unless (sp--skip-match-p match mb me :pair-skip skip-fn :global-skip nil) - (setq hit (list match (if (= group 1) :open :close))))))) - hit)) - -(defun sp-get-textmode-stringlike-expression (&optional back) - "Find the nearest text-mode string-like expression. - -If BACK is non-nil search in the backwards direction. - -Text-mode string-like expression is one where the delimiters must -be surrounded by whitespace from the outside. For example, - -foo *bar* baz - -is a valid expression enclosed in ** pair, but - -foo*bar*baz OR foo *bar*baz OR foo*bar* baz - -are not. - -This is the case in almost every markup language, and so we will -adjust the parsing to only consider such pairs as delimiters. -This makes the parsing much faster as it transforms the problem -to non-stringlike matching and we can use a simple -counting (stack) algorithm." - (save-excursion - (let ((restart-from (point)) - (bounds (or (sp-get-comment-bounds) - (cons (point-min) (point-max)))) - hit re) - (while (not hit) - (goto-char restart-from) - (save-excursion - (ignore-errors - (if back (forward-char) (backward-char))) - (let* ((delimiters (-map 'car (sp--get-allowed-stringlike-list))) - (needle (sp--textmode-stringlike-regexp delimiters)) - (search-fn-f (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (limit-f (if (not back) (cdr bounds) (car bounds)))) - (-if-let ((delim type) (sp--find-next-textmode-stringlike-delimiter needle search-fn-f limit-f)) - (let ((search-fn (if (eq type :open) 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (limit (if (eq type :open) (cdr bounds) (car bounds))) - (needle (sp--textmode-stringlike-regexp (list delim) (if (eq type :open) :close :open)))) - (setq restart-from (point)) - ;; this adjustments are made because elisp regexp - ;; can't do lookahead assertions... so we match and - ;; then back up. - (ignore-errors - (when (and (not back) (eq type :open)) (backward-char (1+ (length delim)))) - (when (and (not back) (eq type :close) (not (eobp))) (backward-char 1)) - (when (and back (eq type :close)) (forward-char (1+ (length delim)))) - (when (and back (eq type :open) (not (bobp))) (forward-char 1))) - (let ((other-end (point))) - (when (sp--find-next-textmode-stringlike-delimiter needle search-fn limit) - ;; Beware, we also need to test the beg/end of - ;; buffer, because we have that variant in the - ;; regexp. In that case the match does not - ;; consume anything and we needn't do any - ;; correction. - (let* ((this-end (if (eq type :open) - (max (point-min) (if (eobp) (point) (1- (point)))) - (min (point-max) (if (bobp) (point) (1+ (point)))))) - (b (min this-end other-end)) - (e (max this-end other-end))) - (setq re (list :beg b - :end e - :op delim - :cl delim - :prefix (sp--get-prefix b delim) :suffix (sp--get-suffix e delim))) - (setq hit t) - ;; We ignore matches that contain two - ;; consecutive newlines, as that usually means - ;; there's a new paragraph somewhere inbetween - ;; TODO: make this customizable - (when (sp-get re - (save-excursion - (goto-char :beg) - (re-search-forward "\n\n\\|\r\r" :end t))) - (setq re nil) - (setq hit nil)))))) - (setq hit :no-more))))) - re))) - -(defun sp-use-textmode-stringlike-parser-p () - "Test if we should use textmode stringlike parser or not." - (let ((modes (-filter 'symbolp sp-navigate-use-textmode-stringlike-parser)) - (derived (-map 'cdr (-remove 'symbolp sp-navigate-use-textmode-stringlike-parser)))) - (or (--any? (eq major-mode it) modes) - (apply 'derived-mode-p derived)))) - -(defun sp-get-stringlike-or-textmode-expression (&optional back delimiter) - "Return a stringlike expression using stringlike or textmode parser. - -DELIMITER is a candidate in case we performed a search before -calling this function and we know it's the closest string -delimiter to try. This is purely a performance hack, do not rely -on it when calling directly." - (if (sp-use-textmode-stringlike-parser-p) - (sp-get-textmode-stringlike-expression back) - ;; performance hack. If the delimiter is a character in - ;; syntax class 34, grab the string-like expression using - ;; `sp-get-string' - (if (and delimiter - (= (length delimiter) 1) - ;; TODO: this "smart" behaviour is duplicated in - ;; `sp-get-thing', maybe the whole string parsing could - ;; be extracted to some common function (actually we - ;; should probably use this one from `sp-get-thing') - (eq (char-syntax (string-to-char delimiter)) 34)) - (if (eq t (sp-point-in-string)) - ;; TODO: this is duplicated in `sp-get-thing', move to a function - (save-excursion - (save-restriction - (widen) - (-let (((beg . end) (sp-get-quoted-string-bounds))) - (narrow-to-region beg end)) - (sp-get-stringlike-expression back))) - (sp-get-string back)) - (sp-get-stringlike-expression back)))) - -(defun sp-get-expression (&optional back) - "Find the nearest balanced expression of any kind. - -For markup and text modes a special, more efficient stringlike -parser is available, see `sp-get-textmode-stringlike-expression'. -By default, this is enabled in all modes derived from -`text-mode'. You can change it by customizing -`sp-navigate-use-textmode-stringlike-parser'." - (let ((pre (sp--get-allowed-regexp)) - (sre (sp--get-stringlike-regexp)) - (search-fn (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) - (ps (if back (1- (point-min)) (1+ (point-max)))) - (ss (if back (1- (point-min)) (1+ (point-max)))) - (string-delim nil)) - (setq ps (if (equal pre "") ps - (or (save-excursion (funcall search-fn pre nil t)) ps))) - (setq ss (if (equal sre "") ss - (or (--when-let (save-excursion - (sp--find-next-stringlike-delimiter sre search-fn)) - (setq string-delim (match-string 0)) - (save-match-data - (set-match-data it) - (if back (match-beginning 0) (match-end 0)))) - ss))) - ;; TODO: simplify this logic somehow... (this really depends - ;; on a rewrite of the core parser logic: separation of "find - ;; the valid opening" and "parse it") - - ;; Here, we sacrifice readability for performance. Because we - ;; only use regexp to look forward for the closest pair, it - ;; might occasionally happen that what we picked in fact - ;; *can't* form a pair and it returns error (for example, it - ;; is an unclosed pair or a quote between words like'so, which - ;; doesn't form a pair). In such a case, or when the pair - ;; found is further than the other possible pair type (for - ;; example, we think we should parse stringlike, but we skip - ;; the first occurrence and the next one is only after a - ;; regular pair, which we should've picked instead), we must - ;; try the other parser as well. - (-let (((type . re) (if (or (and (not back) (< ps ss)) - (and back (> ps ss))) - (cons :regular (sp-get-paired-expression back)) - (cons :string (sp-get-stringlike-or-textmode-expression back string-delim))))) - (when re - (sp-get re - (cond - ;; If the returned sexp is regular, but the - ;; to-be-tried-string-expression is before it, we try - ;; to parse it as well, it might be a complete sexp in - ;; which case it should be returned. - ((and (eq type :regular) - (or (and (not back) (< ss :beg)) - (and back (> ss :end)))) - (or (sp-get-stringlike-or-textmode-expression back string-delim) re)) - ((and (eq type :string) - (or (and (not back) (< ps :beg)) - (and back (> ps :end)))) - (or (sp-get-paired-expression back) re)) - (t re))))))) - -(defun sp-get-sexp (&optional back) - "Find the nearest balanced expression that is after (before) point. - -Search backward if BACK is non-nil. This also means, if the -point is inside an expression, this expression is returned. - -If `major-mode' is member of `sp-navigate-consider-sgml-tags', -sgml tags will also be considered as sexps in current buffer. - -If the search starts outside a comment, all subsequent comments -are skipped. - -If the search starts inside a string or comment, it tries to find -the first balanced expression that is completely contained inside -the string or comment. If no such expression exist, a warning is -raised (for example, when you comment out imbalanced expression). -However, if you start a search from within a string and the next -complete sexp lies completely outside, this is returned. Note -that this only works in modes where strings and comments are -properly defined via the syntax tables. - -The return value is a plist with following keys: - - :beg - point in the buffer before the opening - delimiter (ignoring prefix) - :end - point in the buffer after the closing delimiter - :op - opening delimiter - :cl - closing delimiter - :prefix - expression prefix - :suffix - expression suffix - -However, you should never access this structure directly as it is -subject to change. Instead, use the macro `sp-get' which also -provide shortcuts for many commonly used queries (such as length -of opening/closing delimiter or prefix)." - (sp--maybe-init) - (sp--with-case-sensitive - (cond - (sp-prefix-tag-object - (sp-get-sgml-tag back)) - (sp-prefix-pair-object - (sp-get-paired-expression back)) - ((memq major-mode sp-navigate-consider-sgml-tags) - (let ((paired (sp-get-expression back))) - (if (and paired - (equal "<" (sp-get paired :op))) - ;; if the point is inside the tag delimiter, return the pair. - (if (sp-get paired (and (<= :beg-in (point)) (>= :end-in (point)))) - paired - ;; if the tag can't be completed, we can at least return - ;; the <> pair - (or (sp-get-sgml-tag back) paired)) - ;; we can still try the tag if the first < or > is closer than - ;; the pair. This is a bit too complicated... seems like a - ;; more clever solution would be needed in the future, esp if - ;; we add the python hack. - (cond - ((and (not back) - (< (save-excursion - (or (search-forward "<" nil t) (point-max))) - (or (sp-get paired :beg) (point-max)))) - (or (sp-get-sgml-tag) paired)) - ((and back - (> (save-excursion - (or (search-backward ">" nil t) (point-min))) - (or (sp-get paired :end) (point-max)))) - (or (sp-get-sgml-tag t) paired)) - (t paired))))) - (t (sp-get-expression back))))) - -(defun sp--get-hybrid-sexp-beg () - "Get the beginning of hybrid sexp. -See `sp-get-hybrid-sexp' for definition." - (save-excursion - (cl-labels ((indent-or-beg-of-line - (lb) - (if (sp-point-in-blank-line) - lb - (back-to-indentation) - (point)))) - (let ((p (progn (when (sp-point-in-symbol) (sp-backward-sexp)) (point))) - (lb (line-beginning-position)) - (cur (--if-let (save-excursion (sp-backward-sexp)) it (list :end 0))) ;hack - last) - (if (< (sp-get cur :end) lb) - ;; if the line is not empty, we move the beg to the indent - (indent-or-beg-of-line lb) - (while (sp-get cur - (and cur - (> :end lb) - (<= :end p))) - (setq last cur) - (setq cur (sp-backward-sexp))) - (if last - (sp-get last :beg-prf) - ;; happens when there is no sexp before the opening delim of - ;; the enclosing sexp. In case it is on line above, we take - ;; the maximum wrt lb. - (sp-get cur (max :beg-in (indent-or-beg-of-line lb))))))))) - -(defun sp--narrow-to-line () - "Narrow to the current line." - (narrow-to-region (line-beginning-position) (line-end-position))) - -(defun sp--get-hybrid-sexp-end () - "Get the end of hybrid sexp. -See `sp-get-hybrid-sexp' for definition." - (save-excursion - (cl-labels ((skip-prefix-backward - (p) - (save-excursion - (goto-char p) - (save-restriction - (sp--narrow-to-line) - (skip-syntax-backward " .") - (point))))) - (let ((p (progn (when (sp-point-in-symbol) (sp-backward-sexp)) (point))) - (le (line-end-position)) - (cur (--if-let (save-excursion (sp-forward-sexp)) it (list :beg (1+ (point-max))))) ;hack - last) - (if (> (sp-get cur :beg) le) - (if (sp-point-in-blank-line) le (skip-prefix-backward le)) - (while (sp-get cur - (and cur - (< :beg le) - (>= :beg p))) - (setq last cur) - (setq cur (sp-forward-sexp))) - (let ((r (skip-prefix-backward - (if last - (sp-get last :end) - ;; happens when there is no sexp before the closing delim of - ;; the enclosing sexp. In case it is on line below, we take - ;; the minimum wrt le. - (sp-get cur (min :end-in le)))))) - (goto-char r) - ;; fix the situation when point ends in comment - (cond - ((sp-point-in-comment) - (if (= (line-number-at-pos p) - (line-number-at-pos r)) - (line-end-position) - (goto-char p) - (line-end-position))) - (t r)))))))) - -(defun sp--get-hybrid-suffix (p) - "Get the hybrid sexp suffix, which is any punctuation after -the end, possibly preceded by whitespace." - (save-excursion - (goto-char p) - (buffer-substring-no-properties - p - (save-restriction - (sp--narrow-to-line) - (skip-syntax-forward " ") - (if (not (looking-at "\\s.")) - p - (skip-syntax-forward ".") - (point)))))) - -(defun sp-get-hybrid-sexp () - "Return the hybrid sexp around point. - -A hybrid sexp is defined as the smallest balanced region containing -the point while not expanding further than the current line. That is, -any hanging sexps will be included, but the expansion stops at the -enclosing list boundaries or line boundaries." - (let ((end (sp--get-hybrid-sexp-end))) - (list :beg (sp--get-hybrid-sexp-beg) - :end end - :op "" - :cl "" - :prefix "" - :suffix (sp--get-hybrid-suffix end)))) - -(defun sp-get-enclosing-sexp (&optional arg) - "Return the balanced expression that wraps point at the same level. - -With ARG, ascend that many times. This function expects a positive -argument." - (setq arg (or arg 1)) - (save-excursion - (let ((n arg) - (ok t) - (okr)) - (while (and (> n 0) ok) - (setq ok t) - (setq okr nil) - ;; if we are inside string, get the string bounds and "string - ;; expression" - (when (sp-point-in-string) - (setq okr (sp-get-string))) - ;; get the "normal" expression defined by pairs - (let ((p (point))) - (setq ok (sp-get-sexp)) - (cond - ((and ok (= (sp-get ok :beg) p)) - (goto-char (sp-get ok :end)) - (setq n (1+ n))) - ((and ok (< (sp-get ok :beg) p)) - (goto-char (sp-get ok :end))) - (t - (while (and ok (>= (sp-get ok :beg) p)) - (setq ok (sp-get-sexp)) - (when ok (goto-char (sp-get ok :end))))))) - ;; if the pair expression is enclosed inside a string, return - ;; the pair expression, otherwise return the string expression - (when okr - (unless (and ok - (sp-compare-sexps ok okr >=) - (sp-compare-sexps ok okr <= :end)) - (setq ok okr) - (goto-char (sp-get ok :end)))) - (setq n (1- n))) - (if (not (and (not ok) - sp-navigate-comments-as-sexps)) - ok - (when (sp-point-in-comment) - (let* ((cb (sp-get-comment-bounds)) - (b (save-excursion - (goto-char (car cb)) - (sp-skip-backward-to-symbol t) - (point))) - (e (save-excursion - (goto-char (cdr cb)) - (sp-skip-forward-to-symbol t) - (point)))) - (list :beg b :end e :op "" :cl "" :prefix sp-comment-char))))))) - -(defun sp-get-list-items (&optional lst) - "Return the information about expressions inside LST. - -LST should be a data structure in format as returned by -`sp-get-sexp'. - -The return value is a list of such structures in order as they -occur inside LST describing each expression, with LST itself -prepended to the front. - -If LST is nil, the list at point is used (that is the list -following point after `sp-backward-up-sexp' is called)." - (let ((r nil)) - (save-excursion - (unless lst - (setq lst (sp-backward-up-sexp))) - (when lst - (goto-char (sp-get lst :beg-in)) - (while (< (point) (sp-get lst :end)) - (!cons (sp-forward-sexp) r)) - (cons lst (nreverse (cdr r))))))) - -(cl-defun sp--get-prefix (&optional (p (point)) op) - "Get the prefix of EXPR. - -Prefix is any continuous sequence of characters in \"expression -prefix\" syntax class. You can also specify a set of syntax code -characters or a regexp for a specific major mode. See -`sp-sexp-prefix'. - -The point is expected to be at the opening delimiter of the sexp -and the prefix is searched backwards. - -If the prefix property is defined for OP, the associated regexp -is used to retrieve the prefix instead of the global setting." - (sp--with-case-sensitive - (save-excursion - (goto-char p) - (let* ((pref (sp-get-pair op :prefix)) - (prefix - (if pref - (if (sp--looking-back pref sp-max-prefix-length) - (match-string-no-properties 0) - "") - (-if-let (mmode-prefix (cdr (assoc major-mode sp-sexp-prefix))) - (cond - ((and (eq (car mmode-prefix) 'regexp) - (sp--looking-back (cadr mmode-prefix))) - (match-string-no-properties 0)) - ((eq (car mmode-prefix) 'syntax) - (skip-syntax-backward (cadr mmode-prefix)) - (buffer-substring-no-properties (point) p)) - (t "")) - (backward-prefix-chars) - (buffer-substring-no-properties (point) p))))) - ;; do not consider it a prefix if it matches some opening or - ;; closing delimiter which is allowed for parsing in current - ;; context - (goto-char p) - (if (and (< 0 (length prefix)) - (or (sp--do-action-p prefix 'navigate) - (sp--do-action-p - (car (--first (equal (cdr it) prefix) - sp-pair-list)) - 'navigate))) - "" - prefix))))) - -(cl-defun sp--get-suffix (&optional (p (point)) op) - "Get the suffix of EXPR. - -Suffix is any continuous sequence of characters in the -\"punctuation suffix\" syntax class. You can also specify a set -of syntax code characters or a regexp for a specific major mode. -See `sp-sexp-suffix'. - -If the suffix property is defined for OP, the associated regexp -is used to retrieve the suffix instead of the global setting." - (sp--with-case-sensitive - (save-excursion - (goto-char p) - (let* ((suff (sp-get-pair op :suffix)) - (suffix - (if suff - (if (sp--looking-at suff) - (match-string-no-properties 0) - "") - (-if-let (mmode-suffix (cdr (assoc major-mode sp-sexp-suffix))) - (cond - ((and (eq (car mmode-suffix) 'regexp) - (sp--looking-at (cadr mmode-suffix))) - (match-string-no-properties 0)) - ((eq (car mmode-suffix) 'syntax) - (skip-syntax-forward (cadr mmode-suffix)) - (buffer-substring-no-properties p (point))) - (t "")) - (skip-syntax-forward ".") - (buffer-substring-no-properties p (point)))))) - ;; do not consider it a suffix if it matches some opening or - ;; closing delimiter which is allowed for parsing in current - ;; context - (goto-char p) - (if (and (< 0 (length suffix)) - (or (sp--do-action-p suffix 'navigate) - (sp--do-action-p - (car (--first (equal (cdr it) suffix) - sp-pair-list)) - 'navigate))) - "" - suffix))))) - -(defun sp-get-symbol (&optional back) - "Find the nearest symbol that is after point, or before point if BACK is non-nil. - -This also means, if the point is inside a symbol, this symbol is -returned. Symbol is defined as a chunk of text recognized by -`sp-forward-symbol'. - -The return value is a plist with the same format as the value -returned by `sp-get-sexp'." - (sp--maybe-init) - (let (b e last-or-first) - (save-excursion - (if back - (progn - (sp-skip-backward-to-symbol) - (when (= (point) (point-min)) (setq last-or-first t)) - (sp-forward-symbol -1) - (setq b (point)) - (sp-forward-symbol 1) - (setq e (point))) - (sp-skip-forward-to-symbol) - (when (= (point) (point-max)) (setq last-or-first t)) - (sp-forward-symbol 1) - (setq e (point)) - (sp-forward-symbol -1) - (setq b (point)))) - (unless last-or-first - (list :beg b :end e :op "" :cl "" :prefix (sp--get-prefix b) :suffix (sp--get-suffix e))))) - -(defun sp--get-string (bounds) - "Return the `sp-get-sexp' format info about the string. - -This function simply transforms BOUNDS, which is a cons (BEG -. END) into format compatible with `sp-get-sexp'." - (let* ((op (char-to-string (char-after (car bounds)))) - (cl (char-to-string (char-before (cdr bounds))))) - ;; if the closing and opening isn't the same token, we should - ;; return nil - (when (equal op cl) - (list :beg (car bounds) - :end (cdr bounds) - :op cl - :cl cl - :prefix (sp--get-prefix (car bounds) op) - :suffix (sp--get-suffix (cdr bounds) cl))))) - -(defun sp-get-string (&optional back) - "Find the nearest string after point, or before if BACK is non-nil. - -This also means if the point is inside a string, this string is -returned. If there are another symbols between point and the -string, nil is returned. That means that this function only -return non-nil if the string is the very next meaningful -expression. - -The return value is a plist with the same format as the value -returned by `sp-get-sexp'." - (sp--maybe-init) - (if (sp-point-in-comment) - (sp-get-stringlike-expression back) - (if (sp-point-in-string) - (let ((r (sp-get-quoted-string-bounds))) - (sp--get-string r)) - (save-excursion - (sp-skip-into-string back) - (--when-let (sp-get-quoted-string-bounds) - (sp--get-string it)))))) - -(defun sp-get-whitespace () - "Get the whitespace around point. - -Whitespace here is defined as any of the characters: space, tab -and newline." - (list :beg (save-excursion (skip-chars-backward " \t\n") (point)) - :end (save-excursion (skip-chars-forward " \t\n") (point)) - :op "" - :cl "" - :prefix "" - :suffix "")) - -(defun sp--sgml-get-tag-name (match) - (let ((sub (if (equal "/" (substring match 1 2)) - (substring match 2) - (substring match 1)))) - (car (split-string sub "\\( \\|>\\)")))) - -(defun sp--sgml-opening-p (tag) - (not (equal "/" (substring tag 1 2)))) - -(defun sp--sgml-ignore-tag (tag) - "Return non-nil if tag should be ignored in search, nil otherwise." - (member tag '("!--" "!DOCTYPE"))) - -(defun sp-get-sgml-tag (&optional back) - (sp--maybe-init) - (sp--with-case-sensitive - (save-excursion - (let ((search-fn (if (not back) 'sp--search-forward-regexp 'search-backward-regexp)) - tag tag-name needle - open-start open-end - close-start close-end) - (when (and (funcall search-fn "" nil t) - (progn - (setq tag (substring-no-properties (match-string 0))) - (setq tag-name (sp--sgml-get-tag-name tag)) - (not (sp--sgml-ignore-tag tag-name)))) - (setq needle (concat "" nil t) - (setq open-end (point)))) - (cond - ((and (not back) (not forward)) - (goto-char (match-beginning 0))) - ((and back forward) - (goto-char (match-end 0)))) - (while (> depth 0) - (if (funcall search-fn needle nil t) - (if (sp--sgml-opening-p (match-string 0)) - (if forward (setq depth (1+ depth)) (setq depth (1- depth))) - (if forward (setq depth (1- depth)) (setq depth (1+ depth)))) - (setq depth -1))) - (if (eq depth -1) - (progn (sp-message :no-matching-tag) nil) - (save-excursion - (if forward - (progn - (setq close-start (match-beginning 0)) - (search-forward-regexp ">" nil t) - (setq close-end (point))) - (setq close-start (point)) - (search-forward-regexp ">" nil t) - (setq close-end (point)))) - (let ((op (buffer-substring-no-properties open-start open-end)) - (cl (buffer-substring-no-properties close-start close-end))) - (list :beg (if forward open-start close-start) - :end (if forward close-end open-end) - :op (if forward op cl) - :cl (if forward cl op) - :prefix "" - :suffix ""))))))))) - -(defun sp--end-delimiter-closure (pairs pair-list) - "Compute the \"end-delimiter\" closure of set PAIRS. - -PAIRS can be: -- single pair ID -- single cons with opening and closing delimiter -- list of pair IDs -- list of conses of opening and closing delimiters - -For example, if we have pairs (if . end) and (def . end), then -the closure of \"if\" pair are both of these because they share -the closing delimiter. Therefore, in the navigation functions, -both have to be considered by the parser." - (let* ((pairs (-flatten (list pairs))) - (pairs (if (consp (car pairs)) (-map 'car pairs) pairs)) - (pairs (--filter (member (car it) pairs) pair-list)) - (closure (-mapcat - (lambda (x) - (--filter (equal (cdr x) (cdr it)) pair-list)) - pairs))) - closure)) - -(defun sp-restrict-to-pairs (pairs function) - "Call the FUNCTION restricted to PAIRS. - -PAIRS is either an opening delimiter of a list of opening -delimiters. - -FUNCTION is a function symbol. - -For example, you can restrict function `sp-down-sexp' to the -pair (\"{\" . \"}\") for easier navigation of blocks in C-like -languages." - (let* ((pairs (-flatten (list pairs))) - (new-pairs (--filter (member (car it) pairs) sp-pair-list)) - (sp-pair-list (sp--end-delimiter-closure new-pairs sp-pair-list))) - (call-interactively function))) - -(defun sp-restrict-to-object (object function) - "Call the FUNCTION restricted to OBJECT. - -OBJECT is one of following symbols (you have to quote it!): -- `sp-prefix-pair-object' -- `sp-prefix-tag-object' -- `sp-prefix-symbol-object' - -This function will enable this prefix and then call FUNCTION. - -FUNCTION is a function symbol. - -This function is equivalent to doing: - - (let ((sp-prefix-object t)) - (call-interactively function)) - -For example, you can restrict function `sp-forward-sexp' to just -the pairs for easier navigation of blocks in C-like languages." - (cl-letf (((symbol-value object) t)) - (call-interactively function))) - -;; TODO: add shorter alias? -(defun sp-restrict-to-pairs-interactive (pairs function) - "Return an interactive lambda that calls FUNCTION restricted to PAIRS. - -See `sp-restrict-to-pairs'. - -This function implements a \"decorator pattern\", that is, you -can apply another scoping function to the output of this function -and the effects will added together. In particular, you can -combine it with: - -- `sp-restrict-to-object-interactive' - -You can also bind the output of this function directly to a key, like: - - (global-set-key (kbd ...) (sp-restrict-to-pairs-interactive \"{\" 'sp-down-sexp)) - -This will be a function that descends down only into { } pair, -ignoring all others." - (lambda (&optional _arg) - (interactive "P") - (sp-restrict-to-pairs pairs function))) - -(defun sp-restrict-to-object-interactive (object function) - "Return an interactive lambda that calls FUNCTION restricted to OBJECT. - -See `sp-restrict-to-object'. - -This function implements a \"decorator pattern\", that is, you -can apply another scoping function to the output of this function -and the effects will added together. In particular, you can -combine it with: - -- `sp-restrict-to-pairs-interactive' - -You can also bind the output of this function directly to a key, like: - - (global-set-key (kbd ...) (sp-restrict-to-object-interactive - 'sp-prefix-pair-object - 'sp-forward-sexp)) - -This will be a function that navigates only by using paired -expressions, ignoring strings and sgml tags." - (lambda (&optional _arg) - (interactive "P") - (sp-restrict-to-object object function))) - -(defun sp-prefix-tag-object (&optional _arg) - "Read the command and invoke it on the next tag object. - -If you specify a regular emacs prefix argument this is passed to -the executed command. Therefore, executing -\"\\[universal-argument] 2 \\[sp-prefix-tag-object] \\[sp-forward-sexp]\" will move two tag -expressions forward, ignoring possible symbols or paired -expressions inbetween. - -Tag object is anything delimited by sgml tag." - (interactive "P") - (let* ((cmd (read-key-sequence "" t)) - (com (key-binding cmd)) - (sp-prefix-tag-object t)) - (if (commandp com) - (call-interactively com) - (execute-kbd-macro cmd)))) - -(defun sp-prefix-pair-object (&optional _arg) - "Read the command and invoke it on the next pair object. - -If you specify a regular emacs prefix argument this is passed to -the executed command. Therefore, executing -\"\\[universal-argument] 2 \\[sp-prefix-pair-object] \\[sp-forward-sexp]\" will move two paired -expressions forward, ignoring possible symbols inbetween. - -Pair object is anything delimited by pairs from `sp-pair-list'." - (interactive "P") - (let* ((cmd (read-key-sequence "" t)) - (com (key-binding cmd)) - (sp-prefix-pair-object t)) - (if (commandp com) - (call-interactively com) - (execute-kbd-macro cmd)))) - -(defun sp-prefix-symbol-object (&optional _arg) - "Read the command and invoke it on the next pair object. - -If you specify a regular emacs prefix argument this is passed to -the executed command. Therefore, executing -\"\\[universal-argument] 2 \\[sp-prefix-symbol-object] \\[sp-forward-sexp]\" will move two symbols -forward, ignoring any structure. - -Symbol is defined as a chunk of text recognized by -`sp-forward-symbol'." - (interactive "P") - (let* ((cmd (read-key-sequence "" t)) - (com (key-binding cmd)) - (sp-prefix-symbol-object t)) - (if (commandp com) - (call-interactively com) - (execute-kbd-macro cmd)))) - -(defun sp-prefix-save-excursion (&optional _arg) - "Execute the command keeping the point fixed. - -If you specify a regular emacs prefix argument this is passed to -the executed command." - (interactive "P") - (let* ((cmd (read-key-sequence "" t)) - (com (key-binding cmd))) - (sp--keep-indentation - (save-excursion - (if (commandp com) - (call-interactively com) - (execute-kbd-macro cmd)))))) - -(defun sp-get-thing (&optional back) - "Find next thing after point, or before if BACK is non-nil. - -Thing is either symbol (`sp-get-symbol'), -string (`sp-get-string') or balanced expression recognized by -`sp-get-sexp'. - -If `sp-navigate-consider-symbols' is nil, only balanced -expressions are considered." - (sp--maybe-init) - (sp--with-case-sensitive - (cond - (sp-prefix-tag-object (sp-get-sgml-tag back)) - (sp-prefix-pair-object (sp-get-paired-expression back)) - (sp-prefix-symbol-object (sp-get-symbol back)) - (t - (if back - (if (not sp-navigate-consider-symbols) - (sp-get-sexp t) - (save-excursion - (cond - ((sp-point-in-empty-string) - (sp-get-string t)) - (t - (sp-skip-backward-to-symbol t nil t) - (cond - ;; this is an optimization, we do not need to look up - ;; the "pair" expression first. If this fails, follow - ;; up with regular sexps - ((and (memq major-mode sp-navigate-consider-sgml-tags) - (or (sp--looking-back ">") - ;; sp-skip-backward-to-symbol moves the - ;; point to the end of an element name in - ;; js2-jsx-mode - (looking-at ">")) - (sp-get-sgml-tag t))) - ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-closing-regexp (sp--get-allowed-pair-list)) nil)) - (sp-get-sexp t)) - ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-opening-regexp (sp--get-allowed-pair-list)) nil)) - (sp-get-sexp t)) - ((and (eq (syntax-class (syntax-after (1- (point)))) 7) - (not (sp-char-is-escaped-p (1- (point))))) - (if (eq t (sp-point-in-string)) - (save-excursion - (save-restriction - (widen) - (-let (((beg . end) (sp-get-quoted-string-bounds))) - (narrow-to-region beg end)) - (sp-get-stringlike-expression t))) - (sp-get-string t))) - ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-stringlike-regexp) nil)) - (sp-get-expression t)) - ;; We might be somewhere inside the prefix of the - ;; sexp after the point. Since the prefix can be - ;; specified as regexp and not syntax class, it might - ;; itself by a symbol which would invalidly get - ;; picked here. - (t (-when-let (sym (sp-get-symbol t)) - (save-excursion - (sp-get sym (goto-char :end)) - (if (sp--valid-initial-delimiter-p (sp--looking-at (sp--get-opening-regexp (sp--get-allowed-pair-list)))) - (let* ((ms (match-string 0)) - (pref (sp--get-prefix (point) ms))) - (if (and pref - (not (equal pref ""))) - (sp-get-sexp t) - sym)) - sym))))))))) - (if (not sp-navigate-consider-symbols) - (sp-get-sexp nil) - (save-excursion - (cond - ((sp-point-in-empty-string) - (sp-get-string nil)) - (t - (sp-skip-forward-to-symbol t nil t) - (cond - ((and (memq major-mode sp-navigate-consider-sgml-tags) - (or (looking-at "<") - ;; sp-skip-forward-to-symbol moves the point - ;; to the beginning of an element name in - ;; js2-jsx-mode - (and (sp--looking-back "= because the first skip to - ;; symbol might have skipped some prefix - ;; chars which make prefix of the symbol - ;; which together make prefix of a sexp. - ;; For example \foo{} in latex, where \ is - ;; prefix of symbol foo and \foo is prefix - ;; of { - (if (and pref - (not (equal pref "")) - (>= point-before-prefix (- (point) (length pref)))) - (sp-get-sexp nil) - sym)) - sym)))))))))))))) - -(defun sp-narrow-to-sexp (arg) - "Make text outside current balanced expression invisible. -A numeric arg specifies to move up by that many enclosing expressions. - -See also `narrow-to-region' and `narrow-to-defun'." - (interactive "p") - (-when-let (enc (sp-get-enclosing-sexp arg)) - (sp-get enc (narrow-to-region :beg-prf :end)))) - -(defun sp-forward-sexp (&optional arg) - "Move forward across one balanced expression. - -With ARG, do it that many times. Negative arg -N means move -backward across N balanced expressions. If there is no forward -expression, jump out of the current one (effectively doing -`sp-up-sexp'). - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions. - -Examples: (prefix arg in comment) - - |(foo bar baz) -> (foo bar baz)| - - (|foo bar baz) -> (foo| bar baz) - - (|foo bar baz) -> (foo bar| baz) ;; 2 - - (foo (bar baz|)) -> (foo (bar baz)|)" - (interactive "^p") - (setq arg (or arg 1)) - (if (< arg 0) - (sp-backward-sexp (- arg)) - (let* ((n arg) - (ok t)) - (while (and ok (> n 0)) - (setq ok (sp-get-thing)) - (setq n (1- n)) - (when ok (goto-char (sp-get ok :end)))) - ok))) - -(put 'sp-forward-sexp 'CUA 'move) - -(defun sp-backward-sexp (&optional arg) - "Move backward across one balanced expression (sexp). - -With ARG, do it that many times. Negative arg -N means move -forward across N balanced expressions. If there is no previous -expression, jump out of the current one (effectively doing -`sp-backward-up-sexp'). - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions. - -Examples: (prefix arg in comment) - - (foo bar baz)| -> |(foo bar baz) - - (foo| bar baz) -> (|foo bar baz) - - (foo bar| baz) -> (|foo bar baz) ;; 2 - - ((|foo bar) baz) -> (|(foo bar) baz)" - (interactive "^p") - (setq arg (or arg 1)) - (if (< arg 0) - (sp-forward-sexp (- arg)) - (let* ((n arg) - (ok t)) - (while (and ok (> n 0)) - (setq ok (sp-get-thing t)) - (setq n (1- n)) - (when ok (goto-char (sp-get ok :beg)))) - ok))) - -(put 'sp-backward-sexp 'CUA 'move) - -(defun sp-next-sexp (&optional arg) - "Move forward to the beginning of next balanced expression. - -With ARG, do it that many times. If there is no next expression -at current level, jump one level up (effectively doing -`sp-backward-up-sexp'). Negative arg -N means move to the -beginning of N-th previous balanced expression. - -If `sp-navigate-interactive-always-progress-point' is non-nil, -and this is called interactively, the point will move to the -first expression in forward direction where it will end up -greater than the current location. - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions. - -Examples: - - ((foo) |bar (baz quux)) -> ((foo) bar |(baz quux)) - - ((foo) bar |(baz quux)) -> |((foo) bar (baz quux)) - -and with non-nil `sp-navigate-interactive-always-progress-point' - - (f|oo bar) -> (foo |bar) - - ((fo|o) (bar)) -> ((foo) |(bar))" - (interactive "^p") - (setq arg (or arg 1)) - (if (<= arg 0) - (sp-backward-sexp (- arg)) - (if (and sp-navigate-interactive-always-progress-point - (called-interactively-p 'any)) - (progn - (while (< 0 arg) - (let ((point-start (point))) - (while (--when-let (sp-forward-sexp) - (<= (sp-get it :beg) point-start)))) - (setq arg (1- arg))) - (goto-char (sp-get (sp-get-thing t) :beg))) - (if (= arg 1) - (-when-let (ok (sp-get-thing)) - (if (= (point) (sp-get ok :beg)) - (progn (sp-forward-sexp 2) - (sp-backward-sexp)) - (goto-char (sp-get ok :beg)) - ok)) - (sp-forward-sexp arg) - (sp-backward-sexp))))) - -(put 'sp-next-sexp 'CUA 'move) - -(defun sp-previous-sexp (&optional arg) - "Move backward to the end of previous balanced expression. - -With ARG, do it that many times. If there is no next -expression at current level, jump one level up (effectively -doing `sp-up-sexp'). Negative arg -N means move to the end of -N-th following balanced expression. - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions. - -If `sp-navigate-interactive-always-progress-point' is non-nil, -and this is called interactively, the point will move to the -first expression in backward direction where it will end up -less than the current location. - -Examples: - - ((foo) bar| (baz quux)) -> ((foo)| bar (baz quux)) - - ((foo)| bar (baz quux)) -> ((foo) bar (baz quux))| - -and if `sp-navigate-interactive-always-progress-point' is non-nil - - (foo b|ar baz) -> (foo| bar baz) - - (foo (b|ar baz)) -> (foo| (bar baz))" - (interactive "^p") - (setq arg (or arg 1)) - (if (<= arg 0) - (sp-forward-sexp (- arg)) - (if (and sp-navigate-interactive-always-progress-point - ;; (called-interactively-p 'any) - ) - (progn - (while (< 0 arg) - (let ((point-start (point))) - (while (--when-let (sp-backward-sexp) - (>= (sp-get it :end) point-start)))) - (setq arg (1- arg))) - (goto-char (sp-get (sp-get-thing) :end))) - (if (= arg 1) - (-when-let (ok (sp-get-thing t)) - (if (= (point) (sp-get ok :end)) - (progn (sp-backward-sexp 2) - (sp-forward-sexp)) - (goto-char (sp-get ok :end)) - ok)) - (sp-backward-sexp arg) - (sp-forward-sexp))))) - -(put 'sp-previous-sexp 'CUA 'move) - -(defun sp-forward-parallel-sexp (&optional arg) - "Move forward across one balanced expressions at the same depth. - -If calling `sp-forward-sexp' at point would result in raising a -level up, loop back to the first expression at current level, -that is the first child of the enclosing sexp as defined by -`sp-get-enclosing-sexp'." - (interactive "^p") - (setq arg (or arg 1)) - (if (< arg 0) - (sp-backward-parallel-sexp (- arg)) - (let (re) - (while (> arg 0) - (setq arg (1- arg)) - (let ((next (sp-get-thing)) - (prev (sp-get-thing t))) - (setq - re - (cond - ((eq next nil) - (goto-char (point-min)) - (sp-forward-sexp)) - ((eq prev nil) - (goto-char (sp-get next :end)) - next) - (t (if (> (sp-get next :beg) (sp-get prev :beg)) - (progn - (goto-char (sp-get next :end)) - next) - (goto-char (sp-get next :beg-in)) - (sp-forward-sexp))))))) - re))) - -(defun sp-backward-parallel-sexp (&optional arg) - "Move backward across one balanced expressions at the same depth. - -If calling `sp-backward-sexp' at point would result in raising a -level up, loop back to the last expression at current level, that -is the last child of the enclosing sexp as defined by -`sp-get-enclosing-sexp'." - (interactive "^p") - (setq arg (or arg 1)) - (if (< arg 0) - (sp-forward-parallel-sexp (- arg)) - (let (re) - (while (> arg 0) - (setq arg (1- arg)) - (let ((next (sp-get-thing)) - (prev (sp-get-thing t))) - (setq - re - (cond - ((eq prev nil) - (goto-char (point-max)) - (sp-backward-sexp)) - ((eq next nil) - (goto-char (sp-get prev :beg)) - prev) - (t (if (< (sp-get prev :end) (sp-get next :end)) - (progn - (goto-char (sp-get prev :beg)) - prev) - (goto-char (sp-get prev :end-in)) - (sp-backward-sexp))))))) - re))) - -(defun sp--raw-argument-p (arg) - "Return t if ARG represents raw argument, that is a non-empty list." - (and (listp arg) (car arg))) - -(defun sp--negate-argument (arg) - "Return the argument ARG but negated. - -If the argument is a raw prefix argument (cons num nil) return a -list with its car negated. If the argument is just the - symbol, -return 1. If the argument is nil, return -1. Otherwise negate -the input number." - (cond - ((sp--raw-argument-p arg) (list (- (car arg)))) - ((eq arg '-) 1) - ((not arg) -1) - (t (- arg)))) - -(defun sp-down-sexp (&optional arg) - "Move forward down one level of sexp. - -With ARG, do this that many times. A negative argument -N means -move backward but still go down a level. - -If ARG is raw prefix argument \\[universal-argument], descend forward as much as -possible. - -If ARG is raw prefix argument \\[universal-argument] \\[universal-argument], jump to the beginning of -current list. - -If the point is inside sexp and there is no down expression to -descend to, jump to the beginning of current one. If moving -backwards, jump to end of current one. - -Examples: - - |foo (bar (baz quux)) -> foo (|bar (baz quux)) - - |foo (bar (baz quux)) -> foo (bar (|baz quux)) ;; 2 - - |foo (bar (baz (quux) blab)) -> foo (bar (baz (|quux) blab)) ;; \\[universal-argument] - - (foo (bar baz) |quux) -> (|foo (bar baz) quux) - - (blab foo |(bar baz) quux) -> (|blab foo (bar baz) quux) ;; \\[universal-argument] \\[universal-argument]" - (interactive "^P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (n (abs arg)) - (ok t) - (last-point -1)) - (if (and raw (= (abs arg) 16)) - ;; jump to the beginning/end of current list - (-when-let (enc (sp-get-enclosing-sexp)) - (if (> arg 0) - (goto-char (sp-get enc :beg-in)) - (goto-char (sp-get enc :end-in))) - (setq ok enc)) - ;; otherwise descend normally - (while (and ok (> n 0)) - (setq ok (sp-get-sexp (< arg 0))) - ;; if the prefix was C-u, we do not decrease n and instead set - ;; it to -1 when (point) == "last ok" - (if raw - (when (= (point) last-point) - (setq n -1)) - (setq n (1- n))) - (when ok - (setq last-point (point)) - (if (< arg 0) - (goto-char (sp-get ok :end-in)) - (goto-char (sp-get ok :beg-in)))))) - ok)) - -(put 'sp-down-sexp 'CUA 'move) - -(defun sp-backward-down-sexp (&optional arg) - "Move backward down one level of sexp. - -With ARG, do this that many times. A negative argument -N means -move forward but still go down a level. - -If ARG is raw prefix argument \\[universal-argument], descend backward as much as -possible. - -If ARG is raw prefix argument \\[universal-argument] \\[universal-argument], jump to the end of current -list. - -If the point is inside sexp and there is no down expression to -descend to, jump to the end of current one. If moving forward, -jump to beginning of current one. - -Examples: - - foo (bar (baz quux))| -> foo (bar (baz quux)|) - - (bar (baz quux)) foo| -> (bar (baz quux|)) foo ;; 2 - - foo (bar (baz (quux) blab))| -> foo (bar (baz (quux|) blab)) ;; \\[universal-argument] - - (foo| (bar baz) quux) -> (foo (bar baz) quux|) - - (foo (bar baz) |quux blab) -> (foo (bar baz) quux blab|) ;; \\[universal-argument] \\[universal-argument]" - (interactive "^P") - (sp-down-sexp (sp--negate-argument arg))) - -(put 'sp-backward-down-sexp 'CUA 'move) - -(defun sp-beginning-of-sexp (&optional arg) - "Jump to beginning of the sexp the point is in. - -The beginning is the point after the opening delimiter. - -With no argument, this is the same as calling -\\[universal-argument] \\[universal-argument] `sp-down-sexp' - -With ARG positive N > 1, move forward out of the current -expression, move N-2 expressions forward and move down one level -into next expression. - -With ARG negative -N < 1, move backward out of the current -expression, move N-1 expressions backward and move down one level -into next expression. - -With ARG raw prefix argument \\[universal-argument] move out of the current expressions -and then to the beginning of enclosing expression. - -Examples: - - (foo (bar baz) quux| (blab glob)) -> (|foo (bar baz) quux (blab glob)) - - (foo (bar baz|) quux (blab glob)) -> (foo (|bar baz) quux (blab glob)) - - (|foo) (bar) (baz quux) -> (foo) (bar) (|baz quux) ;; 3 - - (foo bar) (baz) (quux|) -> (|foo bar) (baz) (quux) ;; -3 - - ((foo bar) (baz |quux) blab) -> (|(foo bar) (baz quux) blab) ;; \\[universal-argument]" - (interactive "^P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (re (cond - ((and raw (= arg 4)) - (sp-up-sexp) - (sp-beginning-of-sexp)) - ((= arg 1) - (sp-down-sexp '(16))) - ((< arg 0) - (sp-backward-up-sexp) - (sp-forward-sexp (1+ arg)) - (sp-down-sexp)) - ((> arg 0) - (sp-up-sexp) - (sp-forward-sexp (- arg 2)) - (sp-down-sexp))))) - (sp--run-hook-with-args (sp-get re :op) :post-handlers 'beginning-of-sexp) - re)) - -(put 'sp-beginning-of-sexp 'CUA 'move) - -(defun sp-end-of-sexp (&optional arg) - "Jump to end of the sexp the point is in. - -The end is the point before the closing delimiter. - -With no argument, this is the same as calling -\\[universal-argument] \\[universal-argument] `sp-backward-down-sexp'. - -With ARG positive N > 1, move forward out of the current -expression, move N-1 expressions forward and move down backward -one level into previous expression. - -With ARG negative -N < 1, move backward out of the current -expression, move N-2 expressions backward and move down backward -one level into previous expression. - -With ARG raw prefix argument \\[universal-argument] move out of the current expressions -and then to the end of enclosing expression. - -Examples: - - (foo |(bar baz) quux (blab glob)) -> (foo (bar baz) quux (blab glob)|) - - (foo (|bar baz) quux (blab glob)) -> (foo (bar baz|) quux (blab glob)) - - (|foo) (bar) (baz quux) -> (foo) (bar) (baz quux|) ;; 3 - - (foo bar) (baz) (quux|) -> (foo bar|) (baz) (quux) ;; -3 - - ((foo |bar) (baz quux) blab) -> ((foo bar) (baz quux) blab|) ;; \\[universal-argument]" - (interactive "^P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (re (cond - ((and raw (= arg 4)) - (sp-up-sexp) - (sp-end-of-sexp)) - ((= arg 1) - (sp-down-sexp '(-16))) - ((< arg 0) - (sp-backward-up-sexp) - (sp-forward-sexp (+ 2 arg)) - (sp-backward-down-sexp)) - ((> arg 0) - (sp-up-sexp) - (sp-forward-sexp (1- arg)) - (sp-backward-down-sexp))))) - (sp--run-hook-with-args (sp-get re :op) :post-handlers 'end-of-sexp) - re)) - -(put 'sp-end-of-sexp 'CUA 'move) - -(defun sp-beginning-of-next-sexp (&optional arg) - "Jump to the beginning of next sexp on the same depth. - -Optional argument ARG defaults to 1 and means how many times we -should repeat. - -This acts exactly as `sp-beginning-of-sexp' but adds 1 to the -numeric argument. - -Examples: - - (f|oo) (bar) (baz) -> (foo) (|bar) (baz) - - (f|oo) (bar) (baz) -> (foo) (bar) (|baz) ;; 2" - (interactive "^P") - (if (sp--raw-argument-p arg) - (sp-beginning-of-sexp arg) - (let ((arg (prefix-numeric-value arg))) - (if (> arg 0) - (sp-beginning-of-sexp (1+ arg)) - (sp-beginning-of-sexp (1- arg)))))) - -(put 'sp-beginning-of-next-sexp 'CUA 'move) - -(defun sp-beginning-of-previous-sexp (&optional arg) - "Jump to the beginning of previous sexp on the same depth. - -Optional argument ARG defaults to 1 and means how many times we -should repeat. - -This acts exactly as `sp-beginning-of-sexp' with negative -argument but subtracts 1 from it. - -Examples: - - (foo) (b|ar) (baz) -> (|foo) (bar) (baz) - - (foo) (bar) (b|az) -> (|foo) (bar) (baz) ;; 2" - (interactive "^P") - (if (sp--raw-argument-p arg) - (sp-beginning-of-sexp (sp--negate-argument arg)) - (let ((arg (prefix-numeric-value arg))) - (if (> arg 0) - (sp-beginning-of-sexp (- (1+ arg))) - (sp-beginning-of-sexp (- (1- arg))))))) - -(put 'sp-beginning-of-previous-sexp 'CUA 'move) - -(defun sp-end-of-next-sexp (&optional arg) - "Jump to the end of next sexp on the same depth. - -Optional argument ARG defaults to 1 and means how many times we -should repeat. - -This acts exactly as `sp-end-of-sexp' but adds 1 to the -numeric argument. - -Examples: - - (f|oo) (bar) (baz) -> (foo) (bar|) (baz) - - (f|oo) (bar) (baz) -> (foo) (bar) (baz|) ;; 2" - (interactive "^P") - (if (sp--raw-argument-p arg) - (sp-end-of-sexp arg) - (let ((arg (prefix-numeric-value arg))) - (if (> arg 0) - (sp-end-of-sexp (1+ arg)) - (sp-end-of-sexp (1- arg)))))) - -(put 'sp-end-of-next-sexp 'CUA 'move) - -(defun sp-end-of-previous-sexp (&optional arg) - "Jump to the end of previous sexp on the same depth. - -Optional argument ARG defaults to 1 and means how many times we -should repeat. - -This acts exactly as `sp-end-of-sexp' with negative -argument but subtracts 1 from it. - -Examples: - - (foo) (b|ar) (baz) -> (foo|) (bar) (baz) - - (foo) (bar) (b|az) -> (foo|) (bar) (baz) ;; 2" - (interactive "^P") - (if (sp--raw-argument-p arg) - (sp-end-of-sexp (sp--negate-argument arg)) - (let ((arg (prefix-numeric-value arg))) - (if (> arg 0) - (sp-end-of-sexp (- (1+ arg))) - (sp-end-of-sexp (- (1- arg))))))) - -(put 'sp-end-of-previous-sexp 'CUA 'move) - -;; TODO: split the reindent code so we can call it inside strings on -;; sexps like [foo ]... We can't reindent that by default because it -;; can be a regular expression or something where the whitespace -;; matters. For now, disable reindent in strings if the sexp is not -;; the string quote itself. -(defun sp-up-sexp (&optional arg interactive) - "Move forward out of one level of parentheses. - -With ARG, do this that many times. A negative argument means -move backward but still to a less deep spot. - -The argument INTERACTIVE is for internal use only. - -If called interactively and `sp-navigate-reindent-after-up' is -enabled for current major-mode, remove the whitespace between end -of the expression and the last \"thing\" inside the expression. -This behaviour can be suppressed for syntactic string sexps by -setting `sp-navigate-reindent-after-up-in-string' to nil. - -If `sp-navigate-close-if-unbalanced' is non-nil, close the -unbalanced expressions automatically. - -Examples: - - (foo |(bar baz) quux blab) -> (foo (bar baz) quux blab)| - - (foo (bar |baz) quux blab) -> (foo (bar baz) quux blab)| ;; 2 - - (foo bar |baz -> (foo bar baz)| ;; re-indent the expression -​ ) - - (foo |(bar baz) -> (foo)| (bar baz) ;; close unbalanced expr." - (interactive "^p\np") - (setq arg (or arg 1)) - (sp--with-case-sensitive - (let ((ok (sp-get-enclosing-sexp (abs arg)))) - (if ok - (progn - (if (> arg 0) - (goto-char (sp-get ok :end)) - (goto-char (sp-get ok :beg))) - (when (and (= (abs arg) 1) - (not (equal (sp-get ok :prefix) sp-comment-char)) - (or (memq major-mode (assq 'always sp-navigate-reindent-after-up)) - (and (memq major-mode (assq 'interactive sp-navigate-reindent-after-up)) - interactive)) - (or sp-navigate-reindent-after-up-in-string - (sp-get ok (not (sp-point-in-string :end-in)))) - ;; if the sexp to be reindented is not a string - ;; but is inside a string, we should rather do - ;; nothing than break semantics (in e.g. regexp - ;; [...]) - (let ((str (sp-point-in-string))) - (or (not str) - ;; op must be the delimiter of the string we're in - (eq (sp-get ok :op) - (or (eq str t) - (char-to-string str)))))) - ;; TODO: this needs different indent rules for different - ;; modes. Should we concern with such things? Lisp rules are - ;; funny in HTML... :/ - (save-excursion - (if (> arg 0) - (progn - (goto-char (sp-get ok :end-in)) - (let ((prev (sp-get-thing t))) - ;; if the expression is empty remove everything inside - (if (sp-compare-sexps ok prev) - (sp-get ok (delete-region :beg-in :end-in)) - (when (save-excursion - (skip-chars-backward " \t\n") - (= (point) (sp-get prev :end-suf))) - (delete-region (sp-get prev :end-suf) (point)))))) - (goto-char (sp-get ok :beg-in)) - (let ((next (sp-get-thing))) - (if (sp-compare-sexps ok next) - (sp-get ok (delete-region :beg-in :end-in)) - (when (save-excursion - (skip-chars-forward " \t\n") - (= (point) (sp-get next :beg-prf))) - (delete-region (point) (sp-get next :beg-prf))))))))) - ;; on forward up, we can detect that the pair was not closed. - ;; Therefore, jump sexps backwards until we hit the error, then - ;; extract the opening pair and insert it at point. Only works - ;; for pairs defined in `sp-pair-list'. - (when (and (> arg 0) - sp-navigate-close-if-unbalanced) - (let (active-pair) - (save-excursion - ;; add support for SGML tags here - (while (sp-backward-sexp)) - (sp-skip-backward-to-symbol t) - (when (sp--looking-back (sp--get-opening-regexp)) - (let* ((op (match-string 0))) - (setq active-pair (assoc op sp-pair-list))))) - (when active-pair - (sp-backward-sexp) - (sp-forward-sexp) - (insert (cdr active-pair)))))) - ok))) - -(put 'sp-up-sexp 'CUA 'move) - -(defun sp-backward-up-sexp (&optional arg interactive) - "Move backward out of one level of parentheses. - -With ARG, do this that many times. A negative argument means -move forward but still to a less deep spot. - -The argument INTERACTIVE is for internal use only. - -If called interactively and `sp-navigate-reindent-after-up' is -enabled for current major-mode, remove the whitespace between -beginning of the expression and the first \"thing\" inside the -expression. - -Examples: - - (foo (bar baz) quux| blab) -> |(foo (bar baz) quux blab) - - (foo (bar |baz) quux blab) -> |(foo (bar baz) quux blab) ;; 2 - - ( -> |(foo bar baz) -​ foo |bar baz)" - (interactive "^p\np") - (setq arg (or arg 1)) - (sp-up-sexp (- arg) interactive)) - -(put 'sp-backward-up-sexp 'CUA 'move) - -(defvar sp-last-kill-whitespace nil - "Save the whitespace cleaned after the last kill. - -If the next command is `sp-kill-sexp', append the whitespace -between the successive kills.") - -(defun sp--kill-or-copy-region (beg end &optional dont-kill) - "Kill or copy region between BEG and END according to DONT-KILL. -If `evil-mode' is active, copying a region will also add it to the 0 register. -Additionally, if command was prefixed with a register, copy the region -to that register." - (interactive) - (let ((result - (if dont-kill - (copy-region-as-kill beg end) - (kill-region beg end)))) - (when (bound-and-true-p evil-mode) - (when dont-kill - (evil-set-register ?0 (evil-get-register ?1))) - (when evil-this-register - (evil-set-register evil-this-register (evil-get-register ?1)) - (setq evil-this-register nil))) - result)) - -(defun sp-kill-sexp (&optional arg dont-kill) - "Kill the balanced expression following point. - -If point is inside an expression and there is no following -expression, kill the topmost enclosing expression. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction. - -With ARG being raw prefix \\[universal-argument], kill all the expressions from -point up until the end of current list. With raw prefix \\[negative-argument] \\[universal-argument], -kill all the expressions from beginning of current list up until -point. If point is inside a symbol, this is also killed. If -there is no expression after/before the point, just delete the -whitespace up until the closing/opening delimiter. - -With ARG being raw prefix \\[universal-argument] \\[universal-argument], kill current list (the list -point is inside). - -With ARG numeric prefix 0 (zero) kill the insides of the current -list, that is everything from after the opening delimiter to -before the closing delimiter. - -If ARG is nil, default to 1 (kill single expression forward) - -If second optional argument DONT-KILL is non-nil, save the to be -killed region in the kill ring, but do not kill the region from -buffer. - -With `sp-navigate-consider-symbols', symbols and strings are also -considered balanced expressions. - -Examples: - - (foo |(abc) bar) -> (foo | bar) ;; nil, defaults to 1 - - (foo (bar) | baz) -> | ;; 2 - - (foo |(bar) baz) -> | ;; \\[universal-argument] \\[universal-argument] - - (1 |2 3 4 5 6) -> (1|) ;; \\[universal-argument] - - (1 |2 3 4 5 6) -> (1 | 5 6) ;; 3 - - (1 2 3 4 5| 6) -> (1 2 3 | 6) ;; -2 - - (1 2 3 4| 5 6) -> (|5 6) ;; \\[negative-argument] \\[universal-argument] - - (1 2 | ) -> (1 2|) ;; \\[universal-argument], kill useless whitespace - - (1 2 3 |4 5 6) -> (|) ;; 0 - -Note: prefix argument is shown after the example in -\"comment\". Assumes `sp-navigate-consider-symbols' equal to t." - (interactive "P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (n (abs arg)) - (ok t) - (b (point-max)) - (e (point))) - (cond - ;; kill to the end or beginning of list - ((and raw - (= n 4)) - (let ((next (sp-get-thing (< arg 0))) - (enc (sp-get-enclosing-sexp))) - (if (sp-compare-sexps next enc) - (when (not dont-kill) - (let ((del (sp-get-whitespace))) - (sp-get del (delete-region :beg :end)))) - (if (> arg 0) - (sp--kill-or-copy-region - (sp-get next :beg-prf) (sp-get enc :end-in) dont-kill) - (sp--kill-or-copy-region - (sp-get next :end) (sp-get enc :beg-in) dont-kill)) - (when (not dont-kill) - (let ((del (sp-get-whitespace))) - (sp-get del (delete-region :beg :end))))))) - ;; kill the enclosing list - ((and raw - (= n 16)) - (let ((lst (sp-backward-up-sexp))) - (sp-get lst (sp--kill-or-copy-region - :beg-prf :end dont-kill)))) - ;; kill inside of sexp - ((= n 0) - (let ((e (sp-get-enclosing-sexp))) - (when e - (sp-get e (sp--kill-or-copy-region - :beg-in :end-in dont-kill))))) - ;; regular kill - (t - (save-excursion - (while (and (> n 0) ok) - (setq ok (sp-forward-sexp (sp--signum arg))) - (sp-get ok - (when (< :beg-prf b) (setq b :beg-prf)) - (when (> :end e) (setq e :end))) - (setq n (1- n)))) - (when ok - (let ((bm (set-marker (make-marker) b))) - (if (eq last-command 'kill-region) - (progn - (when (member sp-successive-kill-preserve-whitespace '(1 2)) - (kill-append sp-last-kill-whitespace nil)) - (sp--kill-or-copy-region - (if (> b (point)) (point) b) e dont-kill)) - (sp--kill-or-copy-region b e dont-kill)) - ;; kill useless junk whitespace, but only if we're actually - ;; killing the region - (when (not dont-kill) - (sp--cleanup-after-kill) - ;; kill useless newlines - (when (string-match-p "\n" (buffer-substring-no-properties bm (point))) - (setq sp-last-kill-whitespace - (concat sp-last-kill-whitespace - (buffer-substring-no-properties bm (point)))) - (delete-region bm (point))) - (when (= 0 sp-successive-kill-preserve-whitespace) - (kill-append sp-last-kill-whitespace nil))))))))) - -(defun sp--cleanup-after-kill () - (unless (save-match-data (looking-back "^[\t\s]+" (1- (line-beginning-position)))) - (let ((bdel (save-excursion - (when (sp--looking-back-p " " 1) - (skip-chars-backward " \t") - (when (not (sp--looking-back-p (sp--get-opening-regexp))) - (forward-char))) - (point))) - (edel (save-excursion - (when (looking-at " ") - (skip-chars-forward " \t") - (when (not (or (sp--looking-at (sp--get-closing-regexp)) - (looking-at "$"))) - (backward-char))) - (point)))) - (when (eq this-command 'kill-region) - (setq sp-last-kill-whitespace - (if (/= 2 sp-successive-kill-preserve-whitespace) - (buffer-substring-no-properties bdel edel) - ""))) - (delete-region bdel edel))) - (if (memq major-mode sp-lisp-modes) - ;; WARNING: The above white-space killing routine might preserve - ;; less whitespace than there actually is because the indent - ;; might further eat some up - (indent-according-to-mode) - (unless (or (memq major-mode sp-no-reindent-after-kill-modes) - (memq indent-line-function - sp-no-reindent-after-kill-indent-line-functions)) - (save-excursion - (sp--indent-region (line-beginning-position) (line-end-position))) - (when (> (save-excursion - (back-to-indentation) - (current-indentation)) - (current-column)) - (back-to-indentation))))) - -(defun sp-backward-kill-sexp (&optional arg dont-kill) - "Kill the balanced expression preceding point. - -This is exactly like calling `sp-kill-sexp' with minus ARG. -In other words, the direction of all commands is reversed. For -more information, see the documentation of `sp-kill-sexp'. - -Examples: - - (foo (abc)| bar) -> (foo | bar) - - blab (foo (bar baz) quux)| -> blab | - - (1 2 3 |4 5 6) -> (|4 5 6) ;; \\[universal-argument]" - (interactive "P") - (sp-kill-sexp (sp--negate-argument arg) dont-kill)) - -(defun sp-copy-sexp (&optional arg) - "Copy the following ARG expressions to the kill-ring. - -This is exactly like calling `sp-kill-sexp' with second argument -t. All the special prefix arguments work the same way." - (interactive "P") - (save-excursion - (sp-kill-sexp arg t))) - -(defun sp-backward-copy-sexp (&optional arg) - "Copy the previous ARG expressions to the kill-ring. - -This is exactly like calling `sp-backward-kill-sexp' with second argument -t. All the special prefix arguments work the same way." - (interactive "P") - (save-excursion - (sp-kill-sexp (sp--negate-argument arg) t))) - -(defun sp-clone-sexp () - "Clone sexp after or around point. - -If the form immediately after point is a sexp, clone it below the -current one and put the point in front of it. - -Otherwise get the enclosing sexp and clone it below the current -enclosing sexp." - (interactive) - (-when-let (ok (let ((sexp (sp-get-thing))) - (if (not (equal (sp-get sexp :op) "")) - sexp - (sp-get-enclosing-sexp)))) - (sp-get ok - (undo-boundary) - (if (< :beg-prf (point)) - ;; this is the case where point is inside a sexp, we place - ;; the "clone" before the current enclosing sexp and move - ;; the old one below. Note that the "net result" is the - ;; same as the other case, but the implementation must - ;; reflect different relative position of the point wrt - ;; "current" sexp. - (save-excursion - (goto-char :beg-prf) - (insert-buffer-substring-no-properties - (current-buffer) :beg-prf :end-suf) - (newline-and-indent)) - ;; in this case we are in front, so we move after the current - ;; one, place the clone and move it below - (goto-char :end-suf) - (save-excursion - (insert-buffer-substring-no-properties - (current-buffer) :beg-prf :end-suf)) - (newline-and-indent)) - (sp-indent-defun)))) - -(defun sp-kill-hybrid-sexp (arg) - "Kill a line as if with `kill-line', but respecting delimiters. - -With ARG being raw prefix \\[universal-argument] \\[universal-argument], kill the hybrid sexp -the point is in (see `sp-get-hybrid-sexp'). - -With ARG numeric prefix 0 (zero) just call `kill-line'. - -You can customize the behaviour of this command by toggling -`sp-hybrid-kill-excessive-whitespace'. - -Examples: - - foo | bar baz -> foo | ;; nil - - foo (bar | baz) quux -> foo (bar |) quux ;; nil - - foo | bar (baz -> foo | ;; nil - quux) - - foo \"bar |baz quux\" quack -> foo \"bar |\" quack ;; nil - - foo (bar - baz) qu|ux (quack -> foo | hoo ;; \\[universal-argument] \\[universal-argument] - zaq) hoo - - foo | (bar -> foo | ;; C-0 - baz) baz)" - (interactive "P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (orig-indent (save-excursion - (back-to-indentation) - (current-column))) - (orig-column (current-column))) - (cond - ((= arg 0) (kill-line)) - ((and raw (= arg 16)) - (let ((hl (sp-get-hybrid-sexp))) - (sp-get hl (kill-region :beg-prf :end-suf)))) - (t - (let ((hl (sp-get-hybrid-sexp))) - (save-excursion - (when (and (or (eq sp-hybrid-kill-entire-symbol t) - (and (functionp sp-hybrid-kill-entire-symbol) - (not (funcall sp-hybrid-kill-entire-symbol)))) - (sp-point-in-symbol)) - (sp-backward-sexp)) - (sp-get hl - (let ((end (min (point-max) (if (looking-at "[ \t]*$") - (1+ :end-suf) - :end-suf)))) - (when sp-hybrid-kill-excessive-whitespace - (save-excursion - (goto-char end) - (skip-chars-forward "\n\t\r\s") - (cond - ((eq 'kill sp-hybrid-kill-excessive-whitespace) - (setq end (point))) - (t (delete-region end (point)))))) - (kill-region (point) end))))) - (sp--cleanup-after-kill) - ;; if we've killed the entire line, do *not* contract the indent - ;; to just one space - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (line-end-position)) - (if (and (= 0 orig-column) - kill-whole-line) - (delete-char 1) ;; delete the newline - (let ((need-indent (- orig-indent (current-column)))) - (when (> need-indent 0) - (insert (make-string need-indent ?\ )))))))))) - -(defun sp-kill-whole-line () - "Kill current line in sexp-aware manner. - -First, go to the beginning of current line and then try to kill -as much as possible on the current line but without breaking -balance. - -If there is a hanging sexp at the end of line the it is killed as -well. - -If there is a closing delimiter for a sexp \"up\" current sexp, -the kill is not extended after it. For more details see -`sp-kill-hybrid-sexp'. - -Examples: - - (progn (progn - (some |long sexp)) -> |)" - (interactive) - (beginning-of-line) - (sp-kill-hybrid-sexp nil) - (let ((empty-last-line (save-excursion (beginning-of-line) (eobp)))) - ;; We can't kill the line if it is empty and the last line - (when (and (sp-point-in-blank-line) (not empty-last-line)) - (kill-whole-line)))) - -(defun sp--transpose-objects (first second) - "Transpose FIRST and SECOND object while preserving the -whitespace between them." - (save-excursion - (goto-char (sp-get second :beg-prf)) - (let ((ins (sp-get second (delete-and-extract-region :beg-prf :end))) - (between (delete-and-extract-region (sp-get first :end) (point)))) - (goto-char (sp-get first :beg-prf)) - (insert ins between)))) - -(defun sp-transpose-sexp (&optional arg) - "Transpose the expressions around point. - -The operation will move the point after the transposed block, so -the next transpose will \"drag\" it forward. - -With arg positive N, apply that many times, dragging the -expression forward. - -With arg negative -N, apply N times backward, pushing the word -before cursor backward. This will therefore not transpose the -expressions before and after point, but push the expression -before point over the one before it. - -Examples: - - foo |bar baz -> bar foo| baz - - foo |bar baz -> bar baz foo| ;; 2 - - (foo) |(bar baz) -> (bar baz) (foo)| - - (foo bar) -> (baz quux) ;; keeps the formatting -​ |(baz quux) |(foo bar) - - foo bar baz| -> foo baz| bar ;; -1" - (interactive "P") - (let* ((arg (prefix-numeric-value arg)) - (n (abs arg))) - ;; if we're inside a symbol, we need to move out of it first - (when (> arg 0) - (when (sp-point-in-symbol) - (sp-forward-symbol))) - (while (> n 0) - (when (< arg 0) (sp-backward-sexp)) - (let* ((next (save-excursion (sp-forward-sexp))) - (prev (save-excursion (goto-char (sp-get next :beg-prf)) (sp-backward-sexp)))) - (sp--transpose-objects prev next) - (when (< arg 0) - (goto-char (+ (sp-get prev :beg-prf) (sp-get next :len)))) - (setq n (1- n)))))) - -(defun sp-transpose-hybrid-sexp (&optional arg) - "Transpose the hybrid sexps around point. - -`sp-backward-sexp' is used to enter the previous hybrid sexp. - -With ARG numeric prefix call `transpose-lines' with this -argument. - -The operation will move the point at the next line after the -transposed block if it is at the end of line already. - -Examples: - - foo bar baz (quux - |baz (quux -> quack) - quack) foo bar\\n| - - - [(foo) (bar) -> [(baz) - |(baz)] (foo) (bar)|] - - foo bar baz -> quux flux - |quux flux foo bar baz\\n|" - (interactive "P") - (if (numberp arg) - (transpose-lines arg) - (let* ((next (save-excursion - (sp-forward-sexp) - (sp-backward-sexp) - (sp-get-hybrid-sexp))) - (prev (save-excursion - (goto-char (sp-get next :beg)) - (sp-backward-sexp) - (sp-get-hybrid-sexp)))) - (if (sp-compare-sexps prev next > :end) - (sp-message :invalid-context-prev) - (sp--transpose-objects prev next)) - (when (looking-at "[\n\t ]+") - (forward-line) - (back-to-indentation))))) - -(defun sp-push-hybrid-sexp () - "Push the hybrid sexp after point over the following one. - -`sp-forward-sexp' is used to enter the following hybrid sexp. - -Examples: - - |x = big_function_call(a, |(a, - b) b) = read_user_input() - -> - (a, x = big_function_call(a, - b) = read_user_input() b)" - (interactive) - (let* ((cur (sp-get-hybrid-sexp)) - (next (save-excursion - (goto-char (sp-get cur :end)) - (sp-forward-sexp) - (sp-get-hybrid-sexp)))) - (if (sp-compare-sexps cur next >) - (sp-message :invalid-context-cur) - (sp--transpose-objects cur next)))) - -;; The following two functions are inspired by "adjust-parens.el" -;; package available at -;; http://elpa.gnu.org/packages/adjust-parens-1.0.el -(defun sp-indent-adjust-sexp () - "Add the hybrid sexp at line into previous sexp. All forms -between the two are also inserted. Specifically, if the point is -on empty line, move the closing delimiter there, so the next -typed text will become the last item of the previous sexp. - -This acts similarly to `sp-add-to-previous-sexp' but with special -handling of empty lines." - (interactive) - (let* ((hsexp (sp-get-hybrid-sexp)) - (prev-sexp (save-excursion - (goto-char (sp-get hsexp :beg)) - (sp-get-sexp t)))) - (if (not (and prev-sexp hsexp - (sp-compare-sexps prev-sexp hsexp < :end :beg))) - (sp-message :no-structure-found) - (save-excursion - (sp-get prev-sexp - (goto-char (sp-get hsexp :end)) - (insert :cl) - (goto-char :end-in) - (delete-char :cl-l))) - (sp-get (sp-get-enclosing-sexp) (sp--indent-region :beg :end)) - (indent-according-to-mode) - (sp--run-hook-with-args (sp-get prev-sexp :op) :post-handlers 'indent-adjust-sexp)))) - -(defun sp-dedent-adjust-sexp () - "Remove the hybrid sexp at line from previous sexp. All -sibling forms after it are also removed (not deleted, just placed -outside of the enclosing list). Specifically, if the point is on -empty line followed by closing delimiter of enclosing list, move -the closing delimiter after the last item in the list. - -This acts similarly to `sp-forward-barf-sexp' but with special -handling of empty lines." - (interactive) - (-when-let (enc (sp-get-enclosing-sexp)) - (save-excursion - ;; if we're looking at whitespace and end of sexp, move the - ;; closing paren over the whitespace but *after* the last item - ;; in the list (barf would also go *before* the last item) - (sp-skip-forward-to-symbol t) - (if (= (point) (sp-get enc :end-in)) - (let ((prev-sexp (sp-get-thing t))) - (sp-get enc - (delete-char :cl-l) - (goto-char (sp-get prev-sexp :end)) - ;; see next TODO - (save-restriction - (sp--narrow-to-line) - (skip-syntax-forward " ") - (skip-syntax-forward ".")) - (insert :cl))) - ;; otherwise just C-u barf - (sp-skip-backward-to-symbol t) - (sp-forward-barf-sexp '(4)) - ;; we need to take special care of any hanging - ;; punctuation. TODO: this should be a sexp suffix? HACK until - ;; we fix barf to get the info. - (save-restriction - (sp-get (sp-backward-down-sexp) - (goto-char :end) - (delete-char (- :cl-l)) - (sp--narrow-to-line) - (skip-syntax-forward " ") - (skip-syntax-forward ".") - (insert :cl))) - (sp-get enc (sp--indent-region :beg :end)))) - (indent-according-to-mode) - (sp--run-hook-with-args (sp-get enc :op) :post-handlers 'dedent-adjust-sexp))) - -;; "When the hook is called point is *after* the just moved closing delimiter." -;; TODO: add hook -(defun sp-slurp-hybrid-sexp () - "Add hybrid sexp following the current list in it by moving the -closing delimiter. - -This is philosophically similar to `sp-forward-slurp-sexp' but -works better in \"line-based\" languages like C or Java. - -Because the structure is much looser in these languages, this -command currently does not support all the prefix argument -triggers that `sp-forward-slurp-sexp' does." - (interactive) - (let (slurped-within-line) - (-if-let* ((enc (sp-get-enclosing-sexp)) - (bsexp (save-excursion - (sp-get enc (goto-char :end)) - (when (sp-compare-sexps (sp-forward-sexp) enc >) - (sp-get-hybrid-sexp))))) - (save-excursion - (sp-get enc - (goto-char :end-suf) - (delete-char (- (+ :cl-l :suffix-l))) - ;; TODO: move to hook - (when (sp-point-in-blank-line) - (delete-region (line-beginning-position) (1+ (line-end-position)))) - (sp-forward-sexp) - - (when (eq (line-number-at-pos :beg) - (line-number-at-pos :end)) - (setq slurped-within-line t)) - ;; If we're slurping over multiple lines, include the suffix on the next line. - ;; I.e. while () {|} -> while () {\n foo(); \n} - (unless slurped-within-line - (sp-get (sp-get-hybrid-sexp) (goto-char :end-suf))) - (insert :cl :suffix)) - ;; TODO: move to hook - (sp-get (sp--next-thing-selection -1) - (save-excursion - (if (save-excursion - (goto-char :beg-in) - (looking-at "[ \t]*$")) - (progn - (goto-char :end-in) - (newline)) - ;; copy the whitespace after opening delim and put it in - ;; front of the closing. This will ensure pretty { foo } - ;; or {foo} - (goto-char :end-in) - (insert (buffer-substring-no-properties - :beg-in - (+ :beg-in (save-excursion - (goto-char :beg-in) - (skip-syntax-forward " "))))))) - (unless (or (looking-at "[ \t]*$") - (looking-at (sp--get-stringlike-regexp)) - (looking-at (sp--get-closing-regexp)) - slurped-within-line) - (newline))) - (sp-get (sp--next-thing-selection -1) (sp--indent-region :beg :end)) - ;; we need to call this again to get the new structure after - ;; indent. - (sp--next-thing-selection -1)) - (sp-message :invalid-structure) - nil))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; "paredit" operations - -(defun sp-forward-slurp-sexp (&optional arg) - "Add sexp following the current list in it by moving the closing delimiter. - -If the current list is the last in a parent list, extend that -list (and possibly apply recursively until we can extend a list -or end of file). - -If ARG is N, apply this function that many times. - -If ARG is negative -N, extend the opening pair instead (that is, -backward). - -If ARG is raw prefix \\[universal-argument], extend all the way to the end of the parent list. - -If both the current expression and the expression to be slurped -are strings, they are joined together. - -See also `sp-slurp-hybrid-sexp' which is similar but handles -C-style syntax better. - -Examples: - - (foo |bar) baz -> (foo |bar baz) - - [(foo |bar)] baz -> [(foo |bar) baz] - - [(foo |bar) baz] -> [(foo |bar baz)] - - ((|foo) bar baz quux) -> ((|foo bar baz quux)) ;; with \\[universal-argument] - - \"foo| bar\" \"baz quux\" -> \"foo| bar baz quux\"" - (interactive "P") - (if (> (prefix-numeric-value arg) 0) - (let ((n (abs (prefix-numeric-value arg))) - (enc (sp-get-enclosing-sexp)) - (in-comment (sp-point-in-comment)) - next-thing ok) - (when enc - (save-excursion - (if (sp--raw-argument-p arg) - (progn - (goto-char (sp-get enc :end-suf)) - (setq next-thing (sp-get-enclosing-sexp)) - (when next-thing - (goto-char (sp-get next-thing :end-in)) - (sp--run-hook-with-args (sp-get enc :op) :pre-handlers 'slurp-forward - (list :arg arg :enc enc :next-thing next-thing)) - (sp-get enc (insert :cl :suffix)) - (goto-char (sp-get enc :end-suf)) - (delete-char (sp-get enc (- (+ :cl-l :suffix-l)))) - (sp--indent-region (sp-get enc :beg-prf) (sp-get next-thing :end)) - (sp--run-hook-with-args (sp-get enc :op) :post-handlers 'slurp-forward - (list :arg arg :enc enc :next-thing next-thing)))) - (while (> n 0) - (goto-char (sp-get enc :end-suf)) - (setq ok enc) - (setq next-thing (sp-get-thing nil)) - (while (sp-compare-sexps next-thing ok <) - (goto-char (sp-get next-thing :end-suf)) - (setq ok next-thing) - (setq next-thing (sp-get-thing nil))) - ;; do not allow slurping into a different context from - ;; inside a comment - (if (and in-comment - (save-excursion - (sp-get next-thing - (goto-char :beg) - (not (sp-point-in-comment))))) - (progn - (sp-message :cant-slurp-context) - (setq n -1)) - (if ok - (progn - (if (and (equal (sp-get next-thing :cl) "\"") - (equal (sp-get ok :cl) "\"")) - (progn - (sp--join-sexp ok next-thing) - (goto-char (- (sp-get next-thing :end) 2)) - (plist-put enc :end (- (sp-get next-thing :end) 2))) - (let ((inner-sexp - (save-excursion - (goto-char (sp-get ok :end-in)) - (sp-get-thing t)))) - (delete-char (sp-get ok (- (+ :cl-l :suffix-l)))) - ;; this calculation corrects the absence - ;; of already deleted cls - (goto-char (- (sp-get next-thing :end-suf) - (sp-get ok (+ :cl-l :suffix-l)))) - ;; only insert space if not inserting it - ;; would merge two sexps together - (when (and (sp-get ok (/= :len-in 0)) - (sp-compare-sexps - inner-sexp - (sp-get-thing t)) - (= (sp-get ok :end-suf) - (sp-get next-thing :beg-prf))) - (save-excursion - (goto-char (sp-get ok :end-in)) - (insert " ")))) - (sp--run-hook-with-args - (sp-get enc :op) :pre-handlers 'slurp-forward - (list :arg arg :enc enc :ok ok :next-thing next-thing)) - (sp-get ok (insert :cl :suffix)) - (sp--indent-region (sp-get ok :beg-prf) (point)) - ;; HACK: update the "enc" data structure if ok==enc - (when (= (sp-get enc :beg) (sp-get ok :beg)) (plist-put enc :end (point))) - (sp--run-hook-with-args - (sp-get enc :op) :post-handlers 'slurp-forward - (list :arg arg :enc enc :ok ok :next-thing next-thing))) - (setq n (1- n))) - (sp-message :cant-slurp) - (setq n -1)))))))) - (sp-backward-slurp-sexp (sp--negate-argument arg)))) - -(defun sp-backward-slurp-sexp (&optional arg) - "Add the sexp preceding the current list in it by moving the opening delimiter. - -If the current list is the first in a parent list, extend that -list (and possibly apply recursively until we can extend a list -or beginning of file). - -If arg is N, apply this function that many times. - -If arg is negative -N, extend the closing pair instead (that is, -forward). - -If ARG is raw prefix \\[universal-argument], extend all the way to the beginning of the parent list. - -If both the current expression and the expression to be slurped -are strings, they are joined together. - -Examples: - - foo (bar| baz) -> (foo bar| baz) - - foo [(bar| baz)] -> [foo (bar| baz)] - - [foo (bar| baz)] -> [(foo bar| baz)] - - (foo bar baz (|quux)) -> ((foo bar baz |quux)) ;; with \\[universal-argument] - - \"foo bar\" \"baz |quux\" -> \"foo bar baz |quux\"" - (interactive "P") - (if (> (prefix-numeric-value arg) 0) - (let ((n (abs (prefix-numeric-value arg))) - (enc (sp-get-enclosing-sexp)) - (in-comment (sp-point-in-comment)) - next-thing ok) - (when enc - (save-excursion - (if (sp--raw-argument-p arg) - (progn - (goto-char (sp-get enc :beg-prf)) - (setq next-thing (sp-get-enclosing-sexp)) - (when next-thing - (delete-char (sp-get enc (+ :op-l :prefix-l))) - (goto-char (sp-get next-thing :beg-in)) - (sp--run-hook-with-args - (sp-get enc :op) :pre-handlers 'slurp-backward - (list :arg arg :enc enc :next-thing next-thing)) - (sp-get enc (insert :prefix :op)) - (sp--indent-region (sp-get next-thing :beg-in) (sp-get enc :end)) - (sp--run-hook-with-args - (sp-get enc :op) :post-handlers 'slurp-backward - (list :arg arg :enc enc :next-thing next-thing)))) - (while (> n 0) - (goto-char (sp-get enc :beg-prf)) - (setq ok enc) - (setq next-thing (sp-get-thing t)) - (while (sp-compare-sexps next-thing ok > :end) - (goto-char (sp-get next-thing :beg-prf)) - (setq ok next-thing) - (setq next-thing (sp-get-thing t))) - ;; do not allow slurping into a different context from - ;; inside a comment - (if (and in-comment - (save-excursion - (sp-get next-thing - (goto-char :beg) - (not (sp-point-in-comment))))) - (progn - (sp-message :cant-slurp-context) - (setq n -1)) - (if ok - (progn - (if (and (equal (sp-get next-thing :cl) "\"") - (equal (sp-get ok :cl) "\"")) - (progn - (sp--join-sexp next-thing ok) - (goto-char (sp-get next-thing :beg-prf)) - (plist-put enc :beg (sp-get next-thing :beg))) - (let ((inner-sexp - (save-excursion - (goto-char (sp-get ok :beg-in)) - (sp-get-thing)))) - (delete-char (sp-get ok (+ :op-l :prefix-l))) - (goto-char (sp-get next-thing :beg-prf)) - ;; only insert space if not inserting it - ;; would merge two sexps together - (when (and (sp-get ok (/= :len-in 0)) - (= (sp-get ok (- (sp-get inner-sexp :end) - :op-l :prefix-l)) - (sp-get (sp-get-thing) :end)) - (= (sp-get ok :beg-prf) - (sp-get next-thing :end-suf))) - (save-excursion - (goto-char (sp-get ok (- :beg-in :op-l :prefix-l))) - (insert " ")))) - (sp--run-hook-with-args - (sp-get enc :op) :pre-handlers 'slurp-backward - (list :arg arg :enc enc :ok ok :next-thing next-thing)) - (sp-get ok (insert :prefix :op)) - (sp--indent-region (point) (sp-get ok :end)) - ;; HACK: update the "enc" data structure if ok==enc - (when (sp-compare-sexps enc ok) (plist-put enc :beg (- (point) (sp-get ok :op-l)))) - (sp--run-hook-with-args - (sp-get enc :op) :post-handlers 'slurp-backward - (list :arg arg :enc enc :ok ok :next-thing next-thing))) - (setq n (1- n))) - (sp-message :cant-slurp) - (setq n -1)))))))) - (sp-forward-slurp-sexp (sp--negate-argument arg)))) - -(defun sp-add-to-previous-sexp (&optional arg) - "Add the expression around point to the first list preceding point. - -With ARG positive N add that many expressions to the preceding -list. - -If ARG is raw prefix argument \\[universal-argument] add all expressions until -the end of enclosing list to the previous list. - -If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] add the current -list into the previous list. - -Examples: - - (foo bar) |baz quux -> (foo bar |baz) quux - - (foo bar) |baz quux -> (foo bar |baz quux) ;; 2 - - (blab (foo bar) |baz quux) -> (blab (foo bar |baz quux)) ;; \\[universal-argument] - - (foo bar) (baz |quux) -> (foo bar (baz |quux)) ;; \\[universal-argument] \\[universal-argument]" - (interactive "P") - (save-excursion - (cond - ((equal arg '(16)) - (sp-backward-up-sexp) - (sp-backward-down-sexp) - (sp-forward-slurp-sexp)) - (t - (sp-backward-down-sexp) - (sp-forward-slurp-sexp arg)))) - (indent-according-to-mode)) - -(defun sp-add-to-next-sexp (&optional arg) - "Add the expressions around point to the first list following point. - -With ARG positive N add that many expressions to the following -list. - -If ARG is raw prefix argument \\[universal-argument] add all expressions until -the beginning of enclosing list to the following list. - -If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] add the current -list into the following list. - -Examples: - - foo bar| (baz quux) -> foo (bar| baz quux) - - foo bar| (baz quux) -> (foo bar| baz quux) ;; 2 - - (foo bar |(bar quux) blab) -> ((foo bar |bar quux) blab) ;; \\[universal-argument] - - (foo |bar) (baz quux) -> ((foo |bar) baz quux) ;; \\[universal-argument] \\[universal-argument]" - (interactive "P") - (save-excursion - (cond - ((equal arg '(16)) - (sp-up-sexp) - (sp-down-sexp) - (sp-backward-slurp-sexp)) - (t - (sp-down-sexp) - (sp-backward-slurp-sexp arg))))) - -(defun sp-forward-barf-sexp (&optional arg) - "Remove the last sexp in the current list by moving the closing delimiter. - -If ARG is positive number N, barf that many expressions. - -If ARG is negative number -N, contract the opening pair instead. - -If ARG is raw prefix \\[universal-argument], barf all expressions from the one after -point to the end of current list and place the point before the -closing delimiter of the list. - -If the current list is empty, do nothing. - -Examples: (prefix arg in comment) - - (foo bar| baz) -> (foo bar|) baz ;; nil (defaults to 1) - - (foo| [bar baz]) -> (foo|) [bar baz] ;; 1 - - (1 2 3| 4 5 6) -> (1 2 3|) 4 5 6 ;; \\[universal-argument] (or numeric prefix 3) - - (foo bar| baz) -> foo (bar| baz) ;; -1" - (interactive "P") - (let* ((raw (sp--raw-argument-p arg)) - (old-arg arg) - (arg (prefix-numeric-value arg))) - (if (> arg 0) - (if (sp-point-in-blank-sexp) - (sp-message :blank-sexp) - (save-excursion - (let ((enc (sp-get-enclosing-sexp))) - (sp-get enc - (cond - ((and raw (= arg 4)) - (sp-get (sp-get-thing t) - (goto-char :end-suf))) - (t - (goto-char :end-in) - (sp-backward-sexp arg) - (when (<= (point) :beg) - (goto-char :beg-in)))) - ;; we know for sure there is at least one thing in the list - (let ((back (sp-get-thing t))) - (if (sp-compare-sexps back enc) - (goto-char :beg-in) - (goto-char (sp-get back :end-suf)))) - (sp--run-hook-with-args :op :pre-handlers 'barf-forward - (list :arg arg :enc enc))) - (sp-get (sp-get-enclosing-sexp) - (sp-do-move-cl (point)) - (sp--keep-indentation - (sp--indent-region :beg :end)) - (sp--run-hook-with-args :op :post-handlers 'barf-forward - (list :arg arg :enc enc)))))) - (sp-backward-barf-sexp (sp--negate-argument old-arg))))) - -(defun sp-backward-barf-sexp (&optional arg) - "This is exactly like calling `sp-forward-barf-sexp' with minus ARG. -In other words, instead of contracting the closing pair, the -opening pair is contracted. For more information, see the -documentation of `sp-forward-barf-sexp'. - -Examples: - - (foo bar| baz) -> foo (bar| baz) - - ([foo bar] |baz) -> [foo bar] (|baz) - - (1 2 3 |4 5 6) -> 1 2 3 (|4 5 6) ;; \\[universal-argument] (or 3)" - (interactive "P") - (let* ((raw (sp--raw-argument-p arg)) - (old-arg arg) - (arg (prefix-numeric-value arg))) - (if (> arg 0) - (if (sp-point-in-blank-sexp) - (sp-message :blank-sexp) - (save-excursion - (let ((enc (sp-get-enclosing-sexp))) - (sp-get enc - (cond - ((and raw (= arg 4)) - (sp-get (sp-get-thing) - (goto-char :beg-prf))) - (t - (goto-char :beg-in) - (sp-forward-sexp arg) - (when (>= (point) :end) - (goto-char :end-in)))) - ;; we know for sure there is at least one thing in the list - (let ((next (sp-get-thing))) - (if (sp-compare-sexps next enc) - (goto-char :end-in) - (goto-char (sp-get next :beg-prf)))) - (sp--run-hook-with-args :op :pre-handlers 'barf-backward - (list :arg arg :enc enc))) - (sp-get (sp-get-enclosing-sexp) - (sp-do-move-op (point)) - (sp--indent-region :beg :end) - (sp--run-hook-with-args :op :post-handlers 'barf-backward - (list :arg arg :enc enc)))))) - (sp-forward-barf-sexp (sp--negate-argument old-arg))))) - -;; TODO: get rid of the macro anyway, it's stupid! -(defmacro sp--skip-to-symbol-1 (forward) - "Generate `sp-skip-forward-to-symbol' or `sp-skip-backward-to-symbol'." - (let ((inc (if forward '1+ '1-)) - (dec (if forward '1- '1+)) - (forward-fn (if forward 'forward-char 'backward-char)) - (next-char-fn (if forward 'following-char 'preceding-char)) - (looking (if forward 'sp--looking-at 'sp--looking-back)) - (prefix-fn (if forward 'sp--get-suffix 'sp--get-prefix)) - (eob-test (if forward '(eobp) '(bobp))) - (comment-bound (if forward 'cdr 'car))) - `(let ((in-comment (sp-point-in-comment)) - ;; HACK: if we run out of current context this might skip a - ;; pair that was not allowed before. However, such a call is - ;; never made in SP, so it's OK for now - (allowed-pairs (sp--get-allowed-regexp)) - ,(if forward - '(allowed-close (sp--get-closing-regexp (sp--get-allowed-pair-list))) - '(allowed-open (sp--get-opening-regexp (sp--get-allowed-pair-list)))) - (allowed-strings (sp--get-stringlike-regexp)) - (prefix nil)) - (while (and (not (or ,eob-test - (and stop-after-string - (not (sp-point-in-string)) - (sp-point-in-string (,dec (point)))) - (and stop-at-string - (not (sp-point-in-string)) - (sp-point-in-string (,inc (point)))) - (and stop-inside-string - (sp-point-in-string) - (not (sp-point-in-string (,inc (point))))) - (and (,looking allowed-pairs) - (or in-comment (not (sp-point-in-comment)))) - (and (,looking allowed-strings) - (or in-comment (not (sp-point-in-comment)))))) - (or (member (char-syntax (,next-char-fn)) '(?< ?> ?! ?| ?\ ?\\ ?\" ?' ?.)) - (/= 0 (logand (lsh 1 20) (car (syntax-after - ,(if forward - '(point) - '(1- (point))))))) - (unless in-comment (sp-point-in-comment)) - ;; This is the case where we are starting at - ;; pair (looking at it) and there is some - ;; prefix which is not recognized by syntax, - ;; i.e. defined by regexp. This should only be - ;; tested once in principle before the next - ;; time we land on a delimiter this whole loop - ;; stops based on the first branch of the `and' - ;; condition in `while' so using expensive - ;; functions here is not a bg deal. - (and (or (,(if forward 'sp--looking-back 'sp--looking-at) - ,(if forward 'allowed-close 'allowed-open)) - (,(if forward 'sp--looking-back 'sp--looking-at) allowed-strings)) - (let ((op (match-string 0))) - (setq prefix (,prefix-fn (point) op)) - (> (length prefix) 0))))) - (if (and (not in-comment) - (sp-point-in-comment)) - (progn - (goto-char (,comment-bound (sp-get-comment-bounds))) - (unless ,eob-test (,forward-fn 1))) - (unless ,eob-test - (,forward-fn (max (length prefix) 1)))) - (setq prefix nil))))) - -(defun sp-skip-forward-to-symbol (&optional stop-at-string stop-after-string stop-inside-string) - "Skip whitespace and comments moving forward. - -If STOP-AT-STRING is non-nil, stop before entering a string (if -not already in a string). - -If STOP-AFTER-STRING is non-nil, stop after exiting a string. - -If STOP-INSIDE-STRING is non-nil, stop before exiting a string. - -Examples: - - foo| bar -> foo |bar - - foo| [bar baz] -> foo |[bar baz]" - (interactive "^") - (sp--skip-to-symbol-1 t)) - -(put 'sp-skip-forward-to-symbol 'CUA 'move) - -(defun sp-skip-backward-to-symbol (&optional stop-at-string stop-after-string stop-inside-string) - "Skip whitespace and comments moving backward. -If STOP-AT-STRING is non-nil, stop before entering a string (if -not already in a string). - -If STOP-AFTER-STRING is non-nil, stop after exiting a string. - -If STOP-INSIDE-STRING is non-nil, stop before exiting a string. - -Examples: - - foo |bar -> foo| bar - - [bar baz] |foo -> [bar baz]| foo" - (interactive "^") - (sp--skip-to-symbol-1 nil)) - -(put 'sp-skip-backward-to-symbol 'CUA 'move) - -(defun sp-skip-into-string (&optional back) - "Move the point into the next string. - -With BACK non-nil, move backwards." - (if back - (while (and (not (sp-point-in-string)) (> (point) (point-min))) - (backward-char)) - (while (and (not (sp-point-in-string)) (< (point) (point-max))) - (forward-char)))) - -;; TODO: in ruby, "foo |if bar" now moves correctly, but there's a -;; noticable lag before it jumps over "if". This is probably caused -;; by :skip-match handlers. Investigate! -(defun sp-forward-symbol (&optional arg) - "Move point to the next position that is the end of a symbol. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction. - -A symbol is any sequence of characters that are in either the -word constituent or symbol constituent syntax class. Current -symbol only extend to the possible opening or closing delimiter -as defined by `sp-add-pair' even if part of this delimiter -would match \"symbol\" syntax classes. - -Examples: - - |foo bar baz -> foo| bar baz - - |foo (bar (baz)) -> foo (bar| (baz)) ;; 2 - - |foo (bar (baz) quux) -> foo (bar (baz) quux|) ;; 4" - (interactive "^p") - (setq arg (or arg 1)) - (sp--with-case-sensitive - (let* ((n (abs arg)) - (fw (> arg 0)) - (allowed (sp--get-allowed-pair-list)) - (open (sp--get-opening-regexp allowed)) - (close (sp--get-closing-regexp allowed))) - (if fw - (while (> n 0) - ;; First we need to get to the beginning of a symbol. This means - ;; skipping all whitespace and pair delimiters until we hit - ;; something in \sw or \s_ - (while (cond - ((eobp) nil) - ((not (memq (char-syntax (following-char)) '(?w ?_))) - (forward-char) - t) - ;; if allowed is empty, the regexp matches anything - ;; and we go into infinite loop, cf. Issue #400 - ((and allowed (sp--valid-initial-delimiter-p (sp--looking-at open))) - (goto-char (match-end 0))) - ((and allowed (sp--valid-initial-delimiter-p (sp--looking-at close))) - (goto-char (match-end 0))))) - (while (and (not (eobp)) - (or (not allowed) - (not (or (sp--valid-initial-delimiter-p (sp--looking-at open)) - (sp--valid-initial-delimiter-p (sp--looking-at close))))) - (or (memq (char-syntax (following-char)) '(?w ?_)) - ;; Specifically for lisp, we consider - ;; sequences of ?\ a symbol - ;; sequence - (and (eq (char-before) ??) - (eq (char-syntax (following-char)) ?\\)) - (and (eq (char-syntax (char-before)) ?\\)))) - (forward-char)) - (setq n (1- n))) - (sp-backward-symbol n))))) - -(put 'sp-forward-symbol 'CUA 'move) - -(defun sp-backward-symbol (&optional arg) - "Move point to the next position that is the beginning of a symbol. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -forward direction. - -A symbol is any sequence of characters that are in either the word -constituent or symbol constituent syntax class. Current symbol only -extend to the possible opening or closing delimiter as defined by -`sp-add-pair' even if part of this delimiter would match \"symbol\" -syntax classes. - -Examples: - - foo bar| baz -> foo |bar baz - - ((foo bar) baz)| -> ((foo |bar) baz) ;; 2 - - (quux ((foo) bar) baz)| -> (|quux ((foo) bar) baz) ;; 4" - (interactive "^p") - (setq arg (or arg 1)) - (sp--with-case-sensitive - (let ((n (abs arg)) - (fw (> arg 0)) - (open (sp--get-opening-regexp (sp--get-allowed-pair-list))) - (close (sp--get-closing-regexp (sp--get-allowed-pair-list)))) - (if fw - (while (> n 0) - (while (cond - ((bobp) nil) - ((not (memq (char-syntax (preceding-char)) '(?w ?_))) - (backward-char) - t) - ((sp--valid-initial-delimiter-p (sp--looking-back open)) - (goto-char (match-beginning 0))) - ((sp--valid-initial-delimiter-p (sp--looking-back close)) - (goto-char (match-beginning 0))))) - (while (and (not (bobp)) - (not (or (sp--valid-initial-delimiter-p (sp--looking-back open)) - (sp--valid-initial-delimiter-p (sp--looking-back close)))) - (or (memq (char-syntax (preceding-char)) '(?w ?_)) - ;; Specifically for lisp, we consider - ;; sequences of ?\ a symbol - ;; sequence - (and (eq (char-before (1- (point))) ??) - (eq (char-syntax (preceding-char)) ?\\)) - )) - (backward-char)) - ;; skip characters which are symbols with prefix flag - (while (and (not (eobp)) - (/= 0 (logand (lsh 1 20) (car (syntax-after (point)))))) - (forward-char 1)) - (setq n (1- n))) - (sp-forward-symbol n))))) - -(put 'sp-backward-symbol 'CUA 'move) - -(defun sp-rewrap-sexp (pair &optional keep-old) - "Rewrap the enclosing expression with a different pair. - -PAIR is the new enclosing pair. - -If optional argument KEEP-OLD is set, keep old delimiter and wrap -with PAIR on the outside of the current expression. - -When used interactively, the new pair is specified in minibuffer -by typing the *opening* delimiter, same way as with pair -wrapping. - -When used interactively with raw prefix argument \\[universal-argument], KEEP-OLD -is set to non-nil. - -Examples: - - (foo |bar baz) -> [foo |bar baz] ;; [ - - (foo |bar baz) -> [(foo |bar baz)] ;; \\[universal-argument] [" - (interactive (list - (catch 'done - (let ((available-pairs (sp--get-pair-list-context 'wrap)) - ev ac (pair-prefix "")) - (while (not ac) - (setq ev (read-event (format "Rewrap with: %s" pair-prefix) t)) - (if (and (equal pair-prefix "") - (eq ev 'return)) - (throw 'done nil)) - (setq pair-prefix (concat pair-prefix (format-kbd-macro (vector ev)))) - (unless (--any? (string-prefix-p pair-prefix (car it)) available-pairs) - (user-error "Impossible pair prefix selected: %s" pair-prefix)) - (setq ac (--first (equal pair-prefix (car it)) available-pairs))) - ac)) - current-prefix-arg)) - (if (not pair) - (sp-unwrap-sexp) - (-when-let (enc (sp-get-enclosing-sexp)) - (save-excursion - (sp-get enc - (goto-char :end) - (unless keep-old - (delete-char (- :cl-l))) - (insert (cdr pair)) - (goto-char :beg) - (insert (car pair)) - (unless keep-old - (delete-char :op-l)) - (setq sp-last-wrapped-region - (sp--get-last-wraped-region - :beg (+ :end - (length (car pair)) - (length (cdr pair)) - (- :op-l) - (- :cl-l)) - (car pair) (cdr pair))))) - (sp--run-hook-with-args (car pair) :post-handlers 'rewrap-sexp - (list :parent (sp-get enc :op)))))) - -(defun sp-swap-enclosing-sexp (&optional arg) - "Swap the enclosing delimiters of this and the parent expression. - -With N > 0 numeric argument, ascend that many levels before -swapping. - -Examples: - - (foo [|bar] baz) -> [foo (|bar) baz] ;; 1 - - (foo {bar [|baz] quux} quack) -> [foo {bar (|baz) quux} quack] ;; 2" - (interactive "p") - (let ((enc (sp-get-enclosing-sexp)) - (encp (sp-get-enclosing-sexp (1+ arg)))) - (if (and enc encp) - (save-excursion - (sp-get encp - (goto-char :end) - (delete-char (- :cl-l))) - (sp-get enc - (insert :cl) - (goto-char :end) - (delete-char (- :cl-l))) - (sp-get encp (insert :cl)) - (sp-get enc (goto-char :beg-prf)) - (sp-get encp (insert :prefix :op)) - (sp-get enc (delete-char (+ :op-l :prefix-l))) - (sp-get encp (goto-char :beg-prf)) - (sp-get enc (insert :prefix :op)) - (sp-get encp (delete-char (+ :op-l :prefix-l)))) - (sp-message :point-not-deep-enough)))) - -(defun sp--unwrap-sexp (sexp &optional no-cleanup) - "Unwrap expression defined by SEXP. - -Warning: this function remove possible empty lines and reindents -the unwrapped sexp, so the SEXP structure will no longer -represent a valid object in a buffer!" - (sp-get sexp - (delete-region :end-in :end) - (delete-region :beg-prf :beg-in)) - ;; if the delimiters were the only thing on the line, we should also - ;; get rid of the (possible) empty line that will be the result of - ;; their removal. This is especially nice in HTML mode or - ;; long-running tags like \[\] in latex. - (unless no-cleanup - (let ((new-start (sp-get sexp :beg-prf)) - (new-end (sp-get sexp (- :end-in :op-l :prefix-l))) - indent-from indent-to) - (save-excursion - (goto-char new-end) - (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) - (let ((b (bounds-of-thing-at-point 'line))) - (delete-region (car b) (cdr b)))) - (setq indent-to (point)) - (goto-char new-start) - (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) - (let ((b (bounds-of-thing-at-point 'line))) - (delete-region (car b) (cdr b)))) - (setq indent-from (point))) - (unless (or (memq major-mode sp-no-reindent-after-kill-modes) - (memq indent-line-function - sp-no-reindent-after-kill-indent-line-functions)) - (sp--keep-indentation - (sp--indent-region indent-from indent-to)))))) - -(defun sp-change-inner () - "Change the inside of the next expression. - -First, kill the inside of the next balanced expression, then move -point just after the opening delimiter. - -Examples: - - (f|oo [bar] baz) -> (foo [|] baz) - - {|'foo': 'bar'} -> {'|': 'bar'}" - (interactive) - (-when-let (ok (sp-get-sexp)) - (sp-get ok - (kill-region :beg-in :end-in) - (goto-char :beg-in)))) - -(defun sp-change-enclosing () - "Change the inside of the enclosing expression. - -Whitespace on both sides of the inner items is preserved if it -contains newlines. Invoking this function on a blank sexp will -wipe out remaining whitespace (see `sp-point-in-blank-sexp'). - -Move the point to the beginning of the original content. - -Examples: - - (f|oo [bar] baz) -> (|) - - {'f|oo': 'bar'} -> {'|': 'bar'}" - (interactive) - (-when-let (ok (sp-get-enclosing-sexp)) - (sp-get ok - (if (sp-point-in-blank-sexp) - (progn - (kill-region :beg-in :end-in) - (goto-char :beg-in)) - (let ((beg (progn - (goto-char :beg-in) - (skip-chars-forward "\t\n ") - (point))) - (end (progn - (goto-char :end-in) - (skip-chars-backward "\t\n ") - (point)))) - (kill-region beg end) - (goto-char beg)))))) - -(defun sp-unwrap-sexp (&optional arg) - "Unwrap the following expression. - -With ARG N, unwrap Nth expression as returned by -`sp-forward-sexp'. If ARG is negative -N, unwrap Nth expression -backwards as returned by `sp-backward-sexp'. - -Return the information about the just unwrapped expression. Note -that this structure does not represent a valid expression in the -buffer. - -Examples: - - |(foo bar baz) -> |foo bar baz - - (foo bar| baz) -> foo bar| baz - - |(foo) (bar) (baz) -> |(foo) bar (baz) ;; 2" - (interactive "p") - (setq arg (or arg 1)) - (let ((sp-navigate-consider-symbols nil)) - (let ((ok (save-excursion (sp-forward-sexp arg)))) - (when ok (sp--unwrap-sexp ok)) - ok))) - -(defun sp-backward-unwrap-sexp (&optional arg) - "Unwrap the previous expression. - -With ARG N, unwrap Nth expression as returned by -`sp-backward-sexp'. If ARG is negative -N, unwrap Nth expression -forward as returned by `sp-forward-sexp'. - -Examples: - - (foo bar baz)| -> foo bar baz| - - (foo bar)| (baz) -> foo bar| (baz) - - (foo) (bar) (baz)| -> foo (bar) (baz) ;; 3" - (interactive "p") - (sp-unwrap-sexp (- (or arg 1)))) - -(defun sp-splice-sexp (&optional arg) - "Unwrap the current list. - -With ARG N, unwrap Nth list as returned by applying `sp-up-sexp' -N times. This function expect positive arg. - -Examples: - - (foo (bar| baz) quux) -> (foo bar| baz quux) - - (foo |(bar baz) quux) -> foo |(bar baz) quux - - (foo (bar| baz) quux) -> foo (bar| baz) quux ;; 2" - (interactive "p") - (setq arg (or arg 1)) - (-when-let (ok (sp-get-enclosing-sexp arg)) - (if (equal ";" (sp-get ok :prefix)) - (sp-get ok - (save-excursion - (goto-char :beg) - (-when-let (enc (sp-get-enclosing-sexp arg)) - (sp--unwrap-sexp enc)))) - (sp--unwrap-sexp ok)))) - -(defun sp--splice-sexp-do-killing (beg end expr &optional jump-end) - "Save the text in the region between BEG and END inside EXPR, -then delete EXPR and insert the saved text. - -If optional argument JUPM-END is equal to the symbol 'end move -the point after the re-inserted text." - (let (str p) - (setq str (buffer-substring-no-properties beg end)) - (delete-region (sp-get expr :beg-prf) (sp-get expr :end)) - (save-excursion - (insert str) - (sp--indent-region (sp-get expr :beg-prf) (point)) - (setq p (point))) - (when (eq jump-end 'end) (goto-char p)))) - -(defun sp-splice-sexp-killing-backward (&optional arg) - "Unwrap the current list and kill all the expressions -between start of this list and the point. - -With the optional argument ARG, repeat that many times. This -argument should be positive number. - -Examples: - - (foo (let ((x 5)) |(sqrt n)) bar) -> (foo |(sqrt n) bar) - -​ (when ok| |(perform-operation-1) -​ (perform-operation-1) -> (perform-operation-2) -​ (perform-operation-2)) - -​ (save-excursion -> |(awesome-stuff-happens) ;; 2 -​ (unless (test) -​ |(awesome-stuff-happens))) - -Note that to kill only the content and not the enclosing -delimiters you can use \\[universal-argument] \\[sp-backward-kill-sexp]. -See `sp-backward-kill-sexp' for more information." - (interactive "p") - (while (> arg 0) - (sp-splice-sexp-killing-around '(4)) - (setq arg (1- arg)))) - -;; TODO: write in terms of `sp-splice-sexp-killing-around'. -(defun sp-splice-sexp-killing-forward (&optional arg) - "Unwrap the current list and kill all the expressions between -the point and the end of this list. - -With the optional argument ARG, repeat that many times. This -argument should be positive number. - -Examples: - - (a (b c| d e) f) -> (a b c| f) - - (+ (x |y z) w) -> (+ x| w) - -Note that to kill only the content and not the enclosing -delimiters you can use \\[universal-argument] \\[sp-kill-sexp]. -See `sp-kill-sexp' for more information." - (interactive "p") - (while (> arg 0) - (let ((ok (sp-get-enclosing-sexp 1))) - (if ok - (let ((next (sp-get-thing t))) - (if (sp-compare-sexps next ok) - (sp-kill-sexp '(16)) - (sp--splice-sexp-do-killing - (sp-get next :end) ;search backward - (sp-get ok :beg-in) - ok 'end))) - (setq arg -1))) - (setq arg (1- arg)))) - -(defun sp-splice-sexp-killing-around (&optional arg) - "Unwrap the current list and kill everything inside except next expression. - -With ARG save that many next expressions. With ARG negative -N, -save that many expressions backward. - -If ARG is raw prefix argument \\[universal-argument] this function behaves exactly -the same as `sp-splice-sexp-killing-backward'. - -If ARG is negative raw prefix argument \\[negative-argument] \\[universal-argument] this function -behaves exactly the same as `sp-splice-sexp-killing-forward'. - -Note that the behaviour with the prefix argument seems to be -reversed. This is because the backward variant is much more -common and hence deserve shorter binding. - -If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] raise the expression the point -is inside of. This is the same as `sp-backward-up-sexp' followed by -`sp-splice-sexp-killing-around'. - -Examples: - - (a b |(c d) e f) -> |(c d) ;; with arg = 1 - - (a b |c d e f) -> |c d ;; with arg = 2 - - (- (car x) |a 3) -> (car x)| ;; with arg = -1 - - (foo (bar |baz) quux) -> |(bar baz) ;; with arg = \\[universal-argument] \\[universal-argument]" - (interactive "P") - (cond - ((equal arg '(-4)) - (sp-splice-sexp-killing-forward 1)) - (t - (if (equal arg '(16)) - (progn - (sp-backward-up-sexp) - (setq arg 1))) - (let* (inside-comment-inside-sexp - (num-arg (prefix-numeric-value arg)) - (ok ;; (sp-get-enclosing-sexp 1) - (save-excursion - (sp-skip-backward-to-symbol) - ;; if the point is inside a comment, we want to - ;; operate on the sexp that contains it. however, - ;; if we are inside a sexp inside a comment, we - ;; should operate on that instead. - (if (sp-point-in-comment) - (let ((enc (sp-get-enclosing-sexp 1)) - (cb (sp-get-comment-bounds))) - (if (> (sp-get enc :beg) (car cb)) - (progn - (setq inside-comment-inside-sexp t) - enc) - (goto-char (cdr cb)) - ;; todo: replace with something more - ;; abstract - (skip-chars-forward "\t\n ") - (sp-get-enclosing-sexp 1))) - (sp-get-enclosing-sexp 1))))) - (when ok - (when (and (sp-point-in-comment) - (not inside-comment-inside-sexp)) - (let ((cb (sp-get-comment-bounds))) - (goto-char (if (> num-arg 0) (car cb) (cdr cb))))) - (sp-skip-backward-to-symbol) - (-let* ((next (sp--next-thing-selection arg)) - ((from . to) - (cond - ((and (sp-point-in-comment) - (not inside-comment-inside-sexp)) - (if (> num-arg 0) - ;; only extends to keep the comment if raising - ;; towards the end. - (cons (car (sp-get-comment-bounds)) - (sp-get next :end-suf)) - (sp-get next (cons :beg-prf :end-suf)))) - ((and (sp-point-in-comment) - inside-comment-inside-sexp) - (sp-get next (cons :beg-prf :end-suf))) - ;; If we are splicing before a comment, the - ;; comment might be connected to the sexp - ;; after it, so we better don't kill it. Only - ;; do that if the comment is on its own line - ;; though, otherwise it is connected to the - ;; sexp before it. - ((save-excursion - (skip-chars-forward "\t\n ") - (when (and (> num-arg 0) - (sp-point-in-comment) - (save-excursion - (skip-chars-backward "\t ") - (bolp))) - (cons (point) (sp-get next :end-suf))))) - ;; similarly, if there is a comment before - ;; this sexp, keep it. - ((save-excursion - (sp-backward-symbol) - (when (and (> num-arg 0) - (sp-point-in-comment) - (goto-char (car (sp-get-comment-bounds))) - (> (point) (sp-get ok :beg)) - (save-excursion - (skip-chars-backward "\t ") - (bolp))) - (cons (point) (sp-get next :end-suf))))) - (t (sp-get next (cons :beg-prf :end-suf)))))) - (sp--splice-sexp-do-killing from to - ok (if (> num-arg 0) nil 'end)))))))) - -(defalias 'sp-raise-sexp 'sp-splice-sexp-killing-around) - -(defun sp-convolute-sexp (&optional arg) - "Convolute balanced expressions. - -Save the expressions preceding point and delete them. Then -splice the resulting expression. Wrap the current enclosing list -with the delimiters of the spliced list and insert the saved -expressions. - -If point is in a symbol, move to end of symbol before convolving. - -With ARG positive N, move up N lists before wrapping. - -Examples: - -We want to move the `while' before the `let'. - -​ (let ((stuff 1) (while (we-are-good) -​ (other 2)) (let ((stuff 1) -​ (while (we-are-good) -> (other 2)) -​ |(do-thing 1) |(do-thing 1) -​ (do-thing 2) (do-thing 2) -​ (do-thing 3))) (do-thing 3))) - - (forward-char (sp-get env |:op-l)) -> (sp-get env (forward-char |:op-l))" - (interactive "p") - (save-excursion - (when (sp-point-in-symbol) - (sp-forward-symbol)) - (when (looking-at-p " ") - (just-one-space)) - (let* ((old-buffer-size (buffer-size)) - (enc (sp-get-enclosing-sexp)) - (inner-close (sp-get enc (delete-and-extract-region - (save-excursion - (goto-char :end-in) - (sp-backward-whitespace)) - :end))) - (inner-raise (sp-get enc (delete-and-extract-region - :beg-prf - (save-excursion - (sp-forward-whitespace))))) - (whitespace (sp-get enc - ;; this happens when the entire inside sexp was removed. - (when (= old-buffer-size (+ (buffer-size) :len)) - (delete-and-extract-region - (save-excursion - (goto-char :beg-prf) - (max (line-beginning-position) (sp-backward-whitespace))) - :beg-prf)))) - (encp (sp-get-enclosing-sexp arg))) - (sp-get encp - (goto-char :end) - (insert inner-close) - (goto-char :beg-prf) - (insert inner-raise (if whitespace whitespace "")) - (sp-get (sp-get-enclosing-sexp) - (sp--indent-region :beg :end))))) - (indent-according-to-mode)) - -(defun sp-absorb-sexp (&optional arg) - "Absorb previous expression. - -Save the expressions preceding point and delete them. Then slurp -an expression backward and insert the saved expressions. - -With ARG positive N, absorb that many expressions. - -Examples: - -​ (do-stuff 1) (save-excursion -​ (save-excursion -> |(do-stuff 1) -​ |(do-stuff 2)) (do-stuff 2)) - - foo bar (concat |baz quux) -> (concat |foo bar baz quux) ;; 2" - (interactive "p") - (sp-forward-whitespace) - (let* ((old (point)) - (raise (progn - (sp-beginning-of-sexp) - (buffer-substring (point) old)))) - (delete-region (point) old) - (sp-backward-slurp-sexp arg) - (sp-forward-whitespace) - (sp-beginning-of-sexp) - (insert raise) - (save-excursion - (sp-backward-up-sexp) - (indent-sexp))) - (sp-forward-whitespace)) - -(defun sp-emit-sexp (&optional arg) - "Move all expression preceding point except the first one out of the current list. - -With ARG positive N, keep that many expressions from the start of -the current list. - -This is similar as `sp-backward-barf-sexp' but it also drags the -first N expressions with the delimiter. - -Examples: - -​ (save-excursion ​(do-stuff 1) -​ (do-stuff 1) (do-stuff 2) -​ (do-stuff 2) -> (save-excursion -​ |(do-stuff 3)) |(do-stuff 3)) - -​ (while not-done-yet (execute-only-once) -​ (execute-only-once) -> (while not-done-yet ;; arg = 2 -​ |(execute-in-loop)) |(execute-in-loop))" - (interactive "p") - (let (save-text) - (save-excursion - (sp-beginning-of-sexp) - (let* ((start (point))) - (sp-forward-sexp arg) - (sp-skip-forward-to-symbol t) - (setq save-text (buffer-substring start (point))) - (delete-region start (point)))) - (save-excursion (sp-backward-barf-sexp '(4))) - (sp-down-sexp) - (insert save-text) - (save-excursion - (sp-backward-up-sexp) - (indent-sexp)))) - -(defun sp-extract-before-sexp (&optional arg) - "Move the expression after point before the enclosing balanced expression. - -The point moves with the extracted expression. - -With ARG positive N, extract N expressions after point. - -With ARG negative -N, extract N expressions before point. - -With ARG being raw prefix argument \\[universal-argument], extract all the expressions -up until the end of enclosing list. - -If the raw prefix is negative, this behaves as \\[universal-argument] `sp-backward-barf-sexp'." - (interactive "P") - (if (equal arg '(-4)) - (sp-backward-barf-sexp '(4)) - (sp-select-next-thing arg) - (let ((enc (sp-get-enclosing-sexp)) - save-text b e nl) - (save-excursion - ;; TODO: extract this use pattern into general "get X things - ;; with or without surrounding whitespace." - (setq b (region-beginning)) - (setq e (region-end)) - (goto-char (sp-get enc :end-in)) - (if (save-excursion - (skip-chars-backward "\t ") - (bolp)) - (let ((whitespace (sp-get-whitespace))) - (sp-get whitespace (when (= :beg e) - (delete-region :beg :end)))) - (setq nl t)) - (setq save-text (delete-and-extract-region b e)) - (when nl - (let ((whitespace (sp-get-whitespace))) - (sp-get whitespace (delete-region :beg :end)))) - (goto-char (sp-get enc :beg-prf)) - (insert save-text "\n") - (sp-get enc (sp--indent-region :beg-prf :end))) - ;; if we're at an empty line, remove it - (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) - (let ((b (bounds-of-thing-at-point 'line))) - (delete-region (car b) (cdr b)))) - (goto-char (sp-get enc :beg-prf))))) - -(defun sp-extract-after-sexp (&optional arg) - "Move the expression after point after the enclosing balanced expression. - -The point moves with the extracted expression. - -With ARG positive N, extract N expressions after point. - -With ARG negative -N, extract N expressions before point. - -With ARG being raw prefix argument \\[universal-argument], extract all the -expressions up until the end of enclosing list. - -With ARG being negative raw prefix argument \\[negative-argument] \\[universal-argument], extract all the -expressions up until the start of enclosing list." - ;; this is uch uglier than the "before" version, since the - ;; calculations forward have to account for the deleted text. Figure - ;; out a way to make it smoother. - (interactive "P") - (sp-select-next-thing arg) - (sp--with-case-sensitive - (let ((enc (sp-get-enclosing-sexp)) - (dws 0) ;length of deleted whitespace - save-text b e nl) - (save-excursion - (setq b (region-beginning)) - (setq e (region-end)) - (goto-char (sp-get enc :end-in)) - (if (save-excursion - (skip-chars-backward "\t ") - (bolp)) - (let ((whitespace (sp-get-whitespace))) - (sp-get whitespace - (when (= :beg e) - (delete-region :beg :end) - (setq dws (- :end :beg))))) - (setq nl t)) - (setq save-text (delete-and-extract-region b e)) - (when nl - (let ((whitespace (sp-get-whitespace))) - (sp-get whitespace (delete-region :beg :end)) - (sp-get whitespace (setq dws (+ dws (- :end :beg)))))) - (sp-get enc (goto-char (- :end (length save-text) dws))) - (insert "\n" save-text) - (sp-get enc (sp--indent-region :beg-prf :end)) - (setq e (point))) - ;; if we're at an empty line, remove it - (setq dws 0) ; variable reuse, ugly :/ - (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) - (let ((b (bounds-of-thing-at-point 'line))) - (delete-region (car b) (cdr b)) - (setq dws (- (cdr b) (car b))))) - (when (sp--looking-back (sp--get-opening-regexp) nil t) - (let ((whitespace (sp-get-whitespace))) - (sp-get whitespace - (delete-region :beg :end) - (setq dws (- :end :beg))))) - (goto-char (- e dws))))) - -(defun sp-forward-whitespace (&optional arg) - "Skip forward past the whitespace characters. -With non-nil ARG return number of characters skipped." - (interactive "^P") - (let ((rel-move (skip-chars-forward " \t\n"))) - (if arg rel-move (point)))) - -(put 'sp-forward-whitespace 'CUA 'move) - -(defun sp-backward-whitespace (&optional arg) - "Skip backward past the whitespace characters. -With non-nil ARG return number of characters skipped." - (interactive "^P") - (let ((rel-move (skip-chars-backward " \t\n"))) - (if arg rel-move (point)))) - -(put 'sp-backward-whitespace 'CUA 'move) - -(defun sp-split-sexp (arg) - "Split the list or string the point is on into two. - -If ARG is a raw prefix \\[universal-argument] split all the sexps in current expression -in separate lists enclosed with delimiters of the current -expression. - -See also setting `sp-split-sexp-always-split-as-string' which -determines how sexps inside strings are treated and also for a -discussion of how to automatically add concatenation operators to -string splitting. - -Examples: - - (foo bar |baz quux) -> (foo bar) |(baz quux) - - \"foo bar |baz quux\" -> \"foo bar\" |\"baz quux\" - - ([foo |bar baz] quux) -> ([foo] |[bar baz] quux) - - (foo bar| baz quux) -> (foo) (bar|) (baz) (quux) ;; \\[universal-argument]" - (interactive "P") - (cond - ((equal arg '(4)) - (-when-let ((first-item . rest-items) (sp-get-list-items)) - (sp-get first-item - (save-excursion - (goto-char :end) - (delete-char (- (length :cl))) - (--each (nreverse rest-items) - (goto-char (sp-get it :end)) - (insert :cl) - (goto-char (sp-get it :beg)) - (insert :op)) - (goto-char :beg) - (delete-char (length :op)))))) - (t - (let ((should-split-as-string - (and sp-split-sexp-always-split-as-string - (sp-point-in-string)))) - (-when-let (ok (if should-split-as-string - (save-excursion - (goto-char (car (sp-get-quoted-string-bounds))) - (sp-get-sexp)) - (sp-get-enclosing-sexp 1))) - (sp-get ok - (sp--run-hook-with-args :op :pre-handlers 'split-sexp) - (if should-split-as-string - (progn - (insert :cl) - (save-excursion (insert :op))) - (forward-char (- (prog1 (sp-backward-whitespace t) (insert :cl)))) - (save-excursion (sp-forward-whitespace) (insert :op))) - (sp--run-hook-with-args :op :post-handlers 'split-sexp))))))) - -(defun sp--join-sexp (prev next) - "Join the expressions PREV and NEXT if they are of the same type. - -The expression with smaller :beg is considered the previous one, -so the input order does not actually matter. - -Return the information about resulting expression." - (if (and (sp-compare-sexps prev next equal :op) - (sp-compare-sexps prev next equal :cl)) - ;; if there's some prefix on the second expression, remove it. - ;; We do not move it to the first expression, it is assumed - ;; there's one already - (progn - (if (sp-compare-sexps prev next >) - (let ((tmp prev)) - (setq prev next) - (setq next tmp))) - (sp-get next (delete-region :beg-prf :beg-in)) - (sp-get prev (delete-region :end-in :end)) - (list :beg (sp-get prev :beg) - :end (- (sp-get next (- :end :op-l :prefix-l)) (sp-get prev :cl-l)) - :op (sp-get prev :op) - :cl (sp-get prev :cl) - :prefix (sp-get prev :prefix))) - (sp-message :different-type))) - -(defun sp-join-sexp (&optional arg) - "Join the sexp before and after point if they are of the same type. - -If ARG is positive N, join N expressions after the point with the -one before the point. - -If ARG is negative -N, join N expressions before the point with -the one after the point. - -If ARG is a raw prefix \\[universal-argument] join all the things up until the end -of current expression. - -The joining stops at the first expression of different type. - -Examples: - - (foo bar) |(baz) -> (foo bar |baz) - - (foo) |(bar) (baz) -> (foo |bar baz) ;; 2 - - [foo] [bar] |[baz] -> [foo bar |baz] ;; -2 - - (foo bar (baz)| (quux) (blob bluq)) -> (foo bar (baz| quux blob bluq)) ;; \\[universal-argument]" - (interactive "P") - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (n (abs arg)) - (prev (save-excursion (sp-backward-sexp (sp--signum arg)))) - next) - (save-excursion - (cond - ((and raw (= n 4)) - (setq next (sp-forward-sexp (sp--signum arg))) - (while (cond - ((> arg 0) - (sp-compare-sexps next prev > :beg :end)) - ((< arg 0) - (sp-compare-sexps next prev < :end :beg))) - (setq prev (sp--join-sexp prev next)) - (setq next (sp-forward-sexp (sp--signum arg))))) - (t (while (> n 0) - (setq next (sp-forward-sexp (sp--signum arg))) - (setq prev (sp--join-sexp prev next)) - (setq n (1- n))))) - prev))) - -(defun sp--next-thing-selection (&optional arg point) - "Return the bounds of selection over next thing. - -See `sp-select-next-thing' for the meaning of ARG. - -If POINT is non-nil, it is assumed it's a point inside the buffer -from which the selection extends, either forward or backward, -depending on the value of ARG. - -The return value has the same format as `sp-get-sexp'. This does -not necessarily represent a valid balanced expression!" - (save-excursion - (let* ((raw (sp--raw-argument-p arg)) - (arg (prefix-numeric-value arg)) - (beg point) (end point) - (op "") (cl "") - (prefix "") - (suffix "")) - (cond - ;; select up until end of list - ((and raw (= arg 4)) - (let ((enc (sp-get-enclosing-sexp))) - (if (not enc) - (error "No enclosing expression") - (save-excursion - (goto-char (sp-get enc :end-in)) - (-when-let (ok (sp-get-thing t)) - (sp-get ok - (setq end :end) - (setq cl :cl) - (setq suffix :suffix))))) - (unless point - (-when-let (ok (sp-get-thing)) - (if (sp-compare-sexps ok enc) - (progn - (setq beg end) - (setq end (sp-get enc :end-in))) - (sp-get ok - (setq beg :beg) - (setq op :op) - (setq prefix :prefix))))))) - ;; select up until beg of list - ((and raw (= arg -4)) - (let ((enc (sp-get-enclosing-sexp))) - (if (not enc) - (error "No enclosing expression") - (save-excursion - (goto-char (sp-get enc :beg-in)) - (-when-let (ok (sp-get-thing)) - (sp-get ok - (setq beg :beg) - (setq op :op) - (setq prefix :prefix)))))) - (unless point - (-when-let (ok (sp-get-thing t)) - (sp-get ok - (setq end :end) - (setq cl :cl) - (setq suffix :suffix))))) - ;; select the enclosing expression - ((and raw (= (abs arg) 16)) - (let ((enc (sp-get-enclosing-sexp))) - (if (not enc) - (error "No enclosing expression") - (sp-get enc (setq beg :beg) (setq end :end) - (setq op :op) (setq cl :cl) - (setq prefix :prefix) - (setq suffix :suffix))))) - ;; normal selection, select N expressions - ((> arg 0) - (let* ((first (sp-forward-sexp)) - (last first)) - (setq arg (1- arg)) - (setq beg (or point (sp-get first :beg))) - (while (and (> arg 0) last) - (setq last (sp-forward-sexp)) - (let ((nb (sp-get last :beg))) (when (< nb beg) - (setq first last) - (setq beg nb))) - (setq arg (1- arg))) - (unless (and point (= point beg)) - (sp-get first - (setq beg :beg) - (setq op :op) - (setq prefix :prefix))) - (sp-get last - (setq end :end) - (setq cl :cl) - (setq suffix :suffix)))) - ;; normal select, select -N expressions - ((< arg 0) - (let* ((first (sp-backward-sexp)) - (last first)) - (setq arg (1+ arg)) - (setq end (or point (sp-get first :end))) - (while (and (< arg 0) last) - (setq last (sp-backward-sexp)) - (let ((ne (sp-get last :end))) (when (> ne end) - (setq first last) - (setq end ne))) - (setq arg (1+ arg))) - (sp-get last - (setq beg :beg) - (setq op :op) - (setq prefix :prefix)) - (unless (and point (= point end)) - (sp-get first - (setq end :end) - (setq cl :cl) - (setq suffix :suffix))))) - ;; N = 0, select insides - ((= arg 0) - (let ((enc (sp-get-enclosing-sexp))) - (if (not enc) - (error "No enclosing expression") - (save-excursion - (goto-char (sp-get enc :beg-in)) - (-when-let (ok (sp-get-thing)) - (sp-get ok - (setq beg :beg) - (setq op :op) - (setq prefix :prefix)))) - (save-excursion - (goto-char (sp-get enc :end-in)) - (-when-let (ok (sp-get-thing t)) - (sp-get ok - (setq end :end) - (setq cl :cl) - (setq suffix :suffix)))))))) - (list :beg beg :end end :op op :cl cl :prefix prefix :suffix suffix)))) - -(defun sp-select-next-thing (&optional arg point) - "Set active region over next thing as recognized by `sp-get-thing'. - -If ARG is positive N, select N expressions forward. - -If ARG is negative -N, select N expressions backward. - -If ARG is a raw prefix \\[universal-argument] select all the things up until the -end of current expression. - -If ARG is a raw prefix \\[universal-argument] \\[universal-argument] select the current expression (as -if doing `sp-backward-up-sexp' followed by -`sp-select-next-thing'). - -If ARG is number 0 (zero), select all the things inside the -current expression. - -If POINT is non-nil, it is assumed it's a point inside the buffer -from which the selection extends, either forward or backward, -depending on the value of ARG. - -If the currently active region contains a balanced expression, -following invocation of `sp-select-next-thing' will select the -inside of this expression . Therefore calling this function -twice with no active region will select the inside of the next -expression. - -If the point is right in front of the expression any potential -prefix is ignored. For example, '|(foo) would only select (foo) -and not include ' in the selection. If you wish to also select -the prefix, you have to move the point backwards. - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions." - (interactive "P") - (let* ((selection (sp--next-thing-selection arg point)) - (p (point)) - (b (sp-get selection :beg)) - (e (sp-get selection :end)) - contracted) - ;; Show a helpful error if we're trying to move beyond the - ;; beginning or end of the buffer. - (when (or (null b) (null e)) - (user-error (if (bobp) "At beginning of buffer" "At end of buffer"))) - ;; if region is active and ready to use, check if this selection - ;; == old selection. If so, reselect the insides - (when (region-active-p) - (let ((rb (region-beginning)) - (re (region-end))) - (when (and (sp-get selection - (or (= rb :beg) - (= rb :beg-prf))) - (= re (sp-get selection :end))) - (sp-get selection - (setq b :beg-in) - (setq e :end-in)) - (setq contracted t)))) - ;; if we moved forward check if the old-point was in front of an - ;; expression and after a prefix. If so, remove the prefix from - ;; the selection - (unless (and (> (prefix-numeric-value arg) 0) - (not (sp--raw-argument-p arg)) - (= b p)) - (unless contracted (setq b (sp-get selection :beg-prf)))) - (push-mark b t t) - (goto-char e) - selection)) - -(defun sp-select-previous-thing (&optional arg point) - "Set active region over ARG previous things as recognized by `sp-get-thing'. - -If ARG is negative -N, select that many expressions forward. - -With `sp-navigate-consider-symbols' symbols and strings are also -considered balanced expressions." - (interactive "P") - (sp-select-next-thing (sp--negate-argument arg) point)) - -(defun sp-select-next-thing-exchange (&optional arg point) - "Just like `sp-select-next-thing' but run `exchange-point-and-mark' afterwards." - (interactive "P") - (prog1 - (sp-select-next-thing arg point) - (exchange-point-and-mark))) - -(defun sp-select-previous-thing-exchange (&optional arg point) - "Just like `sp-select-previous-thing' but run `exchange-point-and-mark' afterwards." - (interactive "P") - (prog1 - (sp-select-previous-thing arg point) - (exchange-point-and-mark))) - -(defun sp-mark-sexp (&optional arg allow-extend) - "Set mark ARG balanced expressions from point. -The place mark goes is the same place \\[sp-forward-sexp] would -move to with the same argument. -Interactively, if this command is repeated -or (in Transient Mark mode) if the mark is active, -it marks the next ARG sexps after the ones already marked. -This command assumes point is not in a string or comment." - (interactive "P\np") - (cond ((and allow-extend - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (setq arg (if arg (prefix-numeric-value arg) - (if (< (mark) (point)) -1 1))) - (set-mark - (save-excursion - (let ((p (point))) - (goto-char (mark)) - (sp-forward-sexp arg) - (unless (sp-region-ok-p p (point)) - (user-error "Can not extend selection: region invalid")) - (point))))) - (t - (push-mark - (save-excursion - (sp-forward-sexp (prefix-numeric-value arg)) - (point)) - nil t)))) - -(defun sp-delete-char (&optional arg) - "Delete a character forward or move forward over a delimiter. - -If on an opening delimiter, move forward into balanced expression. - -If on a closing delimiter, refuse to delete unless the balanced -expression is empty, in which case delete the entire expression. - -If the delimiter does not form a balanced expression, it will be -deleted normally. - -With a numeric prefix argument N > 0, delete N characters forward. - -With a numeric prefix argument N < 0, delete N characters backward. - -With a numeric prefix argument N = 0, simply delete a character -forward, without regard for delimiter balancing. - -If ARG is raw prefix argument \\[universal-argument], delete -characters forward until a closing delimiter whose deletion would -break the proper pairing is hit. - -Examples: - - (quu|x \"zot\") -> (quu| \"zot\") - - (quux |\"zot\") -> (quux \"|zot\") -> (quux \"|ot\") - - (foo (|) bar) -> (foo | bar) - - |(foo bar) -> (|foo bar)" - (interactive "P") - (sp--with-case-sensitive - (let* ((raw (sp--raw-argument-p arg)) - ;; if you edit 10 gigabyte files in Emacs, you're gonna have - ;; a bad time. - (n (if raw 100000000 - (prefix-numeric-value arg)))) - (cond - ((> n 0) - (while (> n 0) - (cond - ((let ((ok (sp-point-in-empty-sexp))) - (when ok - (backward-char (length (car ok))) - (delete-char (+ (length (car ok)) (length (cdr ok))))) - ok) - ;; make this customizable - (setq n (1- n))) - ((and (sp-point-in-string) - (save-excursion (forward-char) (not (sp-point-in-string)))) - (setq n 0)) - ((sp--looking-at (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) - (-if-let (thing (save-match-data (sp-get-thing))) - (cond - ((= (sp-get thing :end-in) (point)) - (setq n 0)) - ((= (sp-get thing :beg) (point)) - (goto-char (sp-get thing :beg-in))) - (t - (delete-char (length (match-string 0))))) - (delete-char (length (match-string 0)))) - ;; make this customizable - (setq n (1- n))) - ((and (not (sp-point-in-string)) - (save-excursion (forward-char) (sp-point-in-string))) - (forward-char) - ;; make this customizable - (setq n (1- n))) - ((sp--looking-at (sp--get-closing-regexp (sp--get-pair-list-context 'navigate))) - (if (save-match-data (sp-get-thing)) - ;; make this customizable -- maybe we want to skip and - ;; continue deleting - (setq n 0) - (delete-char (length (match-string 0))) - (setq n (1- n)))) - ((bound-and-true-p hungry-delete-mode) - (hungry-delete-forward 1) - (setq n (1- n))) - (t - (delete-char 1) - (setq n (1- n)))))) - ((= n 0) (delete-char 1)) - (t (sp-backward-delete-char (sp--negate-argument arg))))))) - -(defun sp-backward-delete-char (&optional arg) - "Delete a character backward or move backward over a delimiter. - -If on a closing delimiter, move backward into balanced expression. - -If on a opening delimiter, refuse to delete unless the balanced -expression is empty, in which case delete the entire expression. - -If the delimiter does not form a balanced expression, it will be -deleted normally. - -With a numeric prefix argument N > 0, delete N characters backward. - -With a numeric prefix argument N < 0, delete N characters forward. - -With a numeric prefix argument N = 0, simply delete a character -backward, without regard for delimiter balancing. - -If ARG is raw prefix argument \\[universal-argument], delete -characters backward until a opening delimiter whose deletion would -break the proper pairing is hit. - -Examples: - - (\"zot\" q|uux) -> (\"zot\" |uux) - - (\"zot\"| quux) -> (\"zot|\" quux) -> (\"zo|\" quux) - - (foo (|) bar) -> (foo | bar) - - (foo bar)| -> (foo bar|)" - (interactive "P") - (if (and sp-autodelete-wrap - (eq sp-last-operation 'sp-wrap-region)) - (sp-backward-unwrap-sexp) - (sp--with-case-sensitive - (let* ((raw (sp--raw-argument-p arg)) - ;; if you edit 10 gigabyte files in Emacs, you're gonna have - ;; a bad time. - (n (if raw 100000000 - (prefix-numeric-value arg)))) - (cond - ((> n 0) - (while (> n 0) - (cond - ((let ((ok (sp-point-in-empty-sexp))) - (when ok - (backward-char (length (car ok))) - (delete-char (+ (length (car ok)) (length (cdr ok))))) - ok) - ;; make this customizable - (setq n (1- n))) - ((and (sp-point-in-string) - (save-excursion (backward-char) (not (sp-point-in-string)))) - (setq n 0)) - ((sp--looking-back (sp--get-closing-regexp (sp--get-pair-list-context 'navigate))) - (-if-let (thing (save-match-data (sp-get-thing t))) - (cond - ((= (sp-get thing :end) (point)) - (goto-char (sp-get thing :end-in))) - ((= (sp-get thing :beg-in) (point)) - (setq n 0)) - (t - (delete-char (- (length (match-string 0)))))) - (delete-char (- (length (match-string 0))))) - ;; make this customizable - (setq n (1- n))) - ((and (not (sp-point-in-string)) - (save-excursion (backward-char) (sp-point-in-string))) - (backward-char) - ;; make this customizable - (setq n (1- n))) - ((sp--looking-back (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) - (if (save-match-data (sp-get-thing t)) - ;; make this customizable -- maybe we want to skip and - ;; continue deleting - (setq n 0) - (delete-char (- (length (match-string 0)))) - (setq n (1- n)))) - ((bound-and-true-p hungry-delete-mode) - (hungry-delete-backward 1) - (setq n (1- n))) - (t - (delete-char -1) - (setq n (1- n)))))) - ((= n 0) (delete-char -1)) - (t (sp-delete-char (sp--negate-argument arg)))))))) - -(put 'sp-backward-delete-char 'delete-selection 'supersede) -(put 'sp-delete-char 'delete-selection 'supersede) - -(defun sp-point-in-empty-sexp (&optional pos) - "Return non-nil if point is in empty sexp or string. - -The return value is active cons pair of opening and closing sexp -delimiter enclosing this sexp." - (setq pos (or pos (point))) - (let (op act) - (cond - ((sp--looking-back (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) - (setq op (match-string 0)) - (setq act (--first (equal (car it) op) sp-pair-list)) - (when (sp--looking-at (regexp-quote (cdr act))) act)) - ((sp-point-in-empty-string pos))))) - -(defun sp-point-in-empty-string (&optional pos) - "Return non-nil if point is in empty string. - -The return value is actually cons pair of opening and closing -string delimiter enclosing this string." - (setq pos (or pos (point))) - (when (and (sp-point-in-string) - (save-excursion (if (= (point-max) (point)) - t - (forward-char) (not (sp-point-in-string)))) - (save-excursion (backward-char) (not (sp-point-in-string)))) - (save-excursion - (let* ((syntax (nth 3 (syntax-ppss pos))) - (c (char-to-string (if (eq syntax t) (following-char) syntax)))) - (cons c c))))) - -(defun sp--use-subword () - "Return non-nil if word killing commands should kill subwords. -This is the case if `subword-mode' is enabled and -`sp-use-subword' is non-nil." - (and sp-use-subword (bound-and-true-p subword-mode))) - -(defun sp--kill-word (&optional n) - "Kill N words or subwords." - (let ((n (or n 1))) - (if (sp--use-subword) - (subword-kill n) - (kill-word n)))) - -(defun sp--forward-word (&optional n) - "Move forward N words or subwords." - (let ((n (or n 1))) - (if (sp--use-subword) - (subword-forward n) - (forward-word n)))) - -(defun sp--backward-word (&optional n) - "Move backward N words or subwords." - (let ((n (or n 1))) - (if (sp--use-subword) - (subword-backward n) - (backward-word n)))) - -(defun sp-kill-symbol (&optional arg word) - "Kill a symbol forward, skipping over any intervening delimiters. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction. - -See `sp-forward-symbol' for what constitutes a symbol." - (interactive "p") - (sp--with-case-sensitive - (if (> arg 0) - (while (> arg 0) - (-when-let (s (sp-get-symbol)) - (sp-get s - (let* ((beg - (if (< :beg-prf (point)) - (if word (point) :beg) - (if (= (save-excursion - (sp-skip-forward-to-symbol) - (point)) - :beg-prf) - (point) - :beg-prf))) - (end (if word - (let ((fw-end - (save-excursion - (sp--forward-word) - (point)))) - (if (sp-region-ok-p beg fw-end) - fw-end - :end-suf)) - :end-suf))) - (goto-char beg) - (kill-region beg end)))) - (sp--cleanup-after-kill) - (setq arg (1- arg))) - (sp-backward-kill-symbol (sp--negate-argument arg) word)))) - -(defun sp-kill-word (&optional arg) - "Kill a word forward, skipping over intervening delimiters. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction." - (interactive "p") - (sp-kill-symbol arg t)) - -(defun sp-delete-symbol (&optional arg word) - "Delete a symbol forward, skipping over any intervening delimiters. - -Deleted symbol does not go to the clipboard or kill ring. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction. - -See `sp-forward-symbol' for what constitutes a symbol." - (interactive "p") - (let* ((kill-ring kill-ring) - (select-enable-clipboard nil)) - (sp-kill-symbol arg word))) - -(defun sp-delete-word (&optional arg) - "Delete a word forward, skipping over intervening delimiters. - -Deleted word does not go to the clipboard or kill ring. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction." - (interactive "p") - (sp-delete-symbol arg t)) - -(defun sp-backward-kill-symbol (&optional arg word) - "Kill a symbol backward, skipping over any intervening delimiters. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -forward direction. - -See `sp-backward-symbol' for what constitutes a symbol." - (interactive "p") - (sp--with-case-sensitive - (if (> arg 0) - (while (> arg 0) - (-when-let (s (sp-get-symbol t)) - (sp-get s - (let* ((end - (if (< (point) :end-suf) - (if word (point) :end-suf) - (if (= (save-excursion - (sp-skip-backward-to-symbol) - (point)) - :end-suf) - (point) - :end-suf))) - (beg (if word - (let ((bw-start - (save-excursion - (sp--backward-word) - (point)))) - (if (sp-region-ok-p bw-start end) - bw-start - :beg-prf)) - :beg-prf))) - (goto-char end) - (kill-region end beg)))) - (sp--cleanup-after-kill) - (setq arg (1- arg))) - (sp-kill-symbol (sp--negate-argument arg) word)))) - -(defun sp-backward-kill-word (&optional arg) - "Kill a word backward, skipping over intervening delimiters. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction." - (interactive "p") - (sp-backward-kill-symbol arg t)) - -(defun sp-backward-delete-symbol (&optional arg word) - "Delete a symbol backward, skipping over any intervening delimiters. - -Deleted symbol does not go to the clipboard or kill ring. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -forward direction. - -See `sp-backward-symbol' for what constitutes a symbol." - (interactive "p") - (let* ((kill-ring kill-ring) - (select-enable-clipboard nil)) - (sp-backward-kill-symbol arg word))) - -(defun sp-backward-delete-word (&optional arg) - "Delete a word backward, skipping over intervening delimiters. - -Deleted word does not go to the clipboard or kill ring. - -With ARG being positive number N, repeat that many times. - -With ARG being Negative number -N, repeat that many times in -backward direction." - (interactive "p") - (sp-backward-delete-symbol arg t)) - -(defun sp-delete-region (beg end) - "Delete the text between point and mark, like `delete-region'. - -BEG and END are the bounds of region to be deleted. - -If that text is unbalanced, signal an error instead. -With a prefix argument, skip the balance check." - (interactive "r") - (when (or current-prefix-arg - (sp-region-ok-p beg end) - (user-error (sp-message :unbalanced-region :return))) - (setq this-command 'delete-region) - (delete-region beg end))) - -(defun sp-kill-region (beg end) - "Kill the text between point and mark, like `kill-region'. - -BEG and END are the bounds of region to be killed. - -If that text is unbalanced, signal an error instead. -With a prefix argument, skip the balance check." - (interactive "r") - (when (or current-prefix-arg - (sp-region-ok-p beg end) - (user-error (sp-message :unbalanced-region :return))) - (setq this-command 'kill-region) - (kill-region beg end))) - -(defun sp-indent-defun (&optional arg) - "Reindent the current defun. - -If point is inside a string or comment, fill the current -paragraph instead, and with ARG, justify as well. - -Otherwise, reindent the current defun, and adjust the position -of the point." - (interactive "P") - (if (sp-point-in-string-or-comment) - (fill-paragraph arg) - (let ((column (current-column)) - (indentation (sp--current-indentation))) - (save-excursion - (end-of-defun) - (beginning-of-defun) - (indent-sexp)) - (sp--back-to-indentation column indentation)))) - -(cl-defun sp-region-ok-p (start end) - "Test if region between START and END is balanced. - -A balanced region is one where all opening delimiters are matched -by closing delimiters. - -This function does *not* check that the delimiters are correctly -ordered, that is [(]) is correct even though it is not logically -properly balanced." - (interactive "r") - (save-excursion - (save-restriction - (when (eq (sp-point-in-string start) (sp-point-in-string end)) - (narrow-to-region start end) - (let ((regex (sp--get-allowed-regexp (-difference sp-pair-list (sp--get-allowed-pair-list))))) - (goto-char (point-min)) - (while (or (prog1 (sp-forward-sexp) - (sp-skip-forward-to-symbol)) - ;; skip impossible delimiters - (when (looking-at-p regex) - (goto-char (match-end 0))))) - (looking-at-p "[[:blank:]\n]*\\'")))))) - -(defun sp-newline () - "Insert a newline and indent it. - -This is like `newline-and-indent', but it not only indents the -line that the point is on but also the S-expression following the -point, if there is one. - -If in a string, just insert a literal newline. - -If in a comment and if followed by invalid structure, call -`indent-new-comment-line' to keep the invalid structure in a -comment." - (interactive) - (cond - ((sp-point-in-string) - (newline)) - ((sp-point-in-comment) - (if (sp-region-ok-p (point) (point-at-eol)) - (progn (newline-and-indent) (ignore-errors (indent-sexp))) - (indent-new-comment-line))) - (t - (newline-and-indent) - (ignore-errors (indent-sexp))))) - -(defun sp-comment () - "Insert the comment character and adjust hanging sexps such - that it doesn't break structure." - (interactive) - (if (sp-point-in-string-or-comment) - (if (= 1 (length (single-key-description last-command-event))) ;; pretty hacky - (insert (single-key-description last-command-event)) - (insert comment-start)) - (sp--with-case-sensitive - (let ((old-point (point)) - (column (current-column)) - (indentation (sp--current-indentation)) - (old-line (line-number-at-pos)) - (hsexp (sp-get-hybrid-sexp)) - (newline-inserted 0)) - (goto-char (sp-get hsexp :end)) - (if (and (sp--looking-at-p (concat "\\s-*" (sp--get-closing-regexp))) - (= old-line (line-number-at-pos))) - (progn - (setq old-point (point)) - (newline) - (setq newline-inserted (1+ (- (line-end-position) (point))))) - (when (/= old-line (line-number-at-pos)) - (sp-backward-sexp) - (setq old-point (+ old-point (skip-syntax-backward " "))) - (newline) - (setq newline-inserted (- (line-end-position) (point))))) - ;; @{ indenting madness - (goto-char old-point) - (sp-get hsexp (sp--indent-region :beg (+ :end newline-inserted))) - (sp--back-to-indentation column indentation) - ;; @} - (let ((comment-delim (or (cdr (--first (memq major-mode (car it)) sp-comment-string)) - comment-start))) - (when (and (/= 0 (current-column)) - (not (sp--looking-back-p "\\s-"))) - (insert " ")) - (insert comment-delim) - (when (/= newline-inserted 0) - (save-excursion - (forward-line 1) - (indent-according-to-mode)))))))) - -(defun sp-wrap-round () - "Wrap following sexp in round parentheses." - (interactive) - (sp-wrap-with-pair "(")) - -(defun sp-wrap-square () - "Wrap following sexp in square brackets." - (interactive) - (sp-wrap-with-pair "[")) - -(defun sp-wrap-curly () - "Wrap following sexp in curly braces." - (interactive) - (sp-wrap-with-pair "{")) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; show-smartparens-mode - -(defgroup show-smartparens nil - "Show smartparens minor mode." - :group 'smartparens) - -(defcustom sp-show-pair-delay 0.125 - "Time in seconds to delay before showing a matching pair." - :type '(number :tag "seconds") - :group 'show-smartparens) - -(defcustom sp-show-enclosing-pair-commands '( - sp-show-enclosing-pair - sp-forward-slurp-sexp - sp-backward-slurp-sexp - sp-forward-barf-sexp - sp-backward-barf-sexp - ) - "List of commands after which the enclosing pair is highlighted. - -After the next command the pair will automatically disappear." - :type '(repeat symbol) - :group 'show-smartparens) - -(defcustom sp-show-pair-from-inside nil - "If non-nil, highlight the enclosing pair if immediately after -the opening delimiter or before the closing delimiter." - :type 'boolean - :group 'show-smartparens) - -(defcustom sp-show-pair-match-priority 1000 - "Priority of matching pair highlighting overlays." - :type 'integer - :group 'show-smartparens) - -(defface sp-show-pair-match-face - '((t (:inherit show-paren-match))) - "`show-smartparens-mode' face used for a matching pair." - :group 'show-smartparens) - -(defface sp-show-pair-mismatch-face - '((t (:inherit show-paren-mismatch))) - "`show-smartparens-mode' face used for a mismatching pair." - :group 'show-smartparens) - -(defface sp-show-pair-enclosing - '((t (:inherit highlight))) - "The face used to highlight pair overlays." - :group 'show-smartparens) - -(defface sp-show-pair-match-content-face - '() - "`show-smartparens-mode' face used for a matching pair's content." - :group 'show-smartparens) - -(defvar sp-show-pair-idle-timer nil) - -(defvar sp-show-pair-overlays nil) - -(defvar sp-show-pair-previous-match-positions nil) - -(defvar sp-show-pair-previous-point nil) - -(defvar sp-show-pair-enc-overlays nil) - -;;;###autoload -(define-minor-mode show-smartparens-mode - "Toggle visualization of matching pairs. When enabled, any -matching pair is highlighted after `sp-show-pair-delay' seconds -of Emacs idle time if the point is immediately in front or after -a pair. This mode works similarly to `show-paren-mode', but -support custom pairs." - :init-value nil - :group 'show-smartparens - (if show-smartparens-mode - (unless sp-show-pair-idle-timer - (setq sp-show-pair-idle-timer - (run-with-idle-timer sp-show-pair-delay t - 'sp-show--pair-function))) - (when sp-show-pair-overlays - (sp-show--pair-delete-overlays)))) - -;;;###autoload -(define-globalized-minor-mode show-smartparens-global-mode - show-smartparens-mode - turn-on-show-smartparens-mode) - -;;;###autoload -(defun turn-on-show-smartparens-mode () - "Turn on `show-smartparens-mode'." - (interactive) - (unless (or (member major-mode sp-ignore-modes-list) - (and (not (derived-mode-p 'comint-mode)) - (eq (get major-mode 'mode-class) 'special))) - (show-smartparens-mode t))) - -;;;###autoload -(defun turn-off-show-smartparens-mode () - "Turn off `show-smartparens-mode'." - (interactive) - (show-smartparens-mode -1)) - -(defun sp-show-enclosing-pair () - "Highlight the enclosing pair around point." - (interactive)) - -(defun sp-highlight-current-sexp (_arg) - "Highlight the expression returned by the next command, preserving point position." - (interactive "P") - (let* ((cmd (read-key-sequence "" t)) - (com (key-binding cmd))) - (if (commandp com) - (save-excursion - (let ((ok (call-interactively com))) - (sp-show--pair-enc-function ok))) - (execute-kbd-macro cmd)))) - -(eval-when-compile - (defalias 'sp--while-no-input 'while-no-input) - (when (version< emacs-version "27") - ;; Ripped from Emacs 27.0 subr.el. - ;; See Github Issue#946 and Emacs bug#31692. - (defmacro sp--while-no-input (&rest body) - "Execute BODY only as long as there's no pending input. -If input arrives, that ends the execution of BODY, -and `while-no-input' returns t. Quitting makes it return nil. -If BODY finishes, `while-no-input' returns whatever value BODY produced." - (declare (debug t) (indent 0)) - (let ((catch-sym (make-symbol "input"))) - `(with-local-quit - (catch ',catch-sym - (let ((throw-on-input ',catch-sym) - val) - (setq val (or (input-pending-p) - (progn ,@body))) - (cond - ;; When input arrives while throw-on-input is non-nil, - ;; kbd_buffer_store_buffered_event sets quit-flag to the - ;; value of throw-on-input. If, when BODY finishes, - ;; quit-flag still has the same value as throw-on-input, it - ;; means BODY never tested quit-flag, and therefore ran to - ;; completion even though input did arrive before it - ;; finished. In that case, we must manually simulate what - ;; 'throw' in process_quit_flag would do, and we must - ;; reset quit-flag, because leaving it set will cause us - ;; quit to top-level, which has undesirable consequences, - ;; such as discarding input etc. We return t in that case - ;; because input did arrive during execution of BODY. - ((eq quit-flag throw-on-input) - (setq quit-flag nil) - t) - ;; This is for when the user actually QUITs during - ;; execution of BODY. - (quit-flag - nil) - (t val))))))))) - -(defun sp-show--pair-function () - "Display the show pair overlays and print the line of the -matching paren in the echo area if not visible on screen." - (when show-smartparens-mode - (sp--with-case-sensitive - (save-match-data - (sp--while-no-input - (cl-labels ((scan-and-place-overlays - (match &optional back) - ;; we can use `sp-get-thing' here because we *are* at some - ;; pair opening, and so only the tag or the sexp can trigger. - (-if-let (ok (sp-get-thing back)) - (sp-get ok - (when (or (and back - (or (= :end (point)) - (= :beg-in (point)))) - (and (not back) - (or (= :beg (point)) - (= :end-in (point))))) - (sp-show--pair-create-overlays :beg :end :op-l :cl-l) - (when (and sp-echo-match-when-invisible - (not (or (active-minibuffer-window) cursor-in-echo-area))) - (sp-show--pair-echo-match :beg :end :op-l :cl-l)))) - (if back - (sp-show--pair-create-mismatch-overlay (- (point) (length match)) - (length match)) - (sp-show--pair-create-mismatch-overlay (point) (length match))) - (setq sp-show-pair-previous-match-positions nil) - (setq sp-show-pair-previous-point nil)))) - (let* ((pair-list (sp--get-allowed-pair-list)) - (opening (sp--get-opening-regexp pair-list)) - (closing (sp--get-closing-regexp pair-list)) - (allowed (and sp-show-pair-from-inside (sp--get-allowed-regexp)))) - (cond - ;; if we are in a situation "()|", we should highlight the - ;; regular pair and not the string pair "from inside" - ((and (not (sp--evil-normal-state-p)) - (not (sp--evil-motion-state-p)) - (not (sp--evil-visual-state-p)) - (sp--looking-back (if sp-show-pair-from-inside allowed closing))) - (scan-and-place-overlays (match-string 0) :back)) - ((or (and (or (sp--evil-normal-state-p) - (sp--evil-motion-state-p) - (sp--evil-visual-state-p)) - (sp--looking-at (sp--get-allowed-regexp))) - (sp--looking-at (if sp-show-pair-from-inside allowed opening)) - (looking-at (sp--get-stringlike-regexp)) - (and (memq major-mode sp-navigate-consider-sgml-tags) - (looking-at "<"))) - (scan-and-place-overlays (match-string 0))) - ((or (sp--looking-back (if sp-show-pair-from-inside allowed closing)) - (sp--looking-back (sp--get-stringlike-regexp)) - (and (memq major-mode sp-navigate-consider-sgml-tags) - (sp--looking-back ">"))) - (scan-and-place-overlays (match-string 0) :back)) - (sp-show-pair-overlays - (sp-show--pair-delete-overlays) - (setq sp-show-pair-previous-match-positions nil) - (setq sp-show-pair-previous-point nil)))))))))) - -(defun sp-show--pair-enc-function (&optional thing) - "Display the show pair overlays for enclosing expression." - (when show-smartparens-mode - (-when-let (enc (or thing (sp-get-enclosing-sexp))) - (sp-get enc (sp-show--pair-create-enc-overlays :beg :end :op-l :cl-l))))) - -(defun sp-show--pair-create-overlays (start end olen clen) - "Create the show pair overlays." - (when sp-show-pair-overlays - (sp-show--pair-delete-overlays)) - (let* ((oleft (make-overlay start (+ start olen) nil t nil)) - (omiddle (make-overlay (+ start olen) (- end clen) nil t nil)) - (oright (make-overlay (- end clen) end nil t nil))) - (setq sp-show-pair-overlays (list oleft omiddle oright)) - (overlay-put oleft 'face 'sp-show-pair-match-face) - (unless (use-region-p) - (overlay-put omiddle 'face 'sp-show-pair-match-content-face)) - (overlay-put oright 'face 'sp-show-pair-match-face) - (overlay-put oleft 'priority sp-show-pair-match-priority) - (overlay-put omiddle 'priority 1000) - (overlay-put oright 'priority sp-show-pair-match-priority) - (overlay-put oleft 'type 'show-pair))) - -(defun sp-show--pair-echo-match (start end olen clen) - "Print the line of the matching paren in the echo area if not -visible on screen. Needs to be called after the show-pair overlay -has been created." - (let ((match-positions (list start end olen clen))) - (when (not (and (equal sp-show-pair-previous-match-positions match-positions) - (equal sp-show-pair-previous-point (point)))) - (setq sp-show-pair-previous-match-positions match-positions) - (setq sp-show-pair-previous-point (point)) - (let* ((visible-start (pos-visible-in-window-p start)) - (visible-end (pos-visible-in-window-p end)) - (where (cond - ((not visible-start) start) - ((not visible-end) end)))) - (when where - (save-excursion - (let* ((from (progn (goto-char where) (beginning-of-line) (point))) - (to (progn (end-of-line) (point))) - (line (buffer-substring from to)) - (message-log-max)) ;; don't log in messages - ;; Add smartparens overlay for opening parens - (let* ((i1 (- start from)) - (i2 (+ i1 olen))) - (when (and (< i1 (length line)) (>= i2 0)) - (add-face-text-property (max i1 0) (min i2 (length line)) - 'sp-show-pair-match-face nil line))) - ;; Add smartparens overlay for closing parens - (let* ((i1 (- end from 1)) - (i2 (+ i1 clen))) - (when (and (< i1 (length line)) (>= i2 0)) - (add-face-text-property (max i1 0) (min i2 (length line)) - 'sp-show-pair-match-face nil line))) - ;; echo line of match - (message "Matches: %s" (string-trim line))))))))) - -(defun sp-show--pair-create-enc-overlays (start end olen clen) - "Create the show pair enclosing overlays" - (when sp-show-pair-enc-overlays - (sp-show--pair-delete-enc-overlays)) - (let* ((oleft (make-overlay start (+ start olen) nil t nil)) - (oright (make-overlay (- end clen) end nil t nil))) - (setq sp-show-pair-enc-overlays (cons oleft oright)) - (overlay-put oleft 'face 'sp-show-pair-enclosing) - (overlay-put oright 'face 'sp-show-pair-enclosing) - (overlay-put oleft 'priority 1000) - (overlay-put oright 'priority 1000) - (overlay-put oleft 'type 'show-pair-enc))) - -(defun sp-show--pair-create-mismatch-overlay (start len) - "Create the mismatch pair overlay." - (when sp-show-pair-overlays - (sp-show--pair-delete-overlays)) - (let ((o (make-overlay start (+ start len) nil t nil))) - (setq sp-show-pair-overlays (list o)) - (overlay-put o 'face 'sp-show-pair-mismatch-face) - (overlay-put o 'priority 1000) - (overlay-put o 'type 'show-pair))) - -(defun sp-show--pair-delete-overlays () - "Remove both show pair overlays." - (when sp-show-pair-overlays - (dolist (overlay sp-show-pair-overlays) - (delete-overlay overlay)) - (setq sp-show-pair-overlays nil))) - -(defun sp-show--pair-delete-enc-overlays () - "Remove both show pair enclosing overlays." - (when sp-show-pair-enc-overlays - (when (car sp-show-pair-enc-overlays) - (delete-overlay (car sp-show-pair-enc-overlays))) - (when (cdr sp-show-pair-enc-overlays) - (delete-overlay (cdr sp-show-pair-enc-overlays))) - (setq sp-show-pair-enc-overlays nil))) - - -;; global initialization -(defadvice delete-backward-char (before sp-delete-pair-advice activate) - (save-match-data - (sp-delete-pair (ad-get-arg 0)))) -(defadvice haskell-indentation-delete-backward-char (before sp-delete-pair-advice activate) - (save-match-data - (sp-delete-pair (ad-get-arg 0)))) -(add-hook 'post-command-hook 'sp--post-command-hook-handler) -(sp--set-base-key-bindings) -(sp--update-override-key-bindings) - -(defadvice company--insert-candidate (after sp-company--insert-candidate activate) - "If `smartparens-mode' is active, we check if the completed string -has a pair definition. If so, we insert the closing pair." - (when smartparens-mode - (sp-insert-pair)) - ad-return-value) - -(defadvice hippie-expand (after sp-auto-complete-advice activate) - (when smartparens-mode - (sp-insert-pair))) - -(defvar sp--mc/cursor-specific-vars - '( - sp-wrap-point - sp-wrap-mark - sp-last-wrapped-region - sp-pair-overlay-list - sp-wrap-overlays - sp-wrap-tag-overlays - sp-last-operation - sp-previous-point - ) - "A list of vars that need to be tracked on a per-cursor basis.") - -(defvar mc/cursor-specific-vars) -(eval-after-load 'multiple-cursors - '(dolist (it sp--mc/cursor-specific-vars) - (add-to-list 'mc/cursor-specific-vars it))) - -(provide 'smartparens) - -;; Local Variables: -;; coding: utf-8 -;; eval: (font-lock-add-keywords nil `((,(concat "(" (regexp-opt '("sp-do-move-op" "sp-do-move-cl" "sp-do-put-op" "sp-do-put-cl" "sp-do-del-op" "sp-do-del-cl") t) "\\_>") 1 'font-lock-variable-name-face))) -;; End: - -;;; smartparens.el ends here diff --git a/elpa/smartparens-20220623.1523/sp-sublimetext-like.el b/elpa/smartparens-20220623.1523/sp-sublimetext-like.el deleted file mode 100644 index 1cae7f43..00000000 --- a/elpa/smartparens-20220623.1523/sp-sublimetext-like.el +++ /dev/null @@ -1,57 +0,0 @@ -;;; sp-sublimetext-like.el --- Behavior for inserting parentheses similar to SublimeText editor. -*- lexical-binding: t; -*- -;; -;; Author: Konstantin Kharlamov -;; Maintainer: Matus Goljer -;; Created: 16 December 2020 -;; Keywords: convenience editing -;; URL: https://github.com/Fuco1/smartparens -;; -;; This file is not part of GNU Emacs. -;; -;;; License: -;; -;; This file is part of Smartparens. -;; -;; Smartparens 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. -;; -;; Smartparens 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 Smartparens. If not, see . -;; -;;; Commentary: -;; -;; This file configuation to make smartparens insertion behavae similarly to -;; SublimeText editor. To use it, simply add: -;; -;; (require 'sp-sublimetext-like) -;; -;; into your configuration. You can use this in conjunction with the -;; default config or your own configuration. -;; -;;; Code: - -(require 'smartparens) - -(defun sp-point-not-before-word (_ action __) - "In insert and autoskip actions returns t when next symbol is -not a word constituent." - (if (memq action '(insert autoskip)) - (looking-at "\\(\\Sw\\|$\\)") - t)) - -(let ((when '(sp-point-not-before-word)) - (actions '(insert wrap autoskip navigate))) - (sp-pair "{" "}" :when when :actions actions) - (sp-pair "[" "]" :when when :actions actions) - (sp-pair "(" ")" :when when :actions actions)) - -(provide 'sp-sublimetext-like) - -;;; sp-sublimetext-like.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-autoloads.el b/elpa/smartparens-20230529.1017/smartparens-autoloads.el new file mode 100644 index 00000000..5135ae0d --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-autoloads.el @@ -0,0 +1,403 @@ +;;; smartparens-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "smartparens" "smartparens.el" (0 0 0 0)) +;;; Generated autoloads from smartparens.el + +(autoload 'sp-cheat-sheet "smartparens" "\ +Generate a cheat sheet of all the smartparens interactive functions. + +Without a prefix argument, print only the short documentation and examples. + +With non-nil prefix argument ARG, show the full documentation for each function. + +You can follow the links to the function or variable help page. +To get back to the full list, use \\[help-go-back]. + +You can use `beginning-of-defun' and `end-of-defun' to jump to +the previous/next entry. + +Examples are fontified using the `font-lock-string-face' for +better orientation. + +\(fn &optional ARG)" t nil) + +(defvar smartparens-mode-map (make-sparse-keymap) "\ +Keymap used for `smartparens-mode'.") + +(autoload 'sp-use-paredit-bindings "smartparens" "\ +Initiate `smartparens-mode-map' with `sp-paredit-bindings'." t nil) + +(autoload 'sp-use-smartparens-bindings "smartparens" "\ +Initiate `smartparens-mode-map' with `sp-smartparens-bindings'." t nil) + +(autoload 'smartparens-mode "smartparens" "\ +Toggle smartparens mode. + +This is a minor mode. If called interactively, toggle the +`Smartparens mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `smartparens-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +You can enable pre-set bindings by customizing +`sp-base-key-bindings' variable. The current content of +`smartparens-mode-map' is: + + \\{smartparens-mode-map} + +\(fn &optional ARG)" t nil) + +(autoload 'smartparens-strict-mode "smartparens" "\ +Toggle the strict smartparens mode. + +This is a minor mode. If called interactively, toggle the +`Smartparens-Strict mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `smartparens-strict-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +When strict mode is active, `delete-char', `kill-word' and their +backward variants will skip over the pair delimiters in order to +keep the structure always valid (the same way as `paredit-mode' +does). This is accomplished by remapping them to +`sp-delete-char' and `sp-kill-word'. There is also function +`sp-kill-symbol' that deletes symbols instead of words, otherwise +working exactly the same (it is not bound to any key by default). + +When strict mode is active, this is indicated with \"/s\" +after the smartparens indicator in the mode list. + +\(fn &optional ARG)" t nil) + +(put 'smartparens-global-strict-mode 'globalized-minor-mode t) + +(defvar smartparens-global-strict-mode nil "\ +Non-nil if Smartparens-Global-Strict mode is enabled. +See the `smartparens-global-strict-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `smartparens-global-strict-mode'.") + +(custom-autoload 'smartparens-global-strict-mode "smartparens" nil) + +(autoload 'smartparens-global-strict-mode "smartparens" "\ +Toggle Smartparens-Strict mode in all buffers. +With prefix ARG, enable Smartparens-Global-Strict mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Smartparens-Strict mode is enabled in all buffers where +`turn-on-smartparens-strict-mode' would do it. + +See `smartparens-strict-mode' for more information on +Smartparens-Strict mode. + +\(fn &optional ARG)" t nil) + +(autoload 'turn-on-smartparens-strict-mode "smartparens" "\ +Turn on `smartparens-strict-mode'." t nil) + +(autoload 'turn-off-smartparens-strict-mode "smartparens" "\ +Turn off `smartparens-strict-mode'." t nil) + +(put 'smartparens-global-mode 'globalized-minor-mode t) + +(defvar smartparens-global-mode nil "\ +Non-nil if Smartparens-Global mode is enabled. +See the `smartparens-global-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `smartparens-global-mode'.") + +(custom-autoload 'smartparens-global-mode "smartparens" nil) + +(autoload 'smartparens-global-mode "smartparens" "\ +Toggle Smartparens mode in all buffers. +With prefix ARG, enable Smartparens-Global mode if ARG is positive; +otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Smartparens mode is enabled in all buffers where +`turn-on-smartparens-mode' would do it. + +See `smartparens-mode' for more information on Smartparens mode. + +\(fn &optional ARG)" t nil) + +(autoload 'turn-on-smartparens-mode "smartparens" "\ +Turn on `smartparens-mode'. + +This function is used to turn on `smartparens-global-mode'. + +By default `smartparens-global-mode' ignores buffers with +`mode-class' set to special, but only if they are also not comint +buffers. + +Additionally, buffers on `sp-ignore-modes-list' are ignored. + +You can still turn on smartparens in these mode manually (or +in mode's startup-hook etc.) by calling `smartparens-mode'." t nil) + +(autoload 'turn-off-smartparens-mode "smartparens" "\ +Turn off `smartparens-mode'." t nil) + +(autoload 'show-smartparens-mode "smartparens" "\ +Toggle visualization of matching pairs. When enabled, any +matching pair is highlighted after `sp-show-pair-delay' seconds +of Emacs idle time if the point is immediately in front or after +a pair. This mode works similarly to `show-paren-mode', but +support custom pairs. + +This is a minor mode. If called interactively, toggle the +`Show-Smartparens mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `show-smartparens-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(put 'show-smartparens-global-mode 'globalized-minor-mode t) + +(defvar show-smartparens-global-mode nil "\ +Non-nil if Show-Smartparens-Global mode is enabled. +See the `show-smartparens-global-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `show-smartparens-global-mode'.") + +(custom-autoload 'show-smartparens-global-mode "smartparens" nil) + +(autoload 'show-smartparens-global-mode "smartparens" "\ +Toggle Show-Smartparens mode in all buffers. +With prefix ARG, enable Show-Smartparens-Global mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Show-Smartparens mode is enabled in all buffers where +`turn-on-show-smartparens-mode' would do it. + +See `show-smartparens-mode' for more information on Show-Smartparens +mode. + +\(fn &optional ARG)" t nil) + +(autoload 'turn-on-show-smartparens-mode "smartparens" "\ +Turn on `show-smartparens-mode'." t nil) + +(autoload 'turn-off-show-smartparens-mode "smartparens" "\ +Turn off `show-smartparens-mode'." t nil) + +(register-definition-prefixes "smartparens" '("smartparens-" "sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-clojure" "smartparens-clojure.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-clojure.el + +(register-definition-prefixes "smartparens-clojure" '("sp-clojure-prefix")) + +;;;*** + +;;;### (autoloads nil "smartparens-config" "smartparens-config.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-config.el + +(register-definition-prefixes "smartparens-config" '("sp-lisp-invalid-hyperlink-p")) + +;;;*** + +;;;### (autoloads nil "smartparens-crystal" "smartparens-crystal.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-crystal.el + +(register-definition-prefixes "smartparens-crystal" '("sp-crystal-")) + +;;;*** + +;;;### (autoloads nil "smartparens-elixir" "smartparens-elixir.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-elixir.el + +(register-definition-prefixes "smartparens-elixir" '("sp-elixir-")) + +;;;*** + +;;;### (autoloads nil "smartparens-ess" "smartparens-ess.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-ess.el + +(register-definition-prefixes "smartparens-ess" '("sp-ess-")) + +;;;*** + +;;;### (autoloads nil "smartparens-haskell" "smartparens-haskell.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-haskell.el + +(register-definition-prefixes "smartparens-haskell" '("sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-html" "smartparens-html.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-html.el + +(register-definition-prefixes "smartparens-html" '("sp-html-")) + +;;;*** + +;;;### (autoloads nil "smartparens-latex" "smartparens-latex.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-latex.el + +(register-definition-prefixes "smartparens-latex" '("sp-latex-")) + +;;;*** + +;;;### (autoloads nil "smartparens-lua" "smartparens-lua.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-lua.el + +(register-definition-prefixes "smartparens-lua" '("sp-lua-post-keyword-insert")) + +;;;*** + +;;;### (autoloads nil "smartparens-markdown" "smartparens-markdown.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-markdown.el + +(register-definition-prefixes "smartparens-markdown" '("sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-org" "smartparens-org.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-org.el + +(register-definition-prefixes "smartparens-org" '("sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-python" "smartparens-python.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-python.el + +(register-definition-prefixes "smartparens-python" '("sp-python-")) + +;;;*** + +;;;### (autoloads nil "smartparens-rst" "smartparens-rst.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-rst.el + +(register-definition-prefixes "smartparens-rst" '("sp-rst-point-after-backtick")) + +;;;*** + +;;;### (autoloads nil "smartparens-ruby" "smartparens-ruby.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-ruby.el + +(register-definition-prefixes "smartparens-ruby" '("sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-rust" "smartparens-rust.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-rust.el + +(register-definition-prefixes "smartparens-rust" '("sp-")) + +;;;*** + +;;;### (autoloads nil "smartparens-scala" "smartparens-scala.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-scala.el + +(register-definition-prefixes "smartparens-scala" '("sp-scala-wrap-with-indented-newlines")) + +;;;*** + +;;;### (autoloads nil "smartparens-swift" "smartparens-swift.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-swift.el + +(register-definition-prefixes "smartparens-swift" '("sp-swift-")) + +;;;*** + +;;;### (autoloads nil "smartparens-text" "smartparens-text.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-text.el + +(register-definition-prefixes "smartparens-text" '("sp-text-mode-")) + +;;;*** + +;;;### (autoloads nil "sp-sublimetext-like" "sp-sublimetext-like.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from sp-sublimetext-like.el + +(register-definition-prefixes "sp-sublimetext-like" '("sp-point-not-before-word")) + +;;;*** + +;;;### (autoloads nil nil ("smartparens-c.el" "smartparens-erlang.el" +;;;;;; "smartparens-go.el" "smartparens-javascript.el" "smartparens-ml.el" +;;;;;; "smartparens-pkg.el" "smartparens-racket.el" "smartparens-unison.el") +;;;;;; (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; smartparens-autoloads.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-c.el b/elpa/smartparens-20230529.1017/smartparens-c.el new file mode 100644 index 00000000..d23f3b22 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-c.el @@ -0,0 +1,59 @@ +;;; smartparens-c.el --- Additional configuration for C/C++ mode. -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2019-2020, 2022 Naoya Yamashita, Matus Goljer +;; +;; Author: Naoya Yamashita +;; Maintainer: Matus Goljer +;; Created: 23 June 2019 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens +;; +;; This file is not part of GNU Emacs. +;; +;;; License: +;; +;; This file is part of Smartparens. +;; +;; Smartparens 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. +;; +;; Smartparens 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 Smartparens. If not, see . +;; +;;; Commentary: +;; +;; This file provides some additional configuration for C/C++ mode. +;; To use it, simply add: +;; +;; (require 'smartparens-c) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;;; Code: + +(require 'smartparens) + +;; remap electric delete functions to smartparens function +(define-key smartparens-strict-mode-map [remap c-electric-delete-forward] 'sp-delete-char) +(define-key smartparens-strict-mode-map [remap c-electric-backspace] 'sp-backward-delete-char) + +(sp-with-modes sp-c-modes + (sp-local-pair "{" nil :post-handlers '(("||\n[i]" "RET"))) + (sp-local-pair "/*" "*/" :post-handlers '(("| " "SPC") + ("* ||\n[i]" "RET")))) + +;; inline formulas for doxygen +(sp-with-modes sp-c-modes + (sp-local-pair "\\f[" "\\f]" :when '(sp-in-comment-p)) + (sp-local-pair "\\f$" "\\f$" :when '(sp-in-comment-p))) + +(provide 'smartparens-c) +;;; smartparens-c.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-clojure.el b/elpa/smartparens-20230529.1017/smartparens-clojure.el new file mode 100644 index 00000000..4408e8ae --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-clojure.el @@ -0,0 +1,58 @@ +;;; smartparens-clojure.el --- Additional configuration for Clojure mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2016, 2018-2019 Vitalie Spinu, Matus Goljer + +;; Author: Vitalie Spinu +;; Maintainer: Matus Goljer +;; Created: 14 July 2016 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens +;; +;; This file is not part of GNU Emacs. +;; +;;; License: +;; +;; This file is part of Smartparens. +;; +;; Smartparens 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. +;; +;; Smartparens 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 Smartparens. If not, see . +;; +;;; Commentary: +;; +;; This file provides some additional configuration for Clojure mode. To use +;; it, simply add: +;; +;; (require 'smartparens-clojure) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;;; Code: + +(require 'smartparens) + +(defvar sp-clojure-prefix "\\(?:[@`'#~,_?^]+\\)" + "Prefix used in `sp-sexp-prefix' for clojure modes.") + +(dolist (mode '(clojure-mode clojurescript-mode clojurec-mode cider-repl-mode)) + (add-to-list 'sp-sexp-prefix `(,mode regexp ,sp-clojure-prefix))) + +;; Match "`" with "`" in strings and comments +(sp-with-modes sp-clojure-modes + (sp-local-pair "`" "`" + :when '(sp-in-string-p + sp-in-comment-p) + :unless '(sp-lisp-invalid-hyperlink-p))) + +(provide 'smartparens-clojure) +;;; smartparens-clojure.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-config.el b/elpa/smartparens-20230529.1017/smartparens-config.el new file mode 100644 index 00000000..7bfcfe08 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-config.el @@ -0,0 +1,154 @@ +;;; smartparens-config.el --- Default configuration for smartparens package -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2020, 2022-2023 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 30 Jan 2013 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This is a default configuration for smartparens package. If you +;; wish to set up everything by yourself, you can instead require +;; smartparens directly. + +;; However, some configuration is always loaded by default, most +;; notably the built-in list of supported pairs. If you want to erase +;; this list, simply use (setq sp-pairs nil) and then add your own +;; pairs. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defun sp-lisp-invalid-hyperlink-p (_id action _context) + "Test if there is an invalid hyperlink in a Lisp docstring. +ID, ACTION, CONTEXT." + (when (eq action 'navigate) + ;; Ignore errors due to us being at the start or end of the + ;; buffer. + (ignore-errors + (or + ;; foo'|bar + (and (looking-at "\\sw\\|\\s_") + ;; do not consider punctuation + (not (looking-at "[?.,;!]")) + (save-excursion + (backward-char 2) + (looking-at "\\sw\\|\\s_"))) + ;; foo|'bar + (and (save-excursion + (backward-char 1) + (looking-at "\\sw\\|\\s_")) + (save-excursion + (forward-char 1) + (looking-at "\\sw\\|\\s_") + ;; do not consider punctuation + (not (looking-at "[?.,;!]")))))))) + +;; emacs is lisp hacking environment, so we set up some most common +;; lisp modes too +(sp-with-modes sp-lisp-modes + ;; disable ', it's the quote character! + (sp-local-pair "'" nil :actions nil)) + +(eval-after-load 'org + '(progn + (defun sp-lisp-in-lisp-src-block-p (_id _action _context) + (when (org-in-src-block-p) + (let* ((el (org-element-at-point)) + (lang (org-element-property :language el)) + (mode (intern (concat + (if (string= lang "elisp") "emacs-lisp" lang) + "-mode")))) + (memq mode sp-lisp-modes)))) + + ;; Disable ' pairing in lisp org source blocks + (sp-local-pair 'org-mode "'" "'" + :unless '(:add sp-lisp-in-lisp-src-block-p)))) + +(sp-with-modes (-difference sp-lisp-modes sp-clojure-modes) + ;; also only use the pseudo-quote inside strings where it serve as + ;; hyperlink. + (sp-local-pair "`" "'" + :when '(sp-in-string-p + sp-in-comment-p) + :unless '(sp-lisp-invalid-hyperlink-p) + :skip-match (lambda (ms _mb _me) + (cond + ((equal ms "'") + (or (sp-lisp-invalid-hyperlink-p "`" 'navigate '_) + (not (sp-point-in-string-or-comment)))) + (t (not (sp-point-in-string-or-comment))))))) + +;; TODO: this should only be active in docstring, otherwise we want +;; the regexp completion \\{\\}. To handle this feature, we must +;; allow multiple pairs on same opening (therefore, the unique ID must +;; become the opening and closing pair) +(sp-local-pair 'emacs-lisp-mode "\\\\{" "}" :when '(sp-in-docstring-p)) + +;; NOTE: Normally, `sp-local-pair' accepts list of modes (or a single +;; mode) as a first argument. The macro `sp-with-modes' adds this +;; automatically. If you want to call sp-local-pair outside this +;; macro, you MUST supply the major mode argument. + +(eval-after-load 'cc-mode '(require 'smartparens-c)) +(eval-after-load 'clojure-mode '(require 'smartparens-clojure)) +(eval-after-load 'crystal-mode '(require 'smartparens-crystal)) +(eval-after-load 'elixir-mode '(require 'smartparens-elixir)) +(eval-after-load 'elixir-ts-mode '(require 'smartparens-elixir)) +(eval-after-load 'enh-ruby-mode '(require 'smartparens-ruby)) +(eval-after-load 'erlang-mode '(require 'smartparens-erlang)) +(eval-after-load 'ess '(require 'smartparens-ess)) +(eval-after-load 'go-mode '(require 'smartparens-go)) +(eval-after-load 'haskell-interactive-mode '(require 'smartparens-haskell)) +(eval-after-load 'haskell-mode '(require 'smartparens-haskell)) +(--each sp--html-modes + (eval-after-load it '(require 'smartparens-html))) +(eval-after-load 'latex '(require 'smartparens-latex)) +(eval-after-load 'lua-mode '(require 'smartparens-lua)) +(eval-after-load 'markdown-mode '(require 'smartparens-markdown)) +(--each '(python-mode python) + (eval-after-load it '(require 'smartparens-python))) +(eval-after-load 'org '(require 'smartparens-org)) +(eval-after-load 'racket-mode '(require 'smartparens-racket)) +(eval-after-load 'rst '(require 'smartparens-rst)) +(eval-after-load 'ruby-mode '(require 'smartparens-ruby)) +(eval-after-load 'rust-mode '(require 'smartparens-rust)) +(eval-after-load 'rustic '(require 'smartparens-rust)) +(eval-after-load 'scala-mode '(require 'smartparens-scala)) +(eval-after-load 'swift-mode '(require 'smartparens-swift)) +(eval-after-load 'tex-mode '(require 'smartparens-latex)) +(eval-after-load 'text-mode '(require 'smartparens-text)) +(eval-after-load 'tuareg '(require 'smartparens-ml)) +(eval-after-load 'fsharp-mode '(require 'smartparens-ml)) +(eval-after-load 'unisonlang-mode '(require 'smartparens-unison)) +(--each '(js js2-mode) + (eval-after-load it '(require 'smartparens-javascript))) +(provide 'smartparens-config) + +;;; smartparens-config.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-crystal.el b/elpa/smartparens-20230529.1017/smartparens-crystal.el new file mode 100644 index 00000000..574ac8ea --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-crystal.el @@ -0,0 +1,261 @@ +;;; smartparens-crystal.el --- Additional configuration for Crystal based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Brantou + +;; Author: Brantou +;; Maintainer: Brantou +;; Created: 5 March 2018 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; Based on smartparens-ruby.el + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Crystal based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-crystal) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) +(require 'smartparens-ruby) + +(declare-function crystal-forward-sexp "crystal") +(declare-function crystal-backward-sexp "crystal") + +(defun sp-crystal-forward-sexp () + "Wrapper for `crystal-forward-sexp'." + (interactive) + (crystal-forward-sexp)) + +(defun sp-crystal-backward-sexp () + "Wrapper for `crystal-backward-sexp'." + (interactive) + (crystal-backward-sexp)) + +(defun sp-crystal-inline-p (id) + "Test if ID is inline." + (save-excursion + (when (looking-back id nil) + (backward-word)) + (when (not (or (looking-back "^[[:blank:]]*" nil) + (looking-back "= *" nil))) + (or (save-excursion + (forward-symbol -1) + (forward-symbol 1) + (looking-at-p (concat " *" id))) + (save-excursion + ;; This does not seem to make emacs snapshot happy + (ignore-errors + (sp-crystal-backward-sexp) + (sp-crystal-forward-sexp) + (looking-at-p (concat "[^[:blank:]]* *" id)))))))) + +(defun sp-crystal-skip-inline-match-p (ms _mb _me) + "If non-nil, skip inline match. +MS, MB, ME." + (or (sp-ruby-method-p ms) + (sp-crystal-inline-p ms))) + +(defun sp-crystal-in-string-word-or-inline-p (id action context) + "Test if point is inside string, word or inline. +ID, ACTION, CONTEXT." + (or (sp-ruby-in-string-or-word-p id action context) + (and (looking-back id nil) + (sp-crystal-inline-p id)))) + +(add-to-list 'sp-navigate-skip-match + '((crystal-mode) . sp--ruby-skip-match)) + +(dolist (mode '(crystal-mode)) + (add-to-list 'sp-sexp-suffix `(,mode syntax ""))) + +(sp-with-modes 'crystal-mode + (sp-local-pair "do" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-block-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "{" "}" + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-post-handler) + :suffix "") + + (sp-local-pair "begin" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-block-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "def" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "class" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "struct" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "lib" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "fun" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "enum" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "union" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "module" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "macro" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "case" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "if" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-crystal-skip-inline-match-p + :suffix "") + + (sp-local-pair "unless" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-crystal-skip-inline-match-p + :suffix "") + + (sp-local-pair "while" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-crystal-skip-inline-match-p + :suffix "") + + (sp-local-pair "until" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-crystal-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-crystal-skip-inline-match-p + :suffix "") + + (sp-local-pair "|" "|" + :when '(sp-ruby-should-insert-pipe-close) + :pre-handlers '(sp-ruby-pre-pipe-handler) + :suffix "")) + +(provide 'smartparens-crystal) + +;;; smartparens-crystal.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-elixir.el b/elpa/smartparens-20230529.1017/smartparens-elixir.el new file mode 100644 index 00000000..bf416486 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-elixir.el @@ -0,0 +1,214 @@ +;;; smartparens-elixir.el --- Configuration for Elixir. -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018, 2020 Matúš Goljer + +;; Author: Matúš Goljer +;; Maintainer: Matúš Goljer +;; Version: 0.0.1 +;; Created: 15th January 2017 +;; Keywords: languages + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'smartparens) + +(--each '(elixir-mode elixir-ts-mode) + (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) + +(defvar sp-elixir-builtins + (regexp-opt '("defmodule" "defmacro" "defmacrop" "def" "defp" "defimpl" + "if" "unless" "case" "cond" + "with" "for" "receive" "try" "quote") + 'words) + "Regexp that matches opening delimiters for definitions. + +Definitions require either comma followed by \"do:\" keyword +list, or \"do\" \"end\" block delimiters.") + +(defun sp-elixir-skip-do-keyword-p-fun (bodyless-ms keywords) + "Define a function that will test if any of keywords is part of definition. + +BODYLESS-MS is an keyword that supports bodyless form, like +\"def\" or \"defp\". KEYWORDS is additional regexp for keywords +to check in order to skip definition. + +This line-based search terminates early if any of +`sp-elixir-builtins' were found." + (lambda (ms _mb _me) + (unless (or (equal "end" ms) (equal "do" ms)) + (or (string-match-p keywords (thing-at-point 'line t)) + (catch 'definition + (save-excursion + (while t + (forward-line 1) + (let ((line (string-trim-left (thing-at-point 'line t)))) + (unless (string-match-p "\\s-*#" line) ;; skip full line comments + (cond ((eq (string-match-p "\\bend\\b" line) 0) + (throw 'definition nil)) + ;; if BODYLESS-MS was supplied, means we're trying + ;; to match bodyless form + ((and bodyless-ms (eq (string-match-p bodyless-ms line) 0)) + (throw 'definition t)) + ;; Terminate the search if we find any of + ;; `sp-elixir-builtins' as we're usually + ;; searching for "end" + ((eq (string-match-p sp-elixir-builtins line) 0) + (throw 'definition nil)) + ;; "do:" keyword means that there will be no + ;; "end" so we skip this definition + ((eq (string-match-p keywords line) 0) + (throw 'definition t)) + ((eobp) (throw 'definition nil)))))))))))) + +;; Special functions for SKIP-MATCH parameter of `sp-pair' + +(fset 'sp-elixir-skip-keyword-list-def-p (sp-elixir-skip-do-keyword-p-fun nil "\\bdo:")) +(fset 'sp-elixir-skip-bodyless-def-p (sp-elixir-skip-do-keyword-p-fun "\\bdef\\b" "\\bdo:")) +(fset 'sp-elixir-skip-bodyless-defp-p (sp-elixir-skip-do-keyword-p-fun "\\bdefp\\b" "\\bdo:")) +(fset 'sp-elixir-skip-for-in-defimpl-p (sp-elixir-skip-do-keyword-p-fun nil "\\b\\(defimpl\\b\\|do:\\)")) + +(defun sp-elixir-skip-def-p (ms _mb _me) + "Test if \"do\" is part of definition. + +MS must be \"do\" keyword. + +Definitions in Elixir can contain any of `sp-elixir-builtins' +followed with \"do\" keyword and closed with \"end\" keyword, +which may not be on the same line." + (when (equal "do" ms) + (save-excursion + (catch 'definition + (while t + (let ((line (string-trim-left (thing-at-point 'line t)))) + (unless (string-match-p "\\s-*#" line) + (cond ((eq (string-match-p sp-elixir-builtins line) 0) + (throw 'definition t)) + ((eq (string-match-p "\\bend\\b" line) 0) + (throw 'definition nil)) + ((bobp) (throw 'definition nil))))) + (forward-line -1)))))) + +(defun sp-elixir-do-block-post-handler (_id action _context) + "Insert \"do\" keyword and indent the new block. +ID, ACTION, CONTEXT." + (when (eq action 'insert) + (let ((m (make-marker))) + (save-excursion + (forward-word) ;; over the "end" + (move-marker m (point))) + (save-excursion (newline)) + (save-excursion (insert " do")) + (indent-region (line-beginning-position) m) + (move-marker m nil nil)))) + +(defun sp-elixir-empty-do-block-post-handler (_id action _context) + "Insert empty \"do\" keyword and indent the new block. + +This is used for receive-do-end expression. +ID, ACTION, CONTEXT." + (when (eq action 'insert) + (let ((m (make-marker))) + (save-excursion + (forward-word) ;; over the "end" + (move-marker m (point))) + (save-excursion + (forward-line -1) + (end-of-line) + (insert " do")) + (save-excursion (newline)) + (indent-region (line-beginning-position) m) + (indent-according-to-mode) + (move-marker m nil nil)))) + +(sp-with-modes '(elixir-mode elixir-ts-mode) + (sp-local-pair "do" "end" + :when '(("SPC" "RET" "")) + :skip-match 'sp-elixir-skip-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "def" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-bodyless-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "defp" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-bodyless-defp-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "defmodule" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "defimpl" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "fn" "end" + :when '(("SPC" "RET" "")) + :post-handlers '("| ")) + (sp-local-pair "if" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "for" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-for-in-defimpl-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "cond" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "with" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "unless" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "case" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "try" "end" + :when '(("SPC" "RET" "")) + :post-handlers '(sp-elixir-do-block-post-handler) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "receive" "end" + :when '(("RET" "")) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :post-handlers '(sp-elixir-empty-do-block-post-handler)) + (sp-local-pair "quote" "end" + :when '(("RET" "")) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :post-handlers '(sp-elixir-empty-do-block-post-handler)) + (sp-local-pair "defmacro" "end" + :when '(("RET" "")) + :skip-match 'sp-elixir-skip-keyword-list-def-p + :post-handlers '(sp-elixir-empty-do-block-post-handler)) + ) + +(provide 'smartparens-elixir) +;;; smartparens-elixir.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-erlang.el b/elpa/smartparens-20230529.1017/smartparens-erlang.el new file mode 100644 index 00000000..767ecb4b --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-erlang.el @@ -0,0 +1,55 @@ +;;; smartparens-erlang.el --- Additional configuration for erlang-mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Johnny Ruiz + +;; Created: 6 September 2022 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Erlang. To use +;; it, simply add: +;; +;; (require 'smartparens-config) +;; +;; alternatively, you can explicitly load these preferences: +;; +;; (require 'smartparens-erlang) +;; +;; in your configuration. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: +(require 'smartparens) + +(declare-function erlang-mode "erlang-mode") + +(sp-with-modes 'erlang-mode + (sp-local-pair "`" "'" + :when '(sp-in-comment-p))) + +(provide 'smartparens-erlang) + +;;; smartparens-erlang.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-ess.el b/elpa/smartparens-20230529.1017/smartparens-ess.el new file mode 100644 index 00000000..9d5de2c4 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-ess.el @@ -0,0 +1,237 @@ +;;; smartparens-ess.el --- Smartparens Extension for Emacs Speaks Statistics -*- lexical-binding: t; -*- + +;; Copyright (c) 2016-2018, 2020-2021 Bernhard Pröll, Matus Goljer + +;; Author: Bernhard Pröll +;; Maintainer: Bernhard Pröll +;; URL: https://github.com/Fuco1/smartparens +;; Created: 2015-02-26 +;; Version: 0.2 +;; Keywords: abbrev convenience editing + +;; This file is NOT part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: +;; +;; This file provides some additional configuration for ESS. To use +;; it, simply add: +;; +;; (require 'smartparens-ess) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;;; Code: + +(require 'smartparens) +(require 'rx) + +(defvar ess-roxy-str) + +(declare-function ess-roxy-indent-on-newline "ess-roxy") + + +(dolist (mode '(ess-mode ess-r-mode inferior-ess-mode inferior-ess-r-mode)) + ;; avoid traveling commas when slurping + ;; (|a, b), c ---> (|a, b, c) + (add-to-list 'sp-sexp-suffix (list mode 'regexp "")) + ;; `sp-sexp-prefix' for ESS + (add-to-list 'sp-sexp-prefix + (list mode 'regexp + (rx (zero-or-more (or word (syntax symbol))))))) + +(defadvice sp-backward-kill-symbol (around sp-ess-backward-kill-symbol activate) + "#821 For the purpose of killing words and symbols, we remove +the prefix resolution because it is not necessary. We want to +treat function prefix as word or symbol to be deleted." + (let ((sp-sexp-prefix nil)) + ad-do-it)) + +;; slurping follows Google's R style guide +;; see https://google.github.io/styleguide/Rguide.xml +(defun sp-ess-pre-handler (_id action _context) + "Remove spaces before opening parenthesis in a function call. +Remove redundant space around commas. +ID, ACTION, CONTEXT." + (when (equal action 'slurp-forward) + (let ((sxp (sp-get-thing 'back))) + (save-excursion + (goto-char (sp-get sxp :beg-prf)) + ;; (|) x ---> (x) + (when (looking-back (rx (syntax open-parenthesis) + (one-or-more space)) nil) + (cycle-spacing 0 nil 'single-shot)) + (cond + ;; (|)if(cond) ---> (|if (cond)) + ((member (sp-get sxp :prefix) '("if" "for" "while")) + (goto-char (sp-get sxp :beg)) + (cycle-spacing 1 nil 'single-shot)) + ;; (|)v [,2] <- if(x > 1) ---> (v[,2] <- if (x > 1)) + ((and + (member (sp-get sxp :op) '("[" "(")) + (equal (sp-get sxp :prefix) "") + (looking-back + (rx (and (not-char "%" ",") + (not (syntax close-parenthesis))) + (one-or-more space)) nil) + (not (member + (save-excursion + (sp-backward-sexp) + (thing-at-point 'word 'noprop)) + '("if" "for" "while")))) + (cycle-spacing 0 nil 'single-shot)) + ;; (|[...])%in% ---> ([...] %in%|) + ((or (looking-at "%") (looking-back "%" nil)) + (just-one-space)) + ;; (|)a , b, c ---> (|a, b, c) + ((looking-back + (rx (zero-or-more space) "," (zero-or-more space)) + (line-beginning-position) 'greedy) + (replace-match ", ")))))) + (when (equal action 'slurp-backward) + (let ((sxp (sp-get-thing))) + (save-excursion + (goto-char (sp-get sxp :end)) + ;; x (|) ---> (x) + (when (looking-at (rx (one-or-more space) + (syntax close-parenthesis))) + (cycle-spacing 0 nil 'single-shot)) + ;; if(cond){} (|) ---> (if (cond) {}|) + (cond ((member (sp-get sxp :prefix) '("if" "for" "while")) + (goto-char (sp-get sxp :beg)) + (cycle-spacing 1 nil 'single-shot)) + ;; for style reasons there should be a space before curly + ;; brackets and binary operators + ((and (member (sp-get sxp :op) '("{" "%")) + (not (looking-at (rx (syntax close-parenthesis))))) + (cycle-spacing 1 nil 'single-shot)) + ;; v[2](|) ---> (v[2]|) + ((and + (not (member (thing-at-point 'word 'noprop) + '("if" "for" "while"))) + (looking-at + (rx (and (zero-or-more space) + (not-char "{") + (or (syntax close-parenthesis) + (char "(") + (char "[")))))) + (cycle-spacing 0 nil 'single-shot)) + ;; 1 , 2 (|) ---> (1, 2) + ((looking-at + (rx (zero-or-more space) "," (zero-or-more space))) + (replace-match ", "))))))) + +;; function(x) {|} ---> function(x) {\n|\n} +;; ##' \tabular{rrr}{|} ---> +;; ##' \tabular{rrr}{ +;; ##' | +;; ##' } +(defun sp-ess-open-sexp-indent (&rest _args) + "Open new brace or bracket with indentation. +ARGS." + (if (and (fboundp 'ess-roxy-entry-p) (ess-roxy-entry-p)) + (progn + (save-excursion (ess-roxy-indent-on-newline)) + (when (looking-back ess-roxy-str nil) + (cycle-spacing 3 nil t))) + (newline) + (indent-according-to-mode) + (forward-line -1) + (indent-according-to-mode))) + +(defun sp-ess-roxy-str-p (_id action _context) + "Test if looking back at `ess-roxy-re'. +ID, ACTION, CONTEXT." + (when (and (bound-and-true-p ess-roxy-re) (eq action 'insert)) + (sp--looking-back-p ess-roxy-re))) + +(sp-with-modes 'ess-mode + (sp-local-pair "{" nil + :pre-handlers '(sp-ess-pre-handler) + ;; the more reasonable C-j interferes with default binding for + ;; `ess-eval-line' + :post-handlers '((sp-ess-open-sexp-indent "M-j"))) + (sp-local-pair "(" nil + :pre-handlers '(sp-ess-pre-handler) + :post-handlers '((sp-ess-open-sexp-indent "M-j"))) + (sp-local-pair "[" nil + :pre-handlers '(sp-ess-pre-handler) + :post-handlers '((sp-ess-open-sexp-indent "M-j"))) + (sp-local-pair "'" nil + :unless '(sp-ess-roxy-str-p sp-in-comment-p sp-in-string-quotes-p))) + +;;; roxygen2 markup +;; see https://cran.r-project.org/web/packages/roxygen2/vignettes/formatting.html +(sp-with-modes 'ess-mode + (sp-local-pair "\\strong{" "}" + :when '(sp-in-comment-p) + :trigger "\\strong") + (sp-local-pair "\\emph{" "}" + :when '(sp-in-comment-p) + :trigger "\\emph") + (sp-local-pair "\\code{" "}" + :when '(sp-in-comment-p) + :trigger "\\code") + (sp-local-pair "\\url{" "}" + :when '(sp-in-comment-p) + :trigger "\\url") + (sp-local-pair "\\link{" "}" + :when '(sp-in-comment-p) + :trigger "\\link") + (sp-local-pair "\\href{" "}" + :when '(sp-in-comment-p) + :trigger "\\href" + :suffix "{[^}]*}") + (sp-local-pair "\\email{" "}" + :when '(sp-in-comment-p) + :trigger "\\email") + (sp-local-pair "\\pkg{" "}" + :when '(sp-in-comment-p) + :trigger "\\pkg") + (sp-local-pair "\\item{" "}" + :when '(sp-in-comment-p) + :post-handlers '((sp-ess-open-sexp-indent "M-j")) + :trigger "\\item{") + (sp-local-pair "\\enumerate{" "}" + :when '(sp-in-comment-p) + :post-handlers '((sp-ess-open-sexp-indent "M-j")) + :trigger "\\enumerate") + (sp-local-pair "\\itemize{" "}" + :when '(sp-in-comment-p) + :post-handlers '((sp-ess-open-sexp-indent "M-j")) + :trigger "\\itemize") + (sp-local-pair "\\describe{" "}" + :when '(sp-in-comment-p) + :post-handlers '((sp-ess-open-sexp-indent "M-j")) + :trigger "\\describe") + (sp-local-pair "\\eqn{" "}" + :when '(sp-in-comment-p) + :trigger "\\eqn") + (sp-local-pair "\\deqn{" "}" + :when '(sp-in-comment-p) + :trigger "\\deqn") + (sp-local-pair "\\tabular{" "}" + :when '(sp-in-comment-p) + :trigger "\\tabular" + :post-handlers '((sp-ess-open-sexp-indent "M-j")) + :suffix "{[^}]*}")) + +(sp-with-modes '(ess-r-mode inferior-ess-r-mode) + (sp-local-pair "\\(" nil + :unless '(:add sp-in-code-p))) + +(provide 'smartparens-ess) +;;; smartparens-ess ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-go.el b/elpa/smartparens-20230529.1017/smartparens-go.el new file mode 100644 index 00000000..7479a4cc --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-go.el @@ -0,0 +1,60 @@ +;;; smartparens-go.el --- Additional configuration for go-mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Jimmy Yuen Ho Wong + +;; Created: 10 June 2022 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Go. To use +;; it, simply add: +;; +;; (require 'smartparens-config) +;; +;; alternatively, you can explicitly load these preferences: +;; +;; (require 'smartparens-go) +;; +;; in your configuration. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: +(require 'smartparens) + +(declare-function go-mode "go-mode") + +(sp-with-modes 'go-mode + (sp-local-pair "{" nil :post-handlers '(("||\n[i]" "RET"))) + (sp-local-pair "/*" "*/" :post-handlers '(("| " "SPC") + ("* ||\n[i]" "RET")))) + +;; Go has no sexp suffices. This fixes slurping +;; (|foo).bar -> (foo.bar) +(add-to-list 'sp-sexp-suffix (list #'go-mode 'regexp "")) + +(provide 'smartparens-go) + +;;; smartparens-go.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-haskell.el b/elpa/smartparens-20230529.1017/smartparens-haskell.el new file mode 100644 index 00000000..0e229510 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-haskell.el @@ -0,0 +1,113 @@ +;;; smartparens-haskell.el --- Additional configuration for Haskell based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015, 2017-2018 Michael Xavier, Matus Goljer + +;; Author: Michael Xavier +;; Maintainer: Michael Xavier +;; Created: 29 Apr 2016 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Haskell based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-haskell) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: +(require 'smartparens) + +(defun sp-haskell-skip-apostrophe (_ms mb _me) + (save-excursion + ;; We test the syntax class because haskell mode overrides + ;; the class for ' on the fly when it run the syntax pass of + ;; font-lock... so that if '' is a valid string (char) it + ;; gets an override via 'syntax-table property. In which + ;; case we just agree with haskell mode and let it be used as + ;; a pair. + (not (eq (syntax-class (syntax-after mb)) 7)))) + +(defun sp-haskell-strict-ignore-apostrophe-after-word (_id action _context) + "Ignore trailing ' when navigating. + +Because ' in haskell is symbol class it gets picked up as part of +a words such as myFunction', and then strict mode won't allow us +to delete it. Also show-smartparens-mode incorrectly highlights +it as missing an opener. + +So we ignore that pair when at the end of word." + (when (eq action 'navigate) + (sp--looking-back-p (concat "\\(\\sw\\|\\s_\\)'+")))) + +(sp-with-modes '(haskell-mode haskell-interactive-mode) + (sp-local-pair "{-" "-}") + (sp-local-pair "{-#" "#-}") + (sp-local-pair "{-@" "@-}") + (sp-local-pair "'" nil + :unless '(sp-point-after-word-p + sp-haskell-strict-ignore-apostrophe-after-word) + :skip-match 'sp-haskell-skip-apostrophe) + (sp-local-pair "\\(" nil :actions nil)) + +(defun sp--inferior-haskell-mode-backward-bound-fn () + "Limit the backward search to the prompt if point is on prompt." + (-when-let (limit (cond ((bound-and-true-p comint-last-prompt) + (marker-position (cdr comint-last-prompt))) + ((bound-and-true-p comint-last-prompt-overlay) + (overlay-end comint-last-prompt-overlay)) + (t nil))) + (and (> (point) limit) limit))) + +(defun sp--inferior-haskell-mode-forward-bound-fn () + "Limit the forward search to exclude the prompt if point is before prompt." + (-when-let (limit (cond ((bound-and-true-p comint-last-prompt) + (marker-position (car comint-last-prompt))) + ((bound-and-true-p comint-last-prompt-overlay) + (overlay-start comint-last-prompt-overlay)) + (t nil))) + (and (< (point) limit) limit))) + +(defun sp--setup-inferior-haskell-mode-search-bounds () + "Setup the search bound. + +If the point is after the last prompt, limit the backward search +only for the propmt. + +If the point is before the last prompt, limit the forward search up until the prompt start." + (setq sp-forward-bound-fn 'sp--inferior-haskell-mode-forward-bound-fn) + (setq sp-backward-bound-fn 'sp--inferior-haskell-mode-backward-bound-fn)) + +(add-hook 'inferior-haskell-mode-hook 'sp--setup-inferior-haskell-mode-search-bounds) + +(provide 'smartparens-haskell) + +;;; smartparens-haskell.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-html.el b/elpa/smartparens-20230529.1017/smartparens-html.el new file mode 100644 index 00000000..6f7549f6 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-html.el @@ -0,0 +1,173 @@ +;;; smartparens-html.el --- Additional configuration for HTML based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2014, 2017-2018 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 14 Sep 2013 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for HTML based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-html) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. + +;; This file provides these interactive functions: + +;; `sp-html-next-tag' - Recommended binding: C-c C-f +;; `sp-html-previous-tag' - Recommended binding: C-c C-b +;; +;; (These two bindings are used for navigation by tags forward or +;; backward, but `sp-forward-sexp' already does that.) + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defun sp-html-next-tag (arg) + "Move point to the beginning of next SGML tag. + +With ARG positive N > 1, move N tags forward. + +With ARG raw prefix argument \\[universal-argument] move out of +the current tag and to the beginning of enclosing tag. + +Note: this function is based on `sp-beginning-of-sexp' but +specialized to only work with SGML tags and to always move +forward." + (interactive "P") + (let ((sp-prefix-tag-object t)) + (if (sp--raw-argument-p arg) + (sp-beginning-of-sexp arg) + (sp-beginning-of-sexp (1+ (prefix-numeric-value arg)))))) + +(defun sp-html-previous-tag (arg) + "Move point to the beginning of previous SGML tag. + +With ARG positive N > 1, move N tags backward. + +With ARG raw prefix argument \\[universal-argument] move out of +the current tag and to the beginning of enclosing tag. + +Note: this function is based on `sp-beginning-of-sexp' but +specialized to only work with SGML tags and to always move +backward." + (interactive "P") + (let ((sp-prefix-tag-object t)) + (if (sp--raw-argument-p arg) + (sp-beginning-of-sexp arg) + (sp-beginning-of-sexp (1- (- (prefix-numeric-value arg))))))) + +(defun sp-html-post-handler (&optional _id action _context) + "Post-action hooks for `html-mode'. + +ID is the tag being processed, ACTION is the action and CONTEXT +specifies if we are inside a string or code." + (cl-case action + (slurp-forward + (save-excursion + (let ((sp-prefix-pair-object t)) + (sp-backward-sexp)) + (-when-let (enc (sp-get-enclosing-sexp)) + (sp-get enc + (goto-char :beg-in) + (when (looking-at-p "[ \t]*$") + (goto-char :end-in) + (save-excursion + (sp-backward-sexp) + (forward-line -1) + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (1+ (line-end-position))))) + (newline-and-indent)))))) + (slurp-backward + (save-excursion + (-when-let (enc (sp-get-enclosing-sexp)) + (sp-get enc + (goto-char :end-in) + (when (sp--looking-back-p "^[ \t]*") + (save-excursion + (goto-char :beg-in) + (newline-and-indent) + (sp-forward-sexp) + (forward-line) + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (1+ (line-end-position)))))))))) + (barf-forward + (save-excursion + (let ((sp-prefix-pair-object t)) + (sp-backward-sexp)) + (-when-let (enc (sp-get-enclosing-sexp)) + (sp-get enc + (goto-char :beg-in) + (when (looking-at-p "[ \t]*$") + (goto-char :end-in) + (newline-and-indent))))) + (save-excursion + (sp-forward-sexp) + (forward-line) + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (1+ (line-end-position)))))) + (barf-backward + (save-excursion + (-when-let (enc (sp-get-enclosing-sexp)) + (sp-get enc + (goto-char :end-in) + (when (sp--looking-back-p "^[ \t]*") + (goto-char :beg-in) + (newline-and-indent) + (sp-backward-up-sexp) + (sp-backward-sexp) + (forward-line -1) + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (1+ (line-end-position))))))))) + (beginning-of-sexp + (when (looking-at-p "[ \t]*$") + (sp-next-sexp))) + (end-of-sexp + (when (sp--looking-back-p "^[ \t]*" nil t) + (sp-previous-sexp))))) + +(sp-with-modes sp--html-modes + (sp-local-pair "<" ">") + (sp-local-tag "<" "<_>" "" :transform 'sp-match-sgml-tags :post-handlers '(sp-html-post-handler))) + +(--each sp--html-modes + (add-to-list 'sp-navigate-consider-sgml-tags it)) + +(--each '(web-mode) + (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) + +(provide 'smartparens-html) + +;;; smartparens-html.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-javascript.el b/elpa/smartparens-20230529.1017/smartparens-javascript.el new file mode 100644 index 00000000..95e6e5dc --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-javascript.el @@ -0,0 +1,55 @@ +;;; smartparens-javascript.el --- Additional configuration for JavaScript based modes. -*- lexical-binding: t; -*- + +;; Copyright (c) 2017-2019 Marinin Tim +;; Author: Tim Marinin +;; Maintainer: Tim Marinin +;; Created: 2017-03-03 +;; Keywords: abbrev convenience editing javascript +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for JavaScript based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-javascript) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +;; (|sys).path.append---the dot should not travel with the closing +;; paren +(--each '(js-mode javascript-mode js2-mode typescript-mode rjsx-mode) + (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) + +(provide 'smartparens-javascript) +;;; smartparens-javascript.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-latex.el b/elpa/smartparens-20230529.1017/smartparens-latex.el new file mode 100644 index 00000000..339f2d20 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-latex.el @@ -0,0 +1,192 @@ +;;; smartparens-latex.el --- Additional configuration for (La)TeX based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2019 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 14 Feb 2013 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for (La)TeX based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-latex) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defun sp-latex-insert-spaces-inside-pair (_id action _context) + "ID, ACTION, CONTEXT." + (when (eq action 'insert) + (insert " ") + (backward-char 1)) + (when (and (eq action 'wrap) + (save-excursion + (goto-char (sp-get sp-last-wrapped-region :beg-in)) + (not (sp--looking-back-p "[[{(]")))) + (save-excursion + (goto-char (sp-get sp-last-wrapped-region :end-in)) + (insert " ") + (goto-char (sp-get sp-last-wrapped-region :beg-in)) + (insert " ")))) + +(defun sp-latex-skip-match-apostrophe (ms _mb me) + "MS, MB, ME." + (when (equal ms "'") + (save-excursion + (goto-char me) + (looking-at-p "\\sw")))) + +(defun sp-latex-skip-double-quote (_id action _context) + "ID, ACTION, CONTEXT." + (when (eq action 'insert) + (when (looking-at-p "''''") + (delete-char -2) + (delete-char 2) + (forward-char 2)))) + +(defun sp-latex-point-after-backslash (id action _context) + "Return t if point follows a backslash, nil otherwise. +This predicate is only tested on \"insert\" action. +ID, ACTION, CONTEXT." + (when (eq action 'insert) + (let ((trigger (sp-get-pair id :trigger))) + (looking-back (concat "\\\\" (regexp-quote (if trigger trigger id))) nil)))) + +(add-to-list 'sp-navigate-skip-match + '((tex-mode plain-tex-mode latex-mode) . sp--backslash-skip-match)) + +(sp-with-modes '( + tex-mode + plain-tex-mode + latex-mode + LaTeX-mode + ) + (sp-local-pair "`" "'" + :actions '(:rem autoskip) + :skip-match 'sp-latex-skip-match-apostrophe + :unless '(sp-latex-point-after-backslash sp-in-math-p)) + ;; math modes, yay. The :actions are provided automatically if + ;; these pairs do not have global definitions. + (sp-local-pair "$" "$") + (sp-local-pair "\\[" "\\]" + :unless '(sp-latex-point-after-backslash)) + + ;; disable useless pairs. + (sp-local-pair "\\\\(" nil :actions nil) + (sp-local-pair "'" nil :actions nil) + (sp-local-pair "\\\"" nil :actions nil) + + ;; quote should insert ``'' instead of double quotes. If we ever + ;; need to insert ", C-q is our friend. + (sp-local-pair "``" "''" + :trigger "\"" + :unless '(sp-latex-point-after-backslash sp-in-math-p) + :post-handlers '(sp-latex-skip-double-quote)) + + ;; add the prefix function sticking to {} pair + (sp-local-pair "{" nil :prefix "\\\\\\(\\sw\\|\\s_\\)*") + + ;; do not add more space when slurping + (sp-local-pair "{" "}") + (sp-local-pair "(" ")") + (sp-local-pair "[" "]") + + ;; pairs for big brackets. Needs more research on what pairs are + ;; useful to add here. Post suggestions if you know some. + (sp-local-pair "\\left(" "\\right)" + :trigger "\\l(" + :when '(sp-in-math-p) + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\left[" "\\right]" + :trigger "\\l[" + :when '(sp-in-math-p) + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\left\\{" "\\right\\}" + :trigger "\\l{" + :when '(sp-in-math-p) + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\left|" "\\right|" + :trigger "\\l|" + :when '(sp-in-math-p) + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\bigl(" "\\bigr)" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\biggl(" "\\biggr)" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Bigl(" "\\Bigr)" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Biggl(" "\\Biggr)" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\bigl[" "\\bigr]" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\biggl[" "\\biggr]" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Bigl[" "\\Bigr]" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Biggl[" "\\Biggr]" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\bigl\\{" "\\bigr\\}" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\biggl\\{" "\\biggr\\}" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Bigl\\{" "\\Bigr\\}" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\Biggl\\{" "\\Biggr\\}" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\lfloor" "\\rfloor" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\lceil" "\\rceil" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\langle" "\\rangle" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\lVert" "\\rVert" + :when '(sp-in-math-p) + :trigger "\\lVert" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + (sp-local-pair "\\lvert" "\\rvert" + :when '(sp-in-math-p) + :trigger "\\lvert" + :post-handlers '(sp-latex-insert-spaces-inside-pair)) + + ;; some common wrappings + (sp-local-tag "\"" "``" "''" :actions '(wrap)) + (sp-local-tag "\\b" "\\begin{_}" "\\end{_}") + (sp-local-tag "bi" "\\begin{itemize}" "\\end{itemize}") + (sp-local-tag "be" "\\begin{enumerate}" "\\end{enumerate}")) + +(provide 'smartparens-latex) + +;;; smartparens-latex.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-lua.el b/elpa/smartparens-20230529.1017/smartparens-lua.el new file mode 100644 index 00000000..0b7512a3 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-lua.el @@ -0,0 +1,90 @@ +;;; smartparens-lua.el --- Additional configuration for Lua based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2014, 2016-2018 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 3 August 2013 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Lua based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-lua) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defun sp-lua-post-keyword-insert (id action _context) + "ID, ACTION, CONTEXT." + (cond + ((eq action 'insert) + (cond + ((member id '("while" "for")) + (insert " do") + (save-excursion (newline-and-indent)) + (backward-char 3)) + ((equal id "if") + (insert " then") + (save-excursion (newline-and-indent)) + (backward-char 5)) + ((equal id "function") + (save-excursion (newline-and-indent)) + (insert " ")))))) + +;; all the pairs are expanded only if followed by "SPC" event. This +;; will reduce false positives like 'dIFficult' to trigger. +(sp-with-modes '(lua-mode) + (sp-local-pair "if" "end" + :when '(("SPC")) + :unless '(sp-in-comment-p sp-in-string-p) + :post-handlers '(sp-lua-post-keyword-insert)) + (sp-local-pair "function" "end" + :when '(("SPC")) + :unless '(sp-in-comment-p sp-in-string-p) + :post-handlers '(sp-lua-post-keyword-insert)) + (sp-local-pair "for" "end" + :when '(("SPC")) + :unless '(sp-in-comment-p sp-in-string-p) + :post-handlers '(sp-lua-post-keyword-insert)) + (sp-local-pair "while" "end" + :when '(("SPC")) + :unless '(sp-in-comment-p sp-in-string-p) + :post-handlers '(sp-lua-post-keyword-insert)) + ) + +(provide 'smartparens-lua) + +;;; smartparens-lua.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-markdown.el b/elpa/smartparens-20230529.1017/smartparens-markdown.el new file mode 100644 index 00000000..772dc331 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-markdown.el @@ -0,0 +1,88 @@ +;;; smartparens-markdown.el --- Additional configuration for Markdown based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 11th May 2017 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Markdown based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-markdown) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) +(require 'smartparens-text) +(eval-when-compile + (defvar markdown-gfm-use-electric-backquote)) + + +(defun sp-gfm-electric-backquote-p (_id action _context) + "Do not insert ```...``` pair if that would be handled by `markdown-electric-backquote'." + (and (eq action 'insert) + markdown-gfm-use-electric-backquote + (sp--looking-back-p "^```"))) + +(defun sp--gfm-point-after-word-p (id action _context) + "Return t if point is after a word, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-back-p (concat "\\(\\sw\\)" (regexp-quote id))))) + +(defun sp--gfm-skip-asterisk (_ms mb _me) + "Non-nil if we should ignore this asterisk as a delimiter." + (save-excursion + (goto-char mb) + (save-match-data (looking-at "^\\* ")))) + +(sp-with-modes '(markdown-mode gfm-mode) + (sp-local-pair "*" "*" + :unless '(sp--gfm-point-after-word-p sp-point-at-bol-p) + :post-handlers '(("[d1]" "SPC")) + :skip-match 'sp--gfm-skip-asterisk) + (sp-local-pair "**" "**") + (sp-local-pair "_" "_" :unless '(sp-point-after-word-p))) + +(sp-with-modes 'markdown-mode + (sp-local-pair "```" "```")) + +(sp-with-modes 'gfm-mode + (sp-local-pair "`" "`" :unless '(:add sp-gfm-electric-backquote-p)) + (sp-local-pair "```" "```" :unless '(:add sp-gfm-electric-backquote-p))) + +(provide 'smartparens-markdown) +;;; smartparens-markdown.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-ml.el b/elpa/smartparens-20230529.1017/smartparens-ml.el new file mode 100644 index 00000000..a03c1062 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-ml.el @@ -0,0 +1,80 @@ +;;; smartparens-ml.el --- Additional configuration for ML languages -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2019 Ta Quang Trung +;; Copyright (C) 2017, 2022 Matus Goljer + +;; Author: Ta Quang Trung +;; Matus Goljer +;; Louis Roché +;; Maintainer: Matus Goljer +;; Created: 14 July 2016 +;; Keywords: smartparens, ML, ocaml, reason +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for ML languages. +;; To use it, simply add: +;; +;; (require 'smartparens-ml) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +;;; Local pairs for ML-family languages + +(sp-with-modes '(fsharp-mode) + (sp-local-pair "(*" "*)" )) + +(sp-with-modes '(tuareg-mode) + ;; Disable ` because it is used in polymorphic variants + (sp-local-pair "`" nil :actions nil) + ;; Disable ' because it is used in value names and types + (sp-local-pair "'" nil :actions nil) + (sp-local-pair "{|" "|}" ) ;; multi-line string + (sp-local-pair "[|" "|]" ) ;; array + (sp-local-pair "sig" "end" ) ;; signature + (sp-local-pair "struct" "end" ) ;; module + (sp-local-pair "(*" "*)" )) ;; comment + +;; Ignore punctuation, so we can split ~(foo) to ~foo. +(add-to-list 'sp-sexp-prefix (list 'tuareg-mode 'syntax "")) + +(sp-with-modes '(reason-mode) + ;; Disable ` because it is used in polymorphic variants + (sp-local-pair "`" nil :actions nil) + ;; Disable ' because it is used in value names and types + (sp-local-pair "'" nil :actions nil) + (sp-local-pair "/*" "*/" )) + +(provide 'smartparens-ml) +;;; smartparens-ml.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-org.el b/elpa/smartparens-20230529.1017/smartparens-org.el new file mode 100644 index 00000000..8b864b1d --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-org.el @@ -0,0 +1,72 @@ +;;; smartparens-org.el --- Configuration for Org mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2019 Matúš Goljer + +;; Author: Matúš Goljer +;; Maintainer: Matúš Goljer +;; Version: 0.0.1 +;; Created: 15th January 2017 +;; Keywords: languages + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Org based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-org) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) +(require 'smartparens-text) + +(defun sp--org-skip-asterisk (_ms mb me) + "Non-nil if the asterisk is part of the outline marker." + (save-excursion + (goto-char mb) + (beginning-of-line) + (let ((skip-distance (skip-chars-forward "*"))) + (if (= skip-distance 1) + (not (memq (syntax-class (syntax-after (point))) '(2 3))) + (<= me (point)))))) + +(defun sp-org-point-after-left-square-bracket-p (id action _context) + "Return t if point is after a left square bracket, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-back-p (concat "\\[" (regexp-quote id))))) + +(sp-with-modes 'org-mode + (sp-local-pair "*" "*" + :unless '(sp-point-after-word-p sp-point-at-bol-p) + :skip-match 'sp--org-skip-asterisk) + (sp-local-pair "_" "_" :unless '(sp-point-after-word-p)) + (sp-local-pair "/" "/" :unless '(sp-point-after-word-p sp-org-point-after-left-square-bracket-p) :post-handlers '(("[d1]" "SPC"))) + (sp-local-pair "~" "~" :unless '(sp-point-after-word-p) :post-handlers '(("[d1]" "SPC"))) + (sp-local-pair "=" "=" :unless '(sp-point-after-word-p) :post-handlers '(("[d1]" "SPC"))) + (sp-local-pair "«" "»")) + +(provide 'smartparens-org) +;;; smartparens-org.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-pkg.el b/elpa/smartparens-20230529.1017/smartparens-pkg.el new file mode 100644 index 00000000..14574d7b --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-pkg.el @@ -0,0 +1,13 @@ +(define-package "smartparens" "20230529.1017" "Automatic insertion, wrapping and paredit-like navigation with user defined pairs." + '((dash "2.13.0") + (cl-lib "0.3")) + :commit "79a338db115f441cd47bb91e6f75816c5e78a772" :authors + '(("Matus Goljer" . "matus.goljer@gmail.com")) + :maintainer + '("Matus Goljer" . "matus.goljer@gmail.com") + :keywords + '("abbrev" "convenience" "editing") + :url "https://github.com/Fuco1/smartparens") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/smartparens-20230529.1017/smartparens-python.el b/elpa/smartparens-20230529.1017/smartparens-python.el new file mode 100644 index 00000000..dbe63338 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-python.el @@ -0,0 +1,133 @@ +;;; smartparens-python.el --- Additional configuration for Python based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2018, 2020, 2022-2023 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 8 February 2015 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Python based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-python) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defgroup smartparens-python () + "smartparens settings for python-mode" + :group 'smartparens) + +(defcustom sp-python-insert-colon-in-function-definitions nil + "If non-nil, auto-insert a colon after parens insertion in definition. + +Supported definitions are: + +- def +- async def +- class" + :group 'smartparens-python + :type 'boolean) + +;; Python has no sexp suffices. This fixes slurping +;; (|sys).path.append---the dot should not travel with the closing +;; paren +(--each '(python-mode inferior-python-mode) + (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) + +(defun sp-python-maybe-add-colon-python (_id action _context) + "Adds a colon after parentheses in a python definition. + +Works for (async) def forms and class forms. + +See also the option `sp-python-insert-colon-in-function-definitions'." + ;; here, caret supposed to be in between parens, i.e. (|) + (when (and sp-python-insert-colon-in-function-definitions + (eq action 'insert) + (looking-at ")\\s-*$") + (save-excursion + (goto-char (line-beginning-position)) + (re-search-forward + (rx bol + (* (syntax whitespace)) + (? "async") + (* (syntax whitespace)) + (or "def" "class") + word-boundary) + (line-end-position) + t))) + (save-excursion + (forward-char) ;; skip closing paren + (insert ":")))) + +(sp-with-modes 'python-mode + (sp-local-pair "'" "'" :unless '(sp-in-comment-p sp-in-string-quotes-p) :post-handlers '(:add sp-python-fix-tripple-quotes)) + (sp-local-pair "\"" "\"" :post-handlers '(:add sp-python-fix-tripple-quotes)) + (sp-local-pair "'''" "'''") + (sp-local-pair "\\'" "\\'") + (sp-local-pair "\"\"\"" "\"\"\"") + (sp-local-pair "(" ")" :post-handlers '(:add sp-python-maybe-add-colon-python))) + +(defun sp-python-fix-tripple-quotes (id action _context) + "Properly rewrap tripple quote pairs. + +When the user rewraps a tripple quote pair to the other pair +type (i.e. ''' to \") we check if the old pair was a +tripple-quote pair and if so add two pairs to beg/end of the +newly formed pair (which was a single-quote \"...\" pair)." + (when (eq action 'rewrap-sexp) + (let ((old (plist-get sp-handler-context :parent))) + (when (or (and (equal old "'''") (equal id "\"")) + (and (equal old "\"\"\"") (equal id "'"))) + (save-excursion + (sp-get sp-last-wrapped-region + (goto-char :end-in) + (insert (make-string 2 (aref id 0))) + (goto-char :beg) + (insert (make-string 2 (aref id 0))))))))) + +(defadvice python-indent-dedent-line-backspace + (around sp-backward-delete-char-advice activate) + "Fix indend." + (if smartparens-strict-mode + (cl-letf (((symbol-function 'delete-backward-char) + (lambda (arg &optional killp) + (sp-backward-delete-char arg)))) + ad-do-it) + ad-do-it)) + +(provide 'smartparens-python) +;;; smartparens-python.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-racket.el b/elpa/smartparens-20230529.1017/smartparens-racket.el new file mode 100644 index 00000000..903a7e38 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-racket.el @@ -0,0 +1,56 @@ +;;; smartparens-racket.el --- Additional configuration for Racket based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015, 2018 Vikraman Choudhury + +;; Author: Vikraman Choudhury +;; Maintainer: Vikraman Choudhury +;; Created: 26 Oct 2015 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Racket based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-racket) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(sp-with-modes '(racket-mode racket-repl-mode) + (sp-local-pair "`" nil :actions nil) + (sp-local-pair "'" nil :actions nil) + (sp-local-pair "#|" "|#")) + +(provide 'smartparens-racket) +;;; smartparens-racket.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-rst.el b/elpa/smartparens-20230529.1017/smartparens-rst.el new file mode 100644 index 00000000..650607f0 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-rst.el @@ -0,0 +1,66 @@ +;;; smartparens-rst.el --- Additional configuration for rst based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2019-2020 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 28th January 2019 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for rst based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-rst) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) +(require 'smartparens-text) +(require 'smartparens-markdown) + +(defun sp-rst-point-after-backtick (_id action _context) + (when (eq action 'insert) + (sp--looking-back-p "`_"))) + +(sp-with-modes 'rst-mode + (sp-local-pair "*" "*" + :unless '(sp--gfm-point-after-word-p sp-point-at-bol-p) + :post-handlers '(("[d1]" "SPC")) + :skip-match 'sp--gfm-skip-asterisk) + (sp-local-pair "**" "**") + (sp-local-pair "_" "_" :unless '(sp-point-after-word-p sp-rst-point-after-backtick)) + (sp-local-pair "``" "``")) + +(provide 'smartparens-rst) +;;; smartparens-rst.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-ruby.el b/elpa/smartparens-20230529.1017/smartparens-ruby.el new file mode 100644 index 00000000..237eea90 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-ruby.el @@ -0,0 +1,412 @@ +;;; smartparens-ruby.el --- Additional configuration for Ruby based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2014, 2016-2018, 2020, 2023 Jean-Louis Giordano, Matus Goljer + +;; Author: Jean-Louis Giordano +;; Maintainer: Matus Goljer +;; Created: 16 June 2013 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Ruby based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-ruby) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(declare-function enh-ruby-forward-sexp "ruby") +(declare-function ruby-forward-sexp "ruby") +(declare-function enh-ruby-backward-sexp "ruby") +(declare-function ruby-backward-sexp "ruby") + +(defun sp-ruby-forward-sexp () + "Wrapper for `ruby-forward-sexp' based on `enh-ruby-mode'." + (interactive) + (if (boundp 'enh-ruby-forward-sexp) + (enh-ruby-forward-sexp) + (ruby-forward-sexp))) + +(defun sp-ruby-backward-sexp () + "Wrapper for `ruby-backward-sexp' based on `enh-ruby-mode'." + (interactive) + (if (boundp 'enh-ruby-backward-sexp) + (enh-ruby-backward-sexp) + (ruby-backward-sexp))) + +(defun sp-ruby-maybe-one-space () + "Turn whitespace around point to just one space." + (while (looking-back " " nil) (backward-char)) + (when (or (looking-at-p " ") + (looking-at-p "}") + (looking-back "{" nil) + (and (looking-at-p "\\sw") + (looking-back ":" nil))) + (save-excursion (just-one-space))) + (when (and (not (looking-back "^.?" nil)) + (save-excursion + (backward-char 2) + (or (looking-at-p ".[^:] [.([,;]") + (looking-at-p ".. ::") + (looking-at-p ".[.@$] ") + (looking-at-p ":: ")))) + (delete-char 1))) + +(defun sp-ruby-delete-indentation (&optional arg) + "Better way of joining ruby lines. + +ARG is how many indentation to delete." + (delete-indentation arg) + (sp-ruby-maybe-one-space)) + +(defun sp-ruby-block-post-handler (id action context) + "Handler for ruby block-like insertions. +ID, ACTION, CONTEXT." + (when (equal action 'insert) + (save-excursion + (newline) + (indent-according-to-mode)) + (indent-according-to-mode)) + (sp-ruby-post-handler id action context)) + +(defun sp-ruby-def-post-handler (id action context) + "Handler for ruby def-like insertions. +ID, ACTION, CONTEXT." + (when (equal action 'insert) + (save-excursion + (insert "x") + (newline) + (indent-according-to-mode)) + (delete-char 1)) + (sp-ruby-post-handler id action context)) + +(defun sp-ruby-post-handler (_id action _context) + "Ruby post handler. +ID, ACTION, CONTEXT." + (-let (((&plist :arg arg :enc enc) sp-handler-context)) + (when (equal action 'barf-backward) + (goto-char (sp-get enc :beg)) + (sp-ruby-delete-indentation 1) + (indent-according-to-mode) + (save-excursion + (sp-backward-sexp) ; move to begining of current sexp + (sp-backward-sexp arg) + (sp-ruby-maybe-one-space))) + + (when (equal action 'barf-forward) + (sp-get enc + (let ((beg-line (line-number-at-pos :beg-in))) + (sp-forward-sexp arg) + (sp-ruby-maybe-one-space) + (when (not (= (line-number-at-pos) beg-line)) + (sp-ruby-delete-indentation -1)) + (indent-according-to-mode)))))) + +(defun sp-ruby-pre-handler (_id action _context) + "Handler for ruby slurp and barf. +ID, ACTION, CONTEXT." + (let ((enc (plist-get sp-handler-context :enc))) + (sp-get enc + (let ((beg-line (line-number-at-pos :beg-in)) + (end-line (line-number-at-pos :end-in))) + + (when (equal action 'slurp-backward) + (save-excursion + (sp-forward-sexp) + (when (looking-at-p ";") (forward-char)) + (sp-ruby-maybe-one-space) + (when (not (= (line-number-at-pos) end-line)) + (sp-ruby-delete-indentation -1))) + (when (looking-at-p "::") + (while (and (looking-back "\\sw" nil) + (--when-let (sp-get-symbol t) + (sp-get it (goto-char :beg-prf)))))) + (while (thing-at-point-looking-at "\\.[[:blank:]\n]*") + (sp-backward-sexp)) + (when (looking-back "[@$:&?!]" nil) + (backward-char) + (when (looking-back "[@&:]" nil) + (backward-char))) + (just-one-space) + (save-excursion + (if (= (line-number-at-pos) end-line) + (insert " ") + (newline)))) + + (when (equal action 'barf-backward) + ;; Barf whole method chains + (while (thing-at-point-looking-at "[(.:[][\n[:blank:]]*") + (sp-forward-sexp)) + (if (looking-at-p " *$") + (newline) + (save-excursion (newline)))) + + (when (equal action 'slurp-forward) + (save-excursion + (sp-backward-sexp) + (when (looking-back "\." nil) (backward-char)) + (sp-ruby-maybe-one-space) + (when (not (= (line-number-at-pos) beg-line)) + (if (thing-at-point-looking-at "\\.[[:blank:]\n]*") + (progn + (forward-symbol -1) + (sp-ruby-delete-indentation -1)) + (sp-ruby-delete-indentation)))) + (while (looking-at-p "::") (sp-forward-symbol)) + (when (looking-at-p "[?!;]") (forward-char)) + (if (= (line-number-at-pos) beg-line) + (insert " ") + (newline))) + + (when (equal action 'barf-forward) + (when (looking-back "\\." nil) (backward-char)) + (when (looking-at-p "::") + (while (and (looking-back "\\sw" nil) + (--when-let (sp-get-symbol t) + (sp-get it (goto-char :beg-prf)))))) + (if (= (line-number-at-pos) end-line) + (insert " ") + (if (looking-back "^[[:blank:]]*" nil) + (save-excursion (newline)) + (newline)))))))) + +(defun sp-ruby-inline-p (id) + "Test if ID is inline." + (save-excursion + (when (looking-back id nil) + (backward-word)) + (when (not (or (looking-back "^[[:blank:]]*" nil) + (looking-back "= *" nil))) + (or (save-excursion + (forward-symbol -1) + (forward-symbol 1) + (looking-at-p (concat " *" id))) + (save-excursion + ;; This does not seem to make emacs snapshot happy + (ignore-errors + (sp-ruby-backward-sexp) + (sp-ruby-forward-sexp) + (looking-at-p (concat "[^[:blank:]]* *" id)))))))) + +(defun sp-ruby-method-p (id) + "Test if ID is a method." + (save-excursion + (when (looking-back id nil) + (backward-word)) + (and (looking-at-p id) + (or + ;; fix for def_foo + (looking-at-p (concat id "[_?!:]")) + ;; fix for foo_def + (looking-back "[_:@$.]" nil) + ;; fix for def for; end + (looking-back "def \\|class \\|module " nil) + ;; Check if multiline method call + ;; But beware of comments! + (and (looking-back "\\.[[:blank:]\n]*" nil) + (not (save-excursion + (search-backward ".") + (sp-point-in-comment)))))))) + +(defun sp-ruby-skip-inline-match-p (ms _mb _me) + "If non-nil, skip inline match. +MS, MB, ME." + (or (sp-ruby-method-p ms) + (sp-ruby-inline-p ms))) + +(defun sp-ruby-skip-method-p (ms _mb _me) + "If non-nil, skip method. +MS, MB, ME." + (sp-ruby-method-p ms)) + +(defun sp-ruby-in-string-or-word-p (id action context) + "Test if point is inside string or word. +ID, ACTION, CONTEXT." + (or (sp-in-string-p id action context) + (and (looking-back id nil) + (not (looking-back (sp--strict-regexp-quote id) nil))) + (sp-ruby-method-p id))) + +(defun sp-ruby-in-string-word-or-inline-p (id action context) + "Test if point is inside string, word or inline. +ID, ACTION, CONTEXT." + (or (sp-ruby-in-string-or-word-p id action context) + (and (looking-back id nil) + (sp-ruby-inline-p id)))) + +(defun sp-ruby-pre-pipe-handler (id action _context) + "Ruby pipe handler. +ID, ACTION, CONTEXT." + (when (equal action 'insert) + (save-excursion + (just-one-space)) + (save-excursion + (search-backward id) + (just-one-space)))) + +(defun sp-ruby-should-insert-pipe-close (id action _context) + "Test whether to insert the closing pipe for a lambda-binding pipe pair. +ID, ACTION, CONTEXT" + (if (eq action 'insert) + (thing-at-point-looking-at + (rx-to-string `(and (or "do" "{") (* space) ,id))) + t)) + +(defun sp--ruby-skip-match (ms me mb) + "Ruby skip match. +MS, ME, MB." + (when (string= ms "end") + (or (sp-in-string-p ms me mb) + (sp-ruby-method-p "end")))) + +(add-to-list 'sp-navigate-skip-match + '((ruby-mode enh-ruby-mode motion-mode) . sp--ruby-skip-match)) + +(dolist (mode '(ruby-mode motion-mode)) + (add-to-list 'sp-sexp-suffix `(,mode syntax ""))) + +(sp-with-modes '(ruby-mode enh-ruby-mode motion-mode) + (sp-local-pair "do" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-block-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "{" "}" + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-post-handler) + :suffix "") + + (sp-local-pair "begin" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-block-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "def" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "class" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "module" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "case" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-method-p + :suffix "") + + (sp-local-pair "for" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-or-word-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-inline-match-p) + + (sp-local-pair "if" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-inline-match-p + :suffix "") + + (sp-local-pair "unless" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-inline-match-p + :suffix "") + + (sp-local-pair "while" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-inline-match-p + :suffix "") + + (sp-local-pair "until" "end" + :when '(("SPC" "RET" "")) + :unless '(sp-ruby-in-string-word-or-inline-p sp-in-comment-p) + :actions '(insert navigate) + :pre-handlers '(sp-ruby-pre-handler) + :post-handlers '(sp-ruby-def-post-handler) + :skip-match 'sp-ruby-skip-inline-match-p + :suffix "") + + (sp-local-pair "|" "|" + :when '(sp-ruby-should-insert-pipe-close) + :pre-handlers '(sp-ruby-pre-pipe-handler) + :suffix "")) + +(provide 'smartparens-ruby) + +;;; smartparens-ruby.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-rust.el b/elpa/smartparens-20230529.1017/smartparens-rust.el new file mode 100644 index 00000000..42996d84 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-rust.el @@ -0,0 +1,142 @@ +;;; smartparens-rust.el --- Additional configuration for Rust based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2019 Wilfred Hughes + +;; Created: 3 November 2015 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Rust. To use +;; it, simply add: +;; +;; (require 'smartparens-config) +;; +;; alternatively, you can explicitly load these preferences: +;; +;; (require 'smartparens-rust) +;; +;; in your configuration. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: +(require 'smartparens) + +(declare-function rust-mode "rust-mode") +(declare-function rustic-mode "rustic-mode") + +(defun sp-in-rust-lifetime-context (&rest _args) + "Return t if point is in a Rust context where ' represents a lifetime. +If we return nil, ' should be used for character literals. +ARGS." + (or + (condition-case nil + ;; If point is just after a &', it's probably a &'foo. + (save-excursion + (backward-char 2) + (looking-at "&")) + ;; If we're at the beginning of the buffer, just carry on. + (beginning-of-buffer)) + ;; If point is inside < > it's probably a parameterised function. + (let ((paren-pos (nth 1 (syntax-ppss)))) + (and paren-pos + (save-excursion + (goto-char paren-pos) + (looking-at "<")))))) + +(defun sp-rust-skip-match-angle-bracket (_ms _mb me) + "Non-nil if we should ignore the bracket as valid delimiter." + (save-excursion + (goto-char me) + (let ((on-fn-return-type + (sp--looking-back-p (rx "->") nil)) + (on-match-branch + (sp--looking-back-p (rx "=>") nil)) + (on-comparison + (sp--looking-back-p (rx (or + (seq space "<") + (seq space ">") + (seq space "<<") + (seq space ">>"))) + nil))) + (or on-comparison on-fn-return-type on-match-branch)))) + +(defun sp-rust-filter-angle-brackets (_id action context) + "Non-nil if we should allow ID's ACTION in CONTEXT for angle brackets." + ;; See the docstring for `sp-pair' for the possible values of ID, + ;; ACTION and CONTEXT. + (cond + ;; Inside strings, don't do anything with < or >. + ((eq context 'string) + nil) + ;; Don't do any smart pairing inside comments either. + ((eq context 'comment) + nil) + ;; Otherwise, we're in code. + ((eq context 'code) + (let ((on-fn-return-type + (looking-back (rx "->") nil)) + (on-match-branch + (looking-back (rx "=>") nil)) + (on-comparison + (looking-back (rx (or + (seq space "<") + (seq space ">") + (seq space "<<") + (seq space ">>"))) + nil))) + (cond + ;; Only insert a matching > if we're not looking at a + ;; comparison. + ((eq action 'insert) + (and (not on-comparison) (not on-fn-return-type) (not on-match-branch))) + ;; Always allow wrapping in a pair if the region is active. + ((eq action 'wrap) + (not on-match-branch)) + ;; When pressing >, autoskip if we're not looking at a + ;; comparison. + ((eq action 'autoskip) + (and (not on-comparison) (not on-fn-return-type) (not on-match-branch))) + ;; Allow navigation, highlighting and strictness checks if it's + ;; not a comparison. + ((eq action 'navigate) + (and (not on-comparison) (not on-fn-return-type) (not on-match-branch)))))))) + +(sp-with-modes '(rust-mode rustic-mode) + (sp-local-pair "'" "'" + :unless '(sp-in-comment-p sp-in-string-quotes-p sp-in-rust-lifetime-context) + :post-handlers'(:rem sp-escape-quotes-after-insert)) + (sp-local-pair "<" ">" + :when '(sp-rust-filter-angle-brackets) + :skip-match 'sp-rust-skip-match-angle-bracket)) + +;; Rust has no sexp suffices. This fixes slurping +;; (|foo).bar -> (foo.bar) +(add-to-list 'sp-sexp-suffix (list #'rust-mode 'regexp "")) +(add-to-list 'sp-sexp-suffix (list #'rustic-mode 'regexp "")) + +(provide 'smartparens-rust) + +;;; smartparens-rust.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-scala.el b/elpa/smartparens-20230529.1017/smartparens-scala.el new file mode 100644 index 00000000..14a114a1 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-scala.el @@ -0,0 +1,83 @@ +;;; smartparens-scala.el --- Additional configuration for Scala based modes. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2018, 2021 Greg Nwosu + +;; Author: Greg Nwosu +;; Maintainer: Greg Nwosu +;; Created: 8 July 2015 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Scala based +;; modes. To use it, simply add: +;; +;; (require 'smartparens-scala) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +;; Scala has no sexp suffices. This fixes slurping +;; import scala.mutable{|} ListBuffer, Set ---the comma should not travel with the closing +;; paren +(--each '(scala-mode inferior-scala-mode) + (add-to-list 'sp-sexp-suffix (list it 'regexp ""))) + +(defun sp-scala-wrap-with-indented-newlines (_1 action _2) + "Post handler for the wrap ACTION, putting the region on indented newlines." + (when (eq action 'wrap) + (indent-for-tab-command) + (sp-get sp-last-wrapped-region + (let ((beg :beg-in) + (end :end-in)) + (save-excursion + (goto-char end) + (newline-and-indent)) + (save-excursion + (goto-char beg) + (newline)) + (indent-region beg end))))) + +(sp-local-pair 'scala-mode "(" nil + :post-handlers '(("||\n[i]" "RET") + ("| " "SPC"))) + +(sp-local-pair 'scala-mode "{" nil + :post-handlers '(("||\n[i]" "RET") + ("| " "SPC") + sp-scala-wrap-with-indented-newlines)) + +(sp-local-pair 'scala-mode "\"\"\"" "\"\"\"") + +(provide 'smartparens-scala) +;;; smartparens-scala.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-swift.el b/elpa/smartparens-20230529.1017/smartparens-swift.el new file mode 100644 index 00000000..a1efab10 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-swift.el @@ -0,0 +1,117 @@ +;;; smartparens-swift.el --- Additional configuration for Swift language buffers. -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Wilfred Hughes, +;; 2022 Josh Caswell + +;; Created: 4 April 2022 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Swift. To use +;; it, simply add: +;; +;; (require 'smartparens-config) +;; +;; alternatively, you can explicitly load these preferences: +;; +;; (require 'smartparens-swift) +;; +;; in your configuration. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: +(require 'smartparens) + +(declare-function swift-mode "swift-mode") + +(defun sp-swift-skip-match-angle-bracket (_ms _mb me) + "Non-nil if we should ignore the bracket as valid delimiter." + (save-excursion + (goto-char me) + (let ((on-fn-return-type + (sp--looking-back-p (rx "->") nil)) + (on-range-operator + (sp--looking-back-p (rx "..<") nil)) + (on-comparison + (sp--looking-back-p (rx (or + (seq space "<") + (seq space ">") + (seq space "<<") + (seq space ">>"))) + nil))) + (or on-comparison on-fn-return-type on-range-operator)))) + +(defun sp-swift-filter-angle-brackets (_id action context) + "Non-nil if we should allow ID's ACTION in CONTEXT for angle brackets." + ;; See the docstring for `sp-pair' for the possible values of ID, + ;; ACTION and CONTEXT. + (cond + ;; Inside strings, don't do anything with < or >. + ((eq context 'string) + nil) + ((or (eq context 'comment) + (eq context 'code)) + (let ((on-fn-return-type + (looking-back (rx "->") nil)) + (on-range-operator + (looking-back (rx "..<") nil)) + (on-comparison + (looking-back (rx (or + (seq space "<") + (seq space ">") + (seq space "<<") + (seq space ">>"))) + nil))) + (cond + ;; Only insert a matching > if we're not looking at one of the operators. + ((eq action 'insert) + (and (not on-comparison) (not on-fn-return-type) (not on-range-operator))) + ;; Allow wrapping in a pair if the region is active and we're not on a + ;; range operator. + ((eq action 'wrap) + (not on-range-operator)) + ;; When pressing >, autoskip if we're not looking at one of the + ;; operators. + ((eq action 'autoskip) + (and (not on-comparison) (not on-fn-return-type) (not on-range-operator))) + ;; Allow navigation, highlighting and strictness checks if it's + ;; not one of the operators. + ((eq action 'navigate) + (and (not on-comparison) (not on-fn-return-type) (not on-range-operator)))))))) + +(sp-with-modes '(swift-mode) + (sp-local-pair "<" ">" + :when '(sp-swift-filter-angle-brackets) + :skip-match 'sp-swift-skip-match-angle-bracket) + (sp-local-pair "\"\"\"" "\"\"\"")) + +;; Swift has no sexp suffices. This fixes slurping +;; (|foo).bar -> (foo.bar) +(add-to-list 'sp-sexp-suffix (list #'swift-mode 'regexp "")) + +(provide 'smartparens-swift) + +;;; smartparens-swift.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-text.el b/elpa/smartparens-20230529.1017/smartparens-text.el new file mode 100644 index 00000000..a5f79cc2 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-text.el @@ -0,0 +1,65 @@ +;;; smartparens-latex.el --- Additional configuration for text-mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 16 July 2017 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for `text-mode'. +;; To use it, simply add: +;; +;; (require 'smartparens-text) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. + +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. + +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(defun sp-text-mode-emoticon-p (_id action _context) + (when (memq action '(insert navigate)) + (sp--looking-back-p ":-?[()]" 3))) + +(defun sp-text-mode-skip-emoticon (ms mb _me) + (when (member ms '("(" ")")) + (save-excursion + (goto-char mb) + (sp--looking-back-p ":-?" 2)))) + +(sp-local-pair 'text-mode "(" nil + :unless '(:add sp-text-mode-emoticon-p) + :skip-match 'sp-text-mode-skip-emoticon) + +(provide 'smartparens-text) +;;; smartparens-text.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens-unison.el b/elpa/smartparens-20230529.1017/smartparens-unison.el new file mode 100644 index 00000000..9161c972 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens-unison.el @@ -0,0 +1,57 @@ +;;; smartparens-unison.el --- Additional configuration for Unison -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Joseph Morag + +;; Author: Joseph Morag +;; Maintainer: Joseph Morag +;; Created: 04 December 2022 +;; Keywords: smartparens, unison +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; This file provides some additional configuration for Unison. +;; To use it, simply add: +;; +;; (require 'smartparens-unison) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;; If you have good ideas about what should be added please file an +;; issue on the github tracker. +;; +;; For more info, see github readme at +;; https://github.com/Fuco1/smartparens + +;;; Code: + +(require 'smartparens) + +(sp-with-modes '(unisonlang-mode) + ;; Disable ' because it is used as a shortcut to wrap a value in + ;; lambda () -> value + ;; to make it lazy + (sp-local-pair "'" nil :actions nil)) + +(provide 'smartparens-unison) +;;; smartparens-unison.el ends here diff --git a/elpa/smartparens-20230529.1017/smartparens.el b/elpa/smartparens-20230529.1017/smartparens.el new file mode 100644 index 00000000..bf99f5f7 --- /dev/null +++ b/elpa/smartparens-20230529.1017/smartparens.el @@ -0,0 +1,9697 @@ +;;; smartparens.el --- Automatic insertion, wrapping and paredit-like navigation with user defined pairs. -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2023 Matus Goljer + +;; Author: Matus Goljer +;; Maintainer: Matus Goljer +;; Created: 17 Nov 2012 +;; Version: 1.11.0 +;; Keywords: abbrev convenience editing +;; URL: https://github.com/Fuco1/smartparens + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This file is part of Smartparens. + +;; Smartparens 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. + +;; Smartparens 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 Smartparens. If not, see . + +;;; Commentary: + +;; Smartparens is minor mode for Emacs that deals with parens pairs +;; and tries to be smart about it. It started as a unification effort +;; to combine functionality of several existing packages in a single, +;; compatible and extensible way to deal with parentheses, delimiters, +;; tags and the like. Some of these packages include autopair, +;; textmate, wrap-region, electric-pair-mode, paredit and others. With +;; the basic features found in other packages it also brings many +;; improvements as well as completely new features. + +;; For a basic overview, see github readme at +;; https://github.com/Fuco1/smartparens + +;; For the complete documentation visit the documentation wiki located +;; at https://github.com/Fuco1/smartparens/wiki + +;; If you like this project, you can donate here: +;; https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=CEYP5YVHDRX8C + +;;; Code: + +(eval-when-compile + (require 'subr-x) ; for `string-trim' + (require 'cl-lib)) + +(require 'dash) +(require 'thingatpt) +(require 'help-mode) ;; for help-xref-following #85 +(require 'loadhist) + +(declare-function cua-replace-region "cua-base") ; FIXME: remove this when we drop support for old emacs +(declare-function cua-delete-region "cua-base") +(declare-function cua--fallback "cua-base") +(declare-function package-version-join "package") +(declare-function package-desc-version "package") + +(declare-function subword-kill "subword") +(declare-function subword-forward "subword") +(declare-function subword-backward "subword") + +(declare-function hungry-delete-backward "hungry-delete") +(declare-function hungry-delete-forward "hungry-delete") + +(declare-function evil-get-register "evil-common") +(declare-function evil-set-register "evil-common") +(eval-when-compile + (defvar evil-this-register) + (defvar package-alist) + (defvar sp-autoskip-closing-pair) + (defvar sp-show-enclosing-pair-commands) + (defvar show-smartparens-mode)) + + +;;; backport for older emacsen + +;; introduced in 24.3 +(unless (fboundp 'defvar-local) + (defmacro defvar-local (var val &optional docstring) + "Define VAR as a buffer-local variable with default value VAL. +Like `defvar' but additionally marks the variable as being automatically +buffer-local wherever it is set." + (declare (debug defvar) (doc-string 3)) + ;; Can't use backquote here, it's too early in the bootstrap. + (list 'progn (list 'defvar var val docstring) + (list 'make-variable-buffer-local (list 'quote var))))) + +;;;###autoload +(defun sp-cheat-sheet (&optional arg) + "Generate a cheat sheet of all the smartparens interactive functions. + +Without a prefix argument, print only the short documentation and examples. + +With non-nil prefix argument ARG, show the full documentation for each function. + +You can follow the links to the function or variable help page. +To get back to the full list, use \\[help-go-back]. + +You can use `beginning-of-defun' and `end-of-defun' to jump to +the previous/next entry. + +Examples are fontified using the `font-lock-string-face' for +better orientation." + (interactive "P") + (setq arg (not arg)) + (let ((do-not-display '( + smartparens-mode + smartparens-global-mode + turn-on-smartparens-mode + turn-off-smartparens-mode + sp-wrap-cancel + sp-remove-active-pair-overlay + sp-splice-sexp-killing-around ;; is aliased to `sp-raise-sexp' + show-smartparens-mode + show-smartparens-global-mode + turn-on-show-smartparens-mode + turn-off-show-smartparens-mode + )) + (do-not-display-with-arg '( + sp-use-paredit-bindings + sp-use-smartparens-bindings + )) + (commands (cl-loop for i in (cdr (feature-symbols 'smartparens)) + if (and (eq (car-safe i) 'defun) (commandp (cdr i))) + collect (cdr i)))) + (with-current-buffer (get-buffer-create "*Smartparens cheat sheet*") + (let ((standard-output (current-buffer)) + (help-xref-following t)) + (read-only-mode -1) + (erase-buffer) + (help-mode) + (smartparens-mode 1) + (help-setup-xref (list #'sp-cheat-sheet) + (called-interactively-p 'interactive)) + (read-only-mode -1) + (--each (--remove (or (memq it do-not-display) + (and arg (memq it do-not-display-with-arg))) + commands) + (unless (equal (symbol-name it) "advice-compilation") + (let ((start (point)) kill-from) + (insert (propertize (symbol-name it) 'face 'font-lock-function-name-face)) + (insert " is ") + (describe-function-1 it) + (save-excursion + (when arg + (goto-char start) + (forward-paragraph 1) + (forward-line 1) + (if (looking-at "^It is bound") + (forward-paragraph 2) + (forward-paragraph 1)) + (setq kill-from (point)) + (when (re-search-forward "^Examples:" nil t) + (delete-region kill-from + (save-excursion + (forward-line 1) + (point)))))) + (insert (propertize (concat + "\n\n" + (make-string 72 ?―) + "\n\n") 'face 'font-lock-function-name-face))))) + (goto-char (point-min)) + (while (re-search-forward "\\(->\\|​\\)" nil t) + (let ((thing (bounds-of-thing-at-point 'line))) + (put-text-property (car thing) (cdr thing) 'face 'font-lock-string-face))) + (goto-char (point-min)) + (while (re-search-forward "|" nil t) + (put-text-property (1- (point)) (point) 'face 'font-lock-warning-face)) + (goto-char (point-min)) + (while (re-search-forward "^It is bound to \\(.*?\\)\\." nil t) + (put-text-property (match-beginning 1) (match-end 1) 'face 'font-lock-keyword-face)) + (goto-char (point-min)) + (while (re-search-forward ";;.*?$" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'font-lock-comment-face)) + (help-make-xrefs) + (goto-char (point-min)))) + (pop-to-buffer "*Smartparens cheat sheet*"))) + +(defun sp-describe-system (starterkit) + "Describe user's system. + +The output of this function can be used in bug reports." + (interactive + (list (completing-read "Starterkit/Distribution used: " + (list + "Spacemacs" + "Evil" + "Vanilla" + )))) + (let ((text (format "- `smartparens` version: %s +- Active `major-mode`: `%s` +- Smartparens strict mode: %s +- Emacs version (`M-x emacs-version`): %s +- Starterkit/Distribution: %s +- OS: %s" + (--if-let (cadr (assoc 'smartparens package-alist)) + (package-version-join (package-desc-version it)) + "") + (symbol-name major-mode) + (bound-and-true-p smartparens-strict-mode) + (replace-regexp-in-string "\n" "" (emacs-version)) + starterkit + (symbol-name system-type)))) + (pop-to-buffer + (with-current-buffer (get-buffer-create "*sp-describe-system*") + (erase-buffer) + (insert "The content of the buffer underneath the line was +copied to your clipboard. You can also edit it in this buffer +and then copy the results manually. +------------------------------------------------ +") + (insert text) + (current-buffer))) + (kill-new text))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Variables + +(defvar-local sp-forward-bound-fn nil + "Function to restrict the forward search") + +(defvar-local sp-backward-bound-fn nil + "Function to restrict the backward search") + +(defun sp--get-forward-bound () + "Get the bound to limit the forward search for looking for pairs. + +If it returns nil, the original bound passed to the search +function will be considered." + (and sp-forward-bound-fn (funcall sp-forward-bound-fn))) + +(defun sp--get-backward-bound () + "Get the bound to limit the backward search for looking for pairs. + +If it returns nil, the original bound passed to the search +function will be considered." + (and sp-backward-bound-fn (funcall sp-backward-bound-fn))) + + +(defvaralias 'sp-keymap 'smartparens-mode-map) +(make-obsolete-variable 'sp-keymap 'smartparens-mode-map "2015-01-01") + +;;;###autoload +(defvar smartparens-mode-map (make-sparse-keymap) + "Keymap used for `smartparens-mode'.") + +(defvar sp-paredit-bindings '( + ("C-M-f" . sp-forward-sexp) ;; navigation + ("C-M-b" . sp-backward-sexp) + ("C-M-u" . sp-backward-up-sexp) + ("C-M-d" . sp-down-sexp) + ("C-M-p" . sp-backward-down-sexp) + ("C-M-n" . sp-up-sexp) + ("M-s" . sp-splice-sexp) ;; depth-changing commands + ("M-" . sp-splice-sexp-killing-backward) + ("M-" . sp-splice-sexp-killing-forward) + ("M-r" . sp-splice-sexp-killing-around) + ("M-(" . sp-wrap-round) + ("C-)" . sp-forward-slurp-sexp) ;; barf/slurp + ("C-" . sp-forward-slurp-sexp) + ("C-}" . sp-forward-barf-sexp) + ("C-" . sp-forward-barf-sexp) + ("C-(" . sp-backward-slurp-sexp) + ("C-M-" . sp-backward-slurp-sexp) + ("C-{" . sp-backward-barf-sexp) + ("C-M-" . sp-backward-barf-sexp) + ("M-S" . sp-split-sexp) ;; misc + ("M-j" . sp-join-sexp) + ("M-?" . sp-convolute-sexp) + ) + "Paredit inspired bindings. + +Alist containing the default paredit bindings to corresponding +smartparens functions.") + +(defun sp--populate-keymap (bindings) + "Populates the `smartparens-mode-map' from the BINDINGS alist." + (--each bindings + (define-key smartparens-mode-map (read-kbd-macro (car it)) (cdr it)))) + +;;;###autoload +(defun sp-use-paredit-bindings () + "Initiate `smartparens-mode-map' with `sp-paredit-bindings'." + (interactive) + (sp--populate-keymap sp-paredit-bindings)) + +(defvar sp-smartparens-bindings '( + ("C-M-f" . sp-forward-sexp) + ("C-M-b" . sp-backward-sexp) + ("C-M-d" . sp-down-sexp) + ("C-M-a" . sp-backward-down-sexp) + ("C-S-d" . sp-beginning-of-sexp) + ("C-S-a" . sp-end-of-sexp) + ("C-M-e" . sp-up-sexp) + ("C-M-u" . sp-backward-up-sexp) + ("C-M-n" . sp-next-sexp) + ("C-M-p" . sp-previous-sexp) + ("C-M-k" . sp-kill-sexp) + ("C-M-w" . sp-copy-sexp) + ("M-" . sp-unwrap-sexp) + ("M-" . sp-backward-unwrap-sexp) + ("C-" . sp-forward-slurp-sexp) + ("C-" . sp-forward-barf-sexp) + ("C-M-" . sp-backward-slurp-sexp) + ("C-M-" . sp-backward-barf-sexp) + ("M-D" . sp-splice-sexp) + ("C-M-" . sp-splice-sexp-killing-forward) + ("C-M-" . sp-splice-sexp-killing-backward) + ("C-S-" . sp-splice-sexp-killing-around) + ("C-]" . sp-select-next-thing-exchange) + ("C-M-]" . sp-select-next-thing) + ("C-M-SPC" . sp-mark-sexp) + ("M-F" . sp-forward-symbol) + ("M-B" . sp-backward-symbol) + ) + "Alist containing the default smartparens bindings.") + +;;;###autoload +(defun sp-use-smartparens-bindings () + "Initiate `smartparens-mode-map' with `sp-smartparens-bindings'." + (interactive) + (sp--populate-keymap sp-smartparens-bindings)) + +(defun sp--set-base-key-bindings (&optional symbol value) + "Set up the default keymap based on `sp-base-key-bindings'. + +SYMBOL is the symbol being set, that is `sp-base-key-bindings'. + +VALUE is the saved value (as a symbol), can be one of: +- sp +- paredit + +This function is also used as a setter for this customize value." + (when symbol (set-default symbol value)) + (cond + ((eq value 'sp) + (sp-use-smartparens-bindings)) + ((eq value 'paredit) + (sp-use-paredit-bindings)))) + +(defun sp--update-override-key-bindings (&optional symbol value) + "Override the key bindings with values from `sp-override-key-bindings'. + +SYMBOL is `sp-override-key-bindings', VALUE is the value being set. + +This function is also used as a setter for this customize value." + (when symbol (set-default symbol value)) + ;; this also needs to reload the base set, if any is present. + (sp--set-base-key-bindings) + (sp--populate-keymap value)) + +(defcustom sp-base-key-bindings nil + "A default set of key bindings for commands provided by smartparens. + +Paredit binding adds the bindings in `sp-paredit-bindings' to the +corresponding smartparens commands. It does not add bindings to +any other commands, or commands that do not have a paredit +counterpart. + +Smartparens binding adds the bindings in +`sp-smartparens-bindings' to most common smartparens commands. +These are somewhat inspired by paredit, but in many cases differ. + +Note that neither \"paredit\" nor \"smartparens\" bindings add a +binding for all the provided commands." + :type '(radio + (const :tag "Don't use any default set of bindings" nil) + (const :tag "Use smartparens set of bindings" sp) + (const :tag "Use paredit set of bindings" paredit)) + :set 'sp--set-base-key-bindings + :group 'smartparens) + +(defcustom sp-override-key-bindings nil + "An alist of bindings and commands that should override the base key set. + +If you wish to override a binding from the base set, set the +value for the binding to the `kbd' recognizable string constant +and command to the command symbol you wish to bind there. + +If you wish to disable a binding from the base set, set the value +for the command to nil. + +Examples: + (\"C-M-f\" . sp-forward-sexp) + (\"C-\" . nil) + +See `sp-base-key-bindings'." + :type '(alist + :key-type string + :value-type symbol) + :set 'sp--update-override-key-bindings + :group 'smartparens) + +(defvar-local sp-escape-char nil + "Character used to escape quotes inside strings.") + +(defvar-local sp-comment-char nil + "Character used to start comments.") + +(defvar-local sp-pair-list nil + "List of pairs for autoinsertion or wrapping. + +Maximum length of opening or closing pair is +`sp-max-pair-length' characters.") + +(defvar-local sp-local-pairs nil + "List of pair definitions used for current buffer.") + +(defvar-local sp-last-operation nil + "Symbol holding the last successful operation.") + +(cl-defstruct sp-state + "Smartparens state for the current buffer." + ;; A "counter" to track delayed hook. When a pair is inserted, a + ;; cons of the form (:next . pair) is stored. On the next + ;; (immediately after insertion) invocation of post-command-hook, it + ;; is changed to (:this . pair). When the `car' is :this, the + ;; post-command-hook checks the delayed hooks for `pair' and + ;; executes them, then reset the "counter". + delayed-hook + ;; TODO + delayed-insertion + ;; The last point checked by sp--syntax-ppss and its result, used for + ;; memoization + last-syntax-ppss-point ;; a list (point point-min point-max) + last-syntax-ppss-result + ;; Value of `sp-pair-list' for this buffer. Note that this might + ;; differ from `sp-pair-list' which is often changed by dynamic + ;; binding + pair-list + ;; Value of `sp-local-pairs' for this buffer. Note that this might + ;; differ from `sp-local-pairs' which is often changed by dynamic + ;; binding + local-pairs + ) + +(defvar-local sp-state (make-sp-state) + "Smartparens state for the current buffer.") + +;; TODO: get rid of this +(defvar-local sp-previous-point -1 + "Location of point before last command. + +This is only updated when some pair-overlay is active. Do not +rely on the value of this variable anywhere else!") + +;; TODO: get rid of this +(defvar-local sp-wrap-point nil + "Save the value of point before attempt to wrap a region. + +Used for restoring the original state if the wrapping is +cancelled.") + +;; TODO: get rid of this +(defvar-local sp-wrap-mark nil + "Save the value of mark before attempt to wrap a region. + +Used for restoring the original state if the wrapping is +cancelled.") + +(defvar-local sp-last-inserted-characters "" + "Characters typed during the wrapping selection. + +If wrapping is cancelled, these characters are re-inserted to the +location of point before the wrapping.") + +(defvar-local sp-last-inserted-pair nil + "Last inserted pair.") + +(defvar-local sp-delayed-pair nil + "The pair whose insertion is being delayed. + +The insertion of this pair is delayed to be carried out in +`sp--post-command-hook-handler'. The format is (opening delim +. beg of the opening delim)") + +(defvar-local sp-last-wrapped-region nil + "Information about the last wrapped region. +The format is the same as returned by `sp-get-sexp'.") + +(defvar sp-point-inside-string nil + "Non-nil if point is inside a string. + +Used to remember the state from before `self-insert-command' is +run.") + +(defvar sp-buffer-modified-p nil + "Non-nil if buffer was modified before `pre-command-hook'.") + +(defvar sp-pre-command-point nil + "Position of `point' before `this-command' gets executed.") + +(defconst sp-max-pair-length 10 + "Maximum length of an opening or closing delimiter. + +Only the pairs defined by `sp-pair' are considered. Tag pairs +can be of any length.") + +(defconst sp-max-prefix-length 100 + "Maximum length of a pair prefix. + +Because prefixes for pairs can be specified using regular +expressions, they can potentially be of arbitrary length. This +settings solves the problem where the parser would decide to +backtrack the entire buffer which would lock up Emacs.") + +(defvar sp-pairs + '((t + . + ((:open "\\\\(" :close "\\\\)" :actions (insert wrap autoskip navigate)) + (:open "\\{" :close "\\}" :actions (insert wrap autoskip navigate)) + (:open "\\(" :close "\\)" :actions (insert wrap autoskip navigate)) + (:open "\\\"" :close "\\\"" :actions (insert wrap autoskip navigate)) + (:open "\"" :close "\"" + :actions (insert wrap autoskip navigate escape) + :unless (sp-in-string-quotes-p) + :post-handlers (sp-escape-wrapped-region sp-escape-quotes-after-insert)) + (:open "'" :close "'" + :actions (insert wrap autoskip navigate escape) + :unless (sp-in-string-quotes-p sp-point-after-word-p) + :post-handlers (sp-escape-wrapped-region sp-escape-quotes-after-insert)) + (:open "(" :close ")" :actions (insert wrap autoskip navigate)) + (:open "[" :close "]" :actions (insert wrap autoskip navigate)) + (:open "{" :close "}" :actions (insert wrap autoskip navigate)) + (:open "`" :close "`" :actions (insert wrap autoskip navigate))))) + "List of pair definitions. + +Maximum length of opening or closing pair is +`sp-max-pair-length' characters.") + +(defvar sp-tags nil + "List of tag definitions. See `sp-local-tag' for more information.") + +(defvar sp-prefix-tag-object nil + "If non-nil, only consider tags while searching for next thing.") + +(defvar sp-prefix-pair-object nil + "If non-nil, only consider pairs while searching for next thing. + +Pairs are defined as expressions delimited by pairs from +`sp-pair-list'.") + +(defvar sp-prefix-symbol-object nil + "If non-nil, only consider symbols while searching for next thing. + +Symbol is defined as a chunk of text recognized by +`sp-forward-symbol'.") + +(define-obsolete-variable-alias 'sp--lisp-modes 'sp-lisp-modes "2015-11-08") + +(defcustom sp-lisp-modes '( + cider-repl-mode + clojure-mode + clojurec-mode + clojurescript-mode + clojurex-mode + common-lisp-mode + emacs-lisp-mode + eshell-mode + fennel-mode + fennel-repl-mode + geiser-repl-mode + gerbil-mode + inf-clojure-mode + inferior-emacs-lisp-mode + inferior-lisp-mode + inferior-scheme-mode + lisp-interaction-mode + lisp-mode + monroe-mode + racket-mode + racket-repl-mode + scheme-interaction-mode + scheme-mode + slime-repl-mode + sly-mrepl-mode + stumpwm-mode + ) + "List of Lisp-related modes." + :type '(repeat symbol) + :group 'smartparens) + +(defcustom sp-clojure-modes '( + cider-repl-mode + clojure-mode + clojurec-mode + clojurescript-mode + clojurex-mode + inf-clojure-mode + ) + "List of Clojure-related modes." + :type '(repeat symbol) + :group 'smartparens) + +(defcustom sp-c-modes '( + c-mode + c++-mode + ) + "List of C-related modes." + :type '(repeat symbol) + :group 'smartparens) + +(defcustom sp-no-reindent-after-kill-modes '( + python-mode + coffee-mode + asm-mode + makefile-gmake-mode + haml-mode + ) + "List of modes that should not reindent after kill." + :type '(repeat symbol) + :group 'smartparens) + +(defcustom sp-no-reindent-after-kill-indent-line-functions + '( + insert-tab + ) + "List of `indent-line-function's that should not reindent after kill." + :type '(repeat symbol) + :group 'smartparens) + +(defvar sp--html-modes '( + sgml-mode + html-mode + rhtml-mode + nxhtml-mode + nxml-mode + web-mode + jinja2-mode + html-erb-mode + js-jsx-mode + js2-jsx-mode + rjsx-mode + ) + "List of HTML modes.") + +(defvar sp-message-alist + '((:unmatched-expression + "Search failed: there is an unmatched expression somewhere or we are at the beginning/end of file" + "Unmatched expression") + (:unbalanced-region + "Can not kill the region: the buffer would end up in an unbalanced state after deleting the active region" + "Killing the region would make the buffer unbalanced" + "Unbalanced region") + (:delimiter-in-string + "Ignored: opening or closing pair is inside a string or comment and matching pair is outside (or vice versa)") + (:no-matching-tag + "Search failed: no matching tag found" + "No matching tag") + (:invalid-context-prev + "Invalid context: previous h-sexp ends after the next one" + "Invalid context") + (:invalid-context-cur + "Invalid context: current h-sexp starts after the next one" + "Invalid context") + (:no-structure-found + "Previous sexp starts after current h-sexp or no structure was found" + "No valid structure found") + (:invalid-structure + "Ignored: this operation would result in invalid structure" + "Ignored because of invalid structure") + (:cant-slurp + "Ignored: we can not slurp without breaking strictly balanced expression" + "Can not slurp without breaking balance") + (:cant-slurp-context + "Ignored: we can not slurp into different context (comment -> code)" + "Can not slurp into different context") + (:cant-insert-closing-delimiter + "We can not insert unbalanced closing delimiter in strict mode" + "Can not insert unbalanced delimiter") + (:blank-sexp + "Point is in blank sexp, nothing to barf" + "Point is in blank sexp") + (:point-not-deep-enough + "Point has to be at least two levels deep to swap the enclosing delimiters" + "Point has to be at least two levels deep" + "Point not deep enough") + (:different-type + "The expressions to be joined are of different type" + "Expressions are of different type")) + "List of predefined messages to be displayed by `sp-message'. + +Each element is a list consisting of a keyword and one or more +strings, which are chosen based on the `sp-message-width' +variable. If the latter is t, the first string is chosen as +default, which should be the most verbose option available.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Customize & Mode definitions + +(defgroup smartparens () + "Smartparens minor mode." + :group 'editing + :prefix "sp-") + +;;;###autoload +(define-minor-mode smartparens-mode + "Toggle smartparens mode. + +You can enable pre-set bindings by customizing +`sp-base-key-bindings' variable. The current content of +`smartparens-mode-map' is: + + \\{smartparens-mode-map}" + :init-value nil + :lighter (" SP" (:eval (if smartparens-strict-mode "/s" ""))) + :group 'smartparens + :keymap smartparens-mode-map + (if smartparens-mode + (progn + (sp--init) + (add-hook 'self-insert-uses-region-functions 'sp-wrap--can-wrap-p nil 'local) + ;; Unfortunately, some modes rebind "inserting" keys to their + ;; own handlers but do not hand over the insertion back to + ;; `self-insert-command', rather, they insert via `insert'. + ;; Therefore, we need to call this handler in + ;; `post-command-hook' too (inside + ;; `sp--post-command-hook-handler'). The list + ;; `sp--special-self-insert-commands' specifies which commands + ;; to handle specially. + (add-hook 'post-self-insert-hook 'sp--post-self-insert-hook-handler nil 'local) + (add-hook 'pre-command-hook 'sp--save-pre-command-state nil 'local) + (add-hook 'post-command-hook 'sp--post-command-hook-handler nil 'local) + (run-hooks 'smartparens-enabled-hook)) + (remove-hook 'self-insert-uses-region-functions 'sp-wrap--can-wrap-p 'local) + (remove-hook 'post-self-insert-hook 'sp--post-self-insert-hook-handler 'local) + (remove-hook 'pre-command-hook 'sp--save-pre-command-state 'local) + (remove-hook 'post-command-hook 'sp--post-command-hook-handler 'local) + (run-hooks 'smartparens-disabled-hook))) + +(defvar smartparens-strict-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap delete-char] 'sp-delete-char) + (define-key map [remap delete-forward-char] 'sp-delete-char) + (define-key map [remap backward-delete-char-untabify] 'sp-backward-delete-char) + (define-key map [remap backward-delete-char] 'sp-backward-delete-char) + (define-key map [remap delete-backward-char] 'sp-backward-delete-char) + (define-key map [remap kill-word] 'sp-kill-word) + (define-key map [remap kill-line] 'sp-kill-hybrid-sexp) + (define-key map [remap backward-kill-word] 'sp-backward-kill-word) + (define-key map [remap kill-region] 'sp-kill-region) + (define-key map [remap delete-region] 'sp-delete-region) + (define-key map [remap kill-whole-line] 'sp-kill-whole-line) + map) + "Keymap used for `smartparens-strict-mode'.") + +;;;###autoload +(define-minor-mode smartparens-strict-mode + "Toggle the strict smartparens mode. + +When strict mode is active, `delete-char', `kill-word' and their +backward variants will skip over the pair delimiters in order to +keep the structure always valid (the same way as `paredit-mode' +does). This is accomplished by remapping them to +`sp-delete-char' and `sp-kill-word'. There is also function +`sp-kill-symbol' that deletes symbols instead of words, otherwise +working exactly the same (it is not bound to any key by default). + +When strict mode is active, this is indicated with \"/s\" +after the smartparens indicator in the mode list." + :init-value nil + :group 'smartparens + (if smartparens-strict-mode + (progn + (unless smartparens-mode + (smartparens-mode 1)) + (unless (assq 'smartparens-strict-mode minor-mode-overriding-map-alist) + (push `(smartparens-strict-mode . ,smartparens-strict-mode-map) + minor-mode-overriding-map-alist)) + (put 'sp-backward-delete-char 'delete-selection 'sp--delete-selection-supersede-p) + (put 'sp-delete-char 'delete-selection 'sp--delete-selection-supersede-p) + (add-hook 'self-insert-uses-region-functions 'sp--self-insert-uses-region-strict-p nil 'local) + (setq sp-autoskip-closing-pair 'always)) + (setq minor-mode-overriding-map-alist + (assq-delete-all 'smartparens-strict-mode minor-mode-overriding-map-alist)) + (put 'sp-backward-delete-char 'delete-selection 'supersede) + (put 'sp-delete-char 'delete-selection 'supersede) + (remove-hook 'self-insert-uses-region-functions 'sp--self-insert-uses-region-strict-p 'local) + (let ((std-val (car (plist-get (symbol-plist 'sp-autoskip-closing-pair) 'standard-value))) + (saved-val (car (plist-get (symbol-plist 'sp-autoskip-closing-pair) 'saved-value)))) + (setq sp-autoskip-closing-pair (eval (or saved-val std-val)))))) + +;;;###autoload +(define-globalized-minor-mode smartparens-global-strict-mode + smartparens-strict-mode + turn-on-smartparens-strict-mode + :group 'smartparens) + +(defcustom sp-ignore-modes-list '( + minibuffer-mode + minibuffer-inactive-mode + ) + "Modes where smartparens mode is inactive if allowed globally." + :type '(repeat symbol) + :group 'smartparens) + +;;;###autoload +(defun turn-on-smartparens-strict-mode () + "Turn on `smartparens-strict-mode'." + (interactive) + (unless (or (member major-mode sp-ignore-modes-list) + (and (not (derived-mode-p 'comint-mode)) + (eq (get major-mode 'mode-class) 'special))) + (smartparens-strict-mode 1))) + +;;;###autoload +(defun turn-off-smartparens-strict-mode () + "Turn off `smartparens-strict-mode'." + (interactive) + (smartparens-strict-mode -1)) + +(defun sp--init () + "Initialize the buffer local smartparens state. + + This includes pair bindings and other buffer local variables +that depend on the active `major-mode'." + (setq sp-state (make-sp-state)) + ;; setup local pair replacements + (sp--update-local-pairs) + ;; set the escape char + (dotimes (char 256) + (unless sp-escape-char + (when (= ?\\ (char-syntax char)) + (setq sp-escape-char (string char)))) + (unless sp-comment-char + (when (= ?< (char-syntax char)) + (setq sp-comment-char (string char))))) + ;; in case no escape syntax is found, just assume the backspace + (unless sp-escape-char (setq sp-escape-char "\\"))) + +(defun sp--maybe-init () + "Initialize the buffer if it is not already initialized. + +See `sp--init'." + (unless sp-pair-list + (sp--init))) + +(defun sp--remove-local-pair (open) + "Remove OPEN from `sp-local-pairs'." + (setq sp-local-pairs + (--remove (equal (plist-get it :open) open) + sp-local-pairs))) + +(defun sp--update-sp-pair-list () + "Update `sp-pair-list' according to current value of `sp-local-pairs'." + (setq sp-pair-list + (->> sp-local-pairs + (--map (cons (plist-get it :open) (plist-get it :close))) + (-sort (lambda (x y) (> (length (car x)) (length (car y)))))))) + +(defun sp--update-local-pairs () + "Update local pairs after change or at mode initialization. + +This command loads all the parent major mode definitions and +merges them into current buffer's `sp-local-pairs'." + ;; Combine all the definitions from the most ancient parent to the + ;; most recent parent + (-each (nreverse + (--unfold (when it + (cons it (get it 'derived-mode-parent))) + major-mode)) + #'sp-update-local-pairs)) + +(defun sp-update-local-pairs (configuration) + "Update `sp-local-pairs' with CONFIGURATION. + +The pairs are only updated in current buffer not in all buffers +with the same major mode! If you want to update all buffers of +the specific major-modes use `sp-local-pair'. + +CONFIGURATION can be a symbol to be looked up in `sp-pairs' or a +property list corresponding to the arguments of `sp-local-pair' +or a list of such property lists." + (setq sp-local-pairs + (cond + ((symbolp configuration) + (sp--merge-pair-configurations (cdr (assq configuration sp-pairs)))) + ((plist-member configuration :open) + (sp--merge-pair-configurations (list configuration))) + (t + (sp--merge-pair-configurations configuration)))) + + ;; Keep only those which have non-nil :actions + (setq sp-local-pairs (--filter (plist-get it :actions) sp-local-pairs)) + + ;; update the `sp-pair-list'. This is a list only containing + ;; (open.close) cons pairs for easier querying. We also must order + ;; it by length of opening delimiter in descending order (first + ;; value is the longest) + (sp--update-sp-pair-list) + (setf (sp-state-local-pairs sp-state) sp-local-pairs) + (setf (sp-state-pair-list sp-state) sp-pair-list)) + +(defmacro sp-with-buffers-using-mode (mode &rest body) + "Execute BODY in every existing buffer using `major-mode' MODE." + (declare (indent 1)) + `(--each (buffer-list) + (with-current-buffer it + (when (derived-mode-p ,mode) + ,@body)))) + +(defun sp--update-local-pairs-everywhere (&rest modes) + "Run `sp--update-local-pairs' in all buffers. + +This is necessary to update all the buffer-local definitions. If +MODES is non-nil, only update buffers with `major-mode' equal to +MODES." + (setq modes (-flatten modes)) + (--each (buffer-list) + (with-current-buffer it + (when (and smartparens-mode + (or (not modes) + (--any? (derived-mode-p it) modes))) + (sp--update-local-pairs))))) + +(defcustom smartparens-enabled-hook nil + "Called after `smartparens-mode' is turned on." + :type 'hook + :group 'smartparens) + +(defcustom smartparens-disabled-hook nil + "Called after `smartparens-mode' is turned off." + :type 'hook + :group 'smartparens) + +;;;###autoload +(define-globalized-minor-mode smartparens-global-mode + smartparens-mode + turn-on-smartparens-mode) + +;;;###autoload +(defun turn-on-smartparens-mode () + "Turn on `smartparens-mode'. + +This function is used to turn on `smartparens-global-mode'. + +By default `smartparens-global-mode' ignores buffers with +`mode-class' set to special, but only if they are also not comint +buffers. + +Additionally, buffers on `sp-ignore-modes-list' are ignored. + +You can still turn on smartparens in these mode manually (or +in mode's startup-hook etc.) by calling `smartparens-mode'." + (interactive) + (unless (or (member major-mode sp-ignore-modes-list) + (and (not (derived-mode-p 'comint-mode)) + (eq (get major-mode 'mode-class) 'special))) + (smartparens-mode t))) + +;;;###autoload +(defun turn-off-smartparens-mode () + "Turn off `smartparens-mode'." + (interactive) + (smartparens-mode -1)) + +;; insert custom +(defcustom sp-autoinsert-pair t + "If non-nil, autoinsert pairs. See `sp-insert-pair'." + :type 'boolean + :group 'smartparens) + +;; TODO: remove this in 1.12 +(defcustom sp-autoinsert-quote-if-followed-by-closing-pair nil + "If non-nil autoinsert quotes when the point is followed by closing delimiter. + +This option only changes behaviour of the insertion process if +point is inside a string. In other words, if string is not +closed and next character is a closing pair. + +For example, in a situation like this: + + [\"some text|] + +after pressing \", one would probably want to insert the closing +quote, not a nested pair (\\\"\\\"), to close the string literal +in the array. To enable such behaviour, set this variable to +nil. + +Note: the values of this varible seem to be backward, i.e. it is +\"enabled\" when the value is nil. This was an unfortunate +choice of wording. It is kept this way to preserve backward +compatibility. The intended meaning is \"insert the pair if +followed by closing pair?\", t = yes." + :type 'boolean + :group 'smartparens) +(make-obsolete-variable + 'sp-autoinsert-quote-if-followed-by-closing-pair + "the option was removed and no longer has any effect." "1.10") + +(defcustom sp-autoskip-closing-pair 'always-end + "Determine the behaviour when skipping closing delimiters. + +If t, skip the following closing pair if the expression is +active (that is right after insertion). This is controlled by +`sp-cancel-autoskip-on-backward-movement'. + +If set to \"always-end\", skip the closing pair even if the +expression is not active and point is at the end of the +expression. This only works for expressions with +single-character delimiters. + +If set to \"always\", `sp-up-sexp' is called whenever the closing +delimiter is typed inside a sexp of the same type. This is the +paredit-like behaviour. This setting only works for +single-character delimiters and does not work for string-like +delimiters. + +See `sp-autoskip-opening-pair' for similar setting for +string-like delimiters. + +See also `sp-skip-closing-pair'." + :type '(radio + (const :tag "Never skip closing delimiter" nil) + (const :tag "Skip closing delimiter in active expressions" t) + (const :tag "Always skip closing delimiter if at the end of sexp" always-end) + (const :tag "Always skip closing delimiter" always)) + :group 'smartparens) +(make-variable-buffer-local 'sp-autoskip-closing-pair) + +(defcustom sp-autoskip-opening-pair nil + "Determine the behaviour when skipping opening delimiters. + +If non-nil, skip into the following string-like expression +instead of inserting a new pair." + :type 'boolean + :group 'smartparens) +(make-variable-buffer-local 'sp-autoskip-opening-pair) + +;; TODO: rename to reflect what this actually does +(defcustom sp-cancel-autoskip-on-backward-movement t + "If non-nil, deactivate the active expression on backward movement. + +Note: the name of this variable is a historic coincidence and +will change in some future release to reflect its real purpose. + +See also `sp-skip-closing-pair'." + :type 'boolean + :group 'smartparens) + +;; delete custom +(defcustom sp-autodelete-pair t + "If non-nil, auto delete pairs. See `sp-delete-pair'." + :type 'boolean + :group 'smartparens) + +(defcustom sp-autodelete-closing-pair t + "If non-nil, auto delete the whole closing-pair. See `sp-delete-pair'." + :type 'boolean + :group 'smartparens) + +(defcustom sp-autodelete-opening-pair t + "If non-nil, auto delete the whole opening-pair. See `sp-delete-pair'." + :type 'boolean + :group 'smartparens) + +(defcustom sp-undo-pairs-separately nil + "If non-nil, put an `undo-boundary' before each inserted pair. + +Calling undo after smartparens complete a pair will remove only +the pair before undoing any previous insertion. + +WARNING: This option is implemented by hacking the +`buffer-undo-list'. Turning this option on might have +irreversible consequences on the buffer's undo information and in +some cases might remove important information. Usage of package +`undo-tree' is recommended if you ever need to revert to a state +unreachable by undo." + :type 'boolean + :group 'smartparens) + +(defcustom sp-successive-kill-preserve-whitespace 1 + "Control the behaviour of `sp-kill-sexp' on successive kills. + +In the description, we consider more than one space +\"superfluous\", however, newlines are preserved." + :type '(radio + (const :tag "Always preserve the whitespace" 0) + (const :tag "Remove superfluous whitespace after last kill" 1) + (const :tag "Remove superfluous whitespace after all kills" 2)) + :group 'smartparens) + +;; wrap custom +(defcustom sp-autowrap-region t + "If non-nil, wrap the active region with pair." + :type 'boolean + :group 'smartparens) + +(defcustom sp-wrap-show-possible-pairs t + "If non-nil, show possible pairs which can complete the wrapping." + :type 'boolean + :group 'smartparens) + +(defcustom sp-autodelete-wrap t + "If non-nil, autodelete opening and closing pair of most recent wrapping. + +Deletion command must be the very first command after the +insertion, otherwise normal behaviour is applied." + :type 'boolean + :group 'smartparens) + +(defcustom sp-wrap-repeat-last 1 + "Context in which smartparens repeats the last wrap. + +If the last operation was a wrap and we insert another pair at +the beginning or end of the last wrapped region, repeat the +wrap on this region with current pair." + :type '(radio + (const :tag "Do not repeat wrapping" 0) + (const :tag "Only repeat if current tag is the same as the last one" 1) + (const :tag "Always repeat if the point is after the opening/closing delimiter of last wrapped region" 2)) + :group 'smartparens) + +(defcustom sp-wrap-entire-symbol nil + "If non-nil, do NOT wrap the entire symbol, only the part after point. + +If set to \"Enable globally\", smart symbol wrapping is active +everywhere. This is the default option. + +If set to \"Disable globally\", smart symbol wrapping is disabled +everywhere. + +Otherwise, a list of major modes where smart symbol wrapping is +*disabled* can be supplied. + +Examples: + + foo-ba|r-baz -> (|foo-bar-baz) ;; if enabled + + foo-ba|r-baz -> foo-ba(|r-baz) ;; if disabled" + :type '(choice + (const :tag "Enable globally" nil) + (const :tag "Disable globally" globally) + (repeat :tag "Disable in these major modes" symbol)) + :group 'smartparens) + +(defcustom sp-wrap-from-point nil + "If non-nil, do not wrap from the beginning of next expression but from point. + +However, if the point is inside a symbol/word, the entire +symbol/word is wrapped. To customize this behaviour, see +variable `sp-wrap-entire-symbol'." + :type 'boolean + :group 'smartparens) + +(defcustom sp-wrap-respect-direction nil + "When non-nil respect the wrap direction. + +When non-nil, wrapping with opening pair always jumps to the +beginning of the region and wrapping with closing pair always +jumps to the end of the region. + + |fooM -> [ -> |[foo]M + Mfoo| -> [ -> |[foo]M + |fooM -> ] -> M[foo]| + Mfoo| -> ] -> M[foo]| + +When nil, closing pair places the point at the end of the region +and the opening pair leaves the point at its original +position (before or after the region). + + |fooM -> [ -> [|fooM] + Mfoo| -> [ -> M[foo]| + |fooM -> ] -> M[foo]| + Mfoo| -> ] -> M[foo]|" + :type 'boolean + :group 'smartparens) + +;; escaping custom +(defcustom sp-escape-wrapped-region t + "If non-nil, escape special chars inside the just wrapped region." + :type 'boolean + :group 'smartparens) + +(defcustom sp-escape-quotes-after-insert t + "If non-nil, escape string quotes if typed inside string." + :type 'boolean + :group 'smartparens) + +;; navigation & manip custom +(defcustom sp-barf-move-point-with-delimiter t + "If non-nil, move point when it would end outside the sexp after barf. + +This way, a barf operation can be immediately followed by an +opposite slurp to undo it." + :type 'boolean + :group 'smartparens) + +(defcustom sp-navigate-consider-sgml-tags '( + html-mode + ) + "List of modes where sgml tags are considered to be sexps." + :type '(repeat symbol) + :group 'smartparens) + + +(defcustom sp-navigate-use-textmode-stringlike-parser '((derived . text-mode)) + "List of modes where textmode stringlike parser is used. + +See `sp-get-textmode-stringlike-expression'. + +Each element of the list can either be a symbol which is then +checked against `major-mode', or a cons (derived . PARENT-MODE), +where PARENT-MODE is checked using `derived-mode-p'." + :type '(repeat (choice + (symbol :tag "Major mode") + (cons :tag "Derived mode" + (const derived) + (symbol :tag "Parent major mode name")))) + :group 'smartparens) + +(defcustom sp-navigate-consider-symbols t + "If non-nil, consider symbols outside balanced expressions as such. + +Symbols are recognized by function `sp-forward-symbol'. This +setting affect all the navigation and manipulation functions +where it make sense. + +Also, special handling of strings is enabled, where the whole +string delimited with \"\" is considered as one token. + +WARNING: This is a legacy setting and changing its value to NIL +may break many things. It is kept only for backward +compatibility and will be removed in the next major release." + :type 'boolean + :group 'smartparens) + +(defcustom sp-navigate-comments-as-sexps t + "If non-nil, consider comments as sexps in `sp-get-enclosing-sexp'. + +If this option is enabled, unbalanced expressions in comments are +never automatically closed (see `sp-navigate-close-if-unbalanced')." + :type 'boolean + :group 'smartparens) + +;; TODO: add -alist suffix +(defcustom sp-navigate-skip-match `( + (,sp-lisp-modes . sp--elisp-skip-match) + ) + "Major-mode dependent specifications of skip functions. + +Alist where the key is a list of major-modes and the value is a +function used to skip over matches in `sp-get-paired-expression'. +This function takes three arguments: the currently matched +delimiter, beginning of match and end of match. If this function +returns true, the current match will be skipped. + +You can use this to skip over expressions that serve multiple +functions, such as if/end pair or unary if in Ruby or * in +markdown when it signifies list item instead of emphasis. If the +exception is only relevant to one pair, you should rather +use :skip-match option in `sp-local-pair'." + :type '(alist + :key-type (repeat symbol) + :value-type symbol) + :group 'smartparens) + +(defcustom sp-navigate-reindent-after-up `( + (interactive + ,@sp-lisp-modes + ) + ) + "Modes where sexps should be reindented after `sp-up-sexp'. + +The whitespace between the closing delimiter and last \"thing\" +inside the expression is removed. It works analogically for the +`sp-backward-up-sexp'. + +Note that this also happens when `sp-skip-closing-pair' is +invoked (usually in strict mode when the closing delimiter is +typed) as it calls `sp-up-sexp' internally. This behaviour can +be customized by various settings of `sp-autoskip-closing-pair' +and `sp-autoskip-opening-pair'. + +If the mode is in the list \"interactive\", only reindent the sexp +if the command was called interactively. This is recommended for +general use. + +If the mode is in the list \"always\", reindend the sexp even if the +command was called programatically." + :type '(alist + :options (interactive always) + :value-type (repeat symbol)) + :group 'smartparens) + +(defcustom sp-navigate-reindent-after-up-in-string t + "If non-nil, `sp-up-sexp' will reindent inside strings. + +If `sp-navigate-reindent-after-up' is enabled and the point is +inside a string, this setting determines if smartparens should +reindent the current (string) sexp or not." + :type 'boolean + :group 'smartparens) + +(defcustom sp-navigate-close-if-unbalanced nil + "If non-nil, insert the closing pair of the un-matched pair on `sp-up-sexp'. + +The closing delimiter is inserted after the symbol at +point (using `sp-previous-sexp')." + :type 'boolean + :group 'smartparens) + +(defcustom sp-navigate-interactive-always-progress-point nil + "Make point always move in the direction of navigation. + +If non-nil and the function is called interactively, +`sp-next-sexp' and `sp-previous-sexp' will always move the point +to the end/beg of such an expression where the point would end up +being further in the direction of travel. + +Note: this behaviour will become default in release 2.0 and will +cease to be configurable." + :type 'boolean + :group 'smartparens) + +(defcustom sp-sexp-prefix nil + "Alist of `major-mode' specific prefix specification. + +Each item is a list with three properties: +- major mode +- a constant symbol \\='regexp or \\='syntax +- a regexp or a string containing syntax class codes. + +If the second argument is \\='regexp, the third argument is +interpreted as a regexp to search backward from the start of an +expression. + +If the second argument is \\='syntax, the third argument is +interpreted as string containing syntax codes that will be +skipped. + +You can also override this property locally for a specific pair +by specifying its :prefix property." + :type '(repeat + (list symbol + (choice + (const :tag "Regexp" regexp) + (const :tag "Syntax class codes" syntax)) + string)) + :group 'smartparens) + +(defcustom sp-sexp-suffix nil + "Alist of `major-mode' specific suffix specification. + +Each item is a list with three properties: +- major mode +- a constant symbol \\='regexp or \\='syntax +- a regexp or a string containing syntax class codes. + +If the second argument is \\='regexp, the third argument is +interpreted as a regexp to search forward from the end of an +expression. + +If the second argument is \\='syntax, the third argument is +interpreted as string containing syntax codes that will be +skipped. + +You can also override this property locally for a specific pair +by specifying its :suffix property." + :type '(repeat + (list symbol + (choice + (const :tag "Regexp" regexp) + (const :tag "Syntax class codes" syntax)) + string)) + :group 'smartparens) + +(defcustom sp-split-sexp-always-split-as-string t + "Determine if sexp inside string is split. + +If the point is inside a sexp inside a string, the default +behaviour is now to split the string, such that: + + \"foo (|) bar\" + +becomes + + \"foo (\"|\") bar\" + +instead of + + \"foo ()|() bar\". + +Note: the old default behaviour was the reverse, it would split +the sexp, but this is hardly ever what you want. + +You can add a post-handler on string pair and check for +\\='split-string action to add concatenation operators of the +language you work in (in each `major-mode' you can have a separate +hook). + +For example, in PHP the string concatenation operator is a +dot (.), so you would add: + + (defun my-php-post-split-handler (_ action _) + (when (eq action \\='split-sexp) + (just-one-space) + (insert \". . \") + (backward-char 3))) + + (sp-local-pair \\='php-mode \"\\='\" nil + :post-handlers \\='(my-php-post-split-handler)) + +Then + + echo \\='foo |baz\\='; + +results in + + echo \\='foo\\=' . | . \\='baz\\=';" + :type 'boolean + :group 'smartparens) + +;; hybrid lines +(defcustom sp-hybrid-kill-excessive-whitespace nil + "Determine how `sp-kill-hybrid-sexp' kills excessive whitespace. + +If non-nil, `sp-kill-hybrid-sexp' will delete all whitespace +up until next hybrid sexp if the point is at the end of line or +on a blank line. + +When it is set to \\='kill, whitespace will be appended to the sexp +in kill ring." + :type '(choice + (const :tag "Delete" t) + (const :tag "Kill" kill) + (const :tag "Off" nil)) + :group 'smartparens) + +(defcustom sp-hybrid-kill-entire-symbol nil + "Governs how symbols under point are treated by `sp-kill-hybrid-sexp'. + +If t, always kill the symbol under point. + +If nil, never kill the entire symbol and only kill the part after point. + +If a function, this should be a zero-arg predicate. When it +returns non-nil value, we should kill from point." + :type '(radio + (const :tag "Always kill entire symbol" t) + (const :tag "Always kill from point" nil) + (const :tag "Kill from point only inside strings" sp-point-in-string) + (function :tag "Custom predicate")) + :group 'smartparens) + +(defcustom sp-comment-string nil + "String that is inserted after calling `sp-comment'. + +It is an alist of list of major modes to a string. + +The value of `comment-start' is used if the major mode is not found." + :type '(alist + :key-type (repeat symbol) + :value-type string) + :group 'smartparens) + +;; ui custom +(defcustom sp-highlight-pair-overlay t + "If non-nil, autoinserted pairs are highlighted while point is inside the pair." + :type 'boolean + :group 'smartparens) + +(defcustom sp-highlight-wrap-overlay t + "If non-nil, wrap overlays are highlighted during editing of the wrapping pair." + :type 'boolean + :group 'smartparens) + +(defcustom sp-highlight-wrap-tag-overlay t + "If non-nil, wrap tag overlays are highlighted during editing +of the wrapping tag pair." + :type 'boolean + :group 'smartparens) + +(defcustom sp-echo-match-when-invisible t + "If non-nil, show-smartparens-mode prints the line of the +matching paren in the echo area if not visible on screen." + :type 'boolean + :group 'smartparens) + +(defcustom sp-message-width 'frame + "Length of information and error messages to display. + +If set to \\='frame (the default), messages are chosen based of the +frame width. t means chose the default (verbose) message, nil +means mute. Integers specify the maximum width." + :type '(choice (const :tag "Fit to frame" frame) + (const :tag "Verbose" t) + (const :tag "Mute" nil) + (integer :tag "Max width")) + :group 'smartparens) + +;; TODO: this should be true by default > then the behaviour is +;; controlled by subword-mode... and this is a hard override +(defcustom sp-use-subword nil + "Override of `subword-mode' killing behaviour. + +If non-nill, `sp-kill-word' and `sp-backward-kill-word' only +kill \"subwords\" when `subword-mode' is active." + :type 'boolean + :group 'smartparens) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Selection mode handling + +(defun sp--delete-selection-p () + "Return t if `delete-selection-mode' or `cua-delete-selection' is enabled." + (or (and (boundp 'delete-selection-mode) delete-selection-mode) + (and (boundp 'cua-delete-selection) cua-delete-selection cua-mode))) + +(defun sp--delete-selection-supersede-p () + "Decide if the current command should delete the region or not. + +This check is used as value of \\='delete-selection property on the +command symbol." + (if (or (equal current-prefix-arg '(4)) + (sp-region-ok-p (region-beginning) (region-end))) + 'supersede + (sp-message :unbalanced-region) + ;; Since this check runs in the pre-command-hook we can change the + ;; command to be executed... in this case we set it to ignore + ;; because we don't want to do anything. + (setq this-command 'ignore) + nil)) + +(defun sp--self-insert-uses-region-strict-p () + "Decide if the current `self-insert-command' should be able to +replace the region. + +This check is added to the special hook +`self-insert-uses-region-functions' which is checked by +`delete-selection-uses-region-p'." + (if (or (equal current-prefix-arg '(4)) + (sp-region-ok-p (region-beginning) (region-end))) + ;; region is OK or we are allowed to replace it, just say nil so + ;; that delsel handles this + nil + ;; in case region is bad we interrupt the insertion + (setq this-command 'ignore) + t)) + +;; TODO: this function was removed from Emacs, we should get rid of +;; the advice in time. +(defadvice cua-replace-region (around fix-sp-wrap activate) + "Fix `sp-wrap' in `cua-selection-mode'." + (if (and smartparens-mode (sp-wrap--can-wrap-p)) + (cua--fallback) + ad-do-it)) + +(defadvice cua-delete-region (around fix-sp-delete-region activate) + "If `smartparens-strict-mode' is enabled, perform a region +check before deleting." + (if (and smartparens-mode smartparens-strict-mode) + (progn + (unless (or current-prefix-arg + (sp-region-ok-p (region-beginning) (region-end))) + (user-error (sp-message :unbalanced-region :return))) + ad-do-it) + ad-do-it)) + + + +(cl-eval-when (compile eval load) + (defun sp--get-substitute (struct list) + "Only ever call this from sp-get! This function does the +replacement of all the keywords with actual calls to sp-get." + (if (listp list) + (if (eq (car list) 'sp-get) + list + (mapcar (lambda (x) (sp--get-substitute struct x)) + (let ((command (car list))) + (cond + ((eq command 'sp-do-move-op) + (let ((argument (make-symbol "--sp-argument--"))) + `(let ((,argument ,(cadr list))) + (if (< ,argument :beg-prf) + (progn + (goto-char :beg-prf) + (delete-char (+ :op-l :prefix-l)) + (goto-char ,argument) + (insert :prefix :op)) + (goto-char ,argument) + (insert :prefix :op) + (goto-char :beg-prf) + (delete-char (+ :op-l :prefix-l)))))) + ((eq command 'sp-do-move-cl) + (let ((argument (make-symbol "--sp-argument--"))) + `(let ((,argument ,(cadr list))) + (if (> ,argument :end-in) + (progn + (goto-char ,argument) + (insert :cl :suffix) + (goto-char :end-in) + (delete-char (+ :cl-l :suffix-l))) + (goto-char :end-in) + (delete-char (+ :cl-l :suffix-l)) + (goto-char ,argument) + (insert :cl :suffix))))) + ((eq command 'sp-do-del-op) + `(progn + (goto-char :beg-prf) + (delete-char (+ :op-l :prefix-l)))) + ((eq command 'sp-do-del-cl) + `(progn + (goto-char :end-in) + (delete-char (+ :cl-l :suffix-l)))) + ((eq command 'sp-do-put-op) + `(progn + (goto-char ,(cadr list)) + (insert :prefix :op))) + ((eq command 'sp-do-put-cl) + `(progn + (goto-char ,(cadr list)) + (insert :cl :suffix))) + (t list))))) + (if (keywordp list) + (sp--get-replace-keyword struct list) + list))) + + (defun sp--get-replace-keyword (struct keyword) + (cl-case keyword + ;; point in buffer before the opening delimiter + (:beg `(plist-get ,struct :beg)) + ;; point in the buffer after the closing delimiter + (:end `(plist-get ,struct :end)) + ;; point in buffer after the opening delimiter + (:beg-in `(+ (plist-get ,struct :beg) (length (plist-get ,struct :op)))) + ;; point in buffer before the closing delimiter + (:end-in `(- (plist-get ,struct :end) (length (plist-get ,struct :cl)))) + ;; point in buffer before the prefix of this expression + (:beg-prf `(- (plist-get ,struct :beg) (length (plist-get ,struct :prefix)))) + ;; point in the buffer after the suffix of this expression + (:end-suf `(+ (plist-get ,struct :end) (length (plist-get ,struct :suffix)))) + ;; opening delimiter + (:op `(plist-get ,struct :op)) + ;; closing delimiter + (:cl `(plist-get ,struct :cl)) + ;; length of the opening pair + (:op-l `(length (plist-get ,struct :op))) + ;; length of the closing pair + (:cl-l `(length (plist-get ,struct :cl))) + ;; length of the entire expression, including enclosing + ;; delimiters and the prefix and suffix + (:len `(- (plist-get ,struct :end) + (plist-get ,struct :beg) + (- (length (plist-get ,struct :prefix))) + (- (length (plist-get ,struct :suffix))))) + ;; length of the the pair ignoring the prefix, including delimiters + (:len-out `(- (plist-get ,struct :end) (plist-get ,struct :beg))) + ;; length of the pair inside the delimiters + (:len-in `(- (plist-get ,struct :end) + (plist-get ,struct :beg) + (length (plist-get ,struct :op)) + (length (plist-get ,struct :cl)))) + ;; expression prefix + (:prefix `(plist-get ,struct :prefix)) + ;; expression prefix length + (:prefix-l `(length (plist-get ,struct :prefix))) + (:suffix `(plist-get ,struct :suffix)) + (:suffix-l `(length (plist-get ,struct :suffix))) + ;; combined op/cl and suffix/prefix + (:opp `(concat (plist-get ,struct :prefix) + (plist-get ,struct :op))) + (:opp-l `(+ (length (plist-get ,struct :prefix)) + (length (plist-get ,struct :op)))) + (:cls `(concat (plist-get ,struct :cl) + (plist-get ,struct :suffix))) + (:cls-l `(+ (length (plist-get ,struct :cl)) + (length (plist-get ,struct :suffix)))) + (t keyword)))) + + +;; TODO: rewrite this in terms of `symbol-macrolet' ?? +(defmacro sp-get (struct &rest forms) + "Get a property from a structure. + +STRUCT is a plist with the format as returned by `sp-get-sexp'. +Which means this macro also works with `sp-get-symbol', +`sp-get-string' and `sp-get-thing'. + +FORMS is an attribute we want to query. Currently supported +attributes are: + +:beg - point in buffer before the opening delimiter +:end - point in the buffer after the closing delimiter +:beg-in - point in buffer after the opening delimiter +:end-in - point in buffer before the closing delimiter +:beg-prf - point in buffer before the prefix of this expression +:end-suf - point in buffer after the suffix of this expression +:op - opening delimiter +:cl - closing delimiter +:op-l - length of the opening pair +:cl-l - length of the closing pair +:len - length of the entire expression, including enclosing + delimiters, the prefix and the suffix +:len-out - length of the the pair ignoring the prefix and suffix, + including delimiters +:len-in - length of the pair inside the delimiters +:prefix - expression prefix +:prefix-l - expression prefix length +:suffix - expression suffix +:suffix-l - expression suffix length + +These special \"functions\" are expanded to do the selected +action in the context of currently queried pair: + +Nullary: +\(sp-do-del-op) - remove prefix and opening delimiter +\(sp-do-del-cl) - remove closing delimiter and suffix + +Unary: +\(sp-do-move-op p) - move prefix and opening delimiter to point p +\(sp-do-move-cl p) - move closing delimiter and suffix to point p +\(sp-do-put-op p) - put prefix and opening delimiter at point p +\(sp-do-put-cl p) - put closing delimiter and suffix at point p + +In addition to these simple queries and commands, this macro +understands arbitrary forms where any of the aforementioned +attributes are used. Therefore, you can for example query for +\"(+ :op-l :cl-l)\". This query would return the sum of lengths +of opening and closing delimiter. A query +\"(concat :prefix :op)\" would return the string containing +expression prefix and the opening delimiter. + +Special care is taken to only evaluate the STRUCT argument once." + (declare (indent 1) + (debug (form body))) + (let ((st (make-symbol "struct"))) + (sp--get-substitute st `(let ((,st ,struct)) ,@forms)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Misc/Utility functions + +(defun sp--indent-region (start end &optional column) + "Call `indent-region' unless `aggressive-indent-mode' is enabled. + +START, END and COLUMN are the same as in `indent-region'." + (unless (bound-and-true-p aggressive-indent-mode) + ;; Don't issue "Indenting region..." message. + (cl-letf (((symbol-function 'message) #'ignore)) + (indent-region start end column)))) + +(defmacro sp-with-modes (arg &rest forms) + "Add ARG as first argument to each form in FORMS. + +This can be used with `sp-local-pair' calls to automatically +insert the modes." + (declare (indent 1) + (debug (form body))) + (let ((modes (make-symbol "modes"))) + `(let ((,modes ,arg)) + (progn + ,@(mapcar (lambda (form) (append (list (car form) modes) (cdr form))) forms))))) + +(defmacro sp--with-case-sensitive (&rest body) + "Ensure that searching done within BODY is case-sensitive. + +Bind `case-fold-search' to nil if it is not already and avoid the +bind if it is already. Any function that needs to use any of the +sp--looking-* functions more than once should wrap them all in +`sp--with-case-sensitive'." + (declare (indent 0) + (debug (body))) + `(if case-fold-search + (let ((case-fold-search nil)) + ,@body) + ,@body)) + +(defun sp--evil-normal-state-p () + "Check to see if the current `evil-state' is in normal mode." + (and (fboundp 'evil-normal-state-p) (evil-normal-state-p))) + +(defun sp--evil-motion-state-p () + "Check to see if the current `evil-state' is in motion mode." + (and (fboundp 'evil-motion-state-p) (evil-motion-state-p))) + +(defun sp--evil-visual-state-p () + "Check to see if the current `evil-state' is in visual mode." + (and (fboundp 'evil-visual-state-p) (evil-visual-state-p))) + +(defun sp-point-in-blank-line (&optional p) + "Return non-nil if line at point is blank (whitespace only). + +If optional argument P is present test this instead of point." + (save-excursion + (when p (goto-char p)) + (beginning-of-line) + (looking-at "[ \t]*$"))) + +(defun sp-point-in-blank-sexp (&optional p) + "Return non-nil if point is inside blank (whitespace only) sexp. + +If optional argument P is present test this instead of point. + +Warning: it is only safe to call this when point is inside a +sexp, otherwise the call may be very slow." + (save-excursion + (when p (goto-char p)) + (-when-let (enc (sp-get-enclosing-sexp)) + (sp-get enc (string-match-p + "\\`[ \t\n]*\\'" + (buffer-substring-no-properties :beg-in :end-in)))))) + +(defun sp-char-is-escaped-p (&optional point) + "Test if the char at POINT is escaped or not. + +POINT defaults to `point'." + (setq point (or point (point))) + (save-match-data + (when (save-excursion + (goto-char point) + (looking-back (concat sp-escape-char sp-escape-char "+") nil t)) + (eq (logand (length (match-string 0)) 1) 1)))) + +(defun sp--syntax-ppss (&optional p) + "Memoize the last result of `syntax-ppss'. + +P is the point at which we run `syntax-ppss'" + (let ((p (or p (point))) + (mem-p (sp-state-last-syntax-ppss-point sp-state))) + (if (and (eq p (nth 0 mem-p)) + (eq (point-min) (nth 1 mem-p)) + (eq (point-max) (nth 2 mem-p))) + (sp-state-last-syntax-ppss-result sp-state) + ;; Add hook to reset memoization if necessary + (unless (sp-state-last-syntax-ppss-point sp-state) + (add-hook 'before-change-functions 'sp--reset-memoization t t)) + (setf (sp-state-last-syntax-ppss-point sp-state) + (list p (point-min) (point-max)) + (sp-state-last-syntax-ppss-result sp-state) (syntax-ppss p))))) + +(defun sp-point-in-string (&optional p) + "Return non-nil if point is inside string or documentation string. + +This function actually returns the 3rd element of `syntax-ppss' +which can be a number if the string is delimited by that +character or t if the string is delimited by general string +fences. + +If optional argument P is present test this instead of point." + (ignore-errors + (save-excursion + (nth 3 (sp--syntax-ppss p))))) + +(defun sp-point-in-comment (&optional p) + "Return non-nil if point is inside comment. + +If optional argument P is present test this instead off point." + (setq p (or p (point))) + (ignore-errors + (save-excursion + ;; We cannot be in a comment if we are inside a string + (unless (nth 3 (sp--syntax-ppss p)) + (or (nth 4 (sp--syntax-ppss p)) + ;; this also test opening and closing comment delimiters... we + ;; need to chack that it is not newline, which is in "comment + ;; ender" class in elisp-mode, but we just want it to be + ;; treated as whitespace + (and (< p (point-max)) + (memq (char-syntax (char-after p)) '(?< ?>)) + (not (eq (char-after p) ?\n))) + ;; we also need to test the special syntax flag for comment + ;; starters and enders, because `syntax-ppss' does not yet + ;; know if we are inside a comment or not (e.g. / can be a + ;; division or comment starter...). + (-when-let (s (car (syntax-after p))) + (or (and (/= 0 (logand (lsh 1 16) s)) + (nth 4 (syntax-ppss (+ p 2)))) + (and (/= 0 (logand (lsh 1 17) s)) + (nth 4 (syntax-ppss (+ p 1)))) + (and (/= 0 (logand (lsh 1 18) s)) + (nth 4 (syntax-ppss (- p 1)))) + (and (/= 0 (logand (lsh 1 19) s)) + (nth 4 (syntax-ppss (- p 2))))))))))) + +(defun sp-point-in-string-or-comment (&optional p) + "Return non-nil if point is inside string, documentation string or a comment. + +If optional argument P is present, test this instead of point." + (or (sp-point-in-string p) + (sp-point-in-comment p))) + +;; TODO: add -p suffix +(defun sp-point-in-symbol (&optional p) + "Return non-nil if `point' is inside symbol. + +If P is non-nil, interpret it as buffer position and test there. + +Point is inside symbol if characters on both sides of the point +are in either word or symbol class." + (setq p (or p (point))) + (save-excursion + (goto-char p) + (and (/= 0 (following-char)) + (memq (char-syntax (following-char)) '(?w ?_)) + (memq (char-syntax (preceding-char)) '(?w ?_))))) + +(defun sp--single-key-description (event) + "Return a description of the last EVENT. + +Replace all the function key symbols with garbage character (ň). + +TODO: fix this!" + (let ((original (single-key-description event))) + (cond + ((string-match-p "<.*?>" original) "ň") + ((string-match-p "SPC" original) " ") + (t original)))) + +;; see https://github.com/Fuco1/smartparens/issues/125#issuecomment-20356176 +(defun sp--current-indentation () + "Get the indentation offset of the current line." + (save-excursion + (back-to-indentation) + (current-column))) + +(defun sp--calculate-indentation-offset (old-column old-indentation) + "Calculate correct indentation after re-indent. + +OLD-COLUMN is the column before reindent. + +OLD-INDENTATION is the indentation depth before reindent." + (let ((indentation (sp--current-indentation))) + (cond + ;; Point was in code, so move it along with the re-indented code + ((>= old-column old-indentation) + (+ old-column (- indentation old-indentation))) + ;; Point was indentation, but would be in code now, so move to + ;; the beginning of indentation + ((<= indentation old-column) indentation) + ;; Point was in indentation, and still is, so leave it there + (:else old-column)))) + +(defun sp--back-to-indentation (old-column old-indentation) + "Set the current column to proper value. + +See `sp--keep-indentation'. + +OLD-COLUMN is the column before reindent. + +OLD-INDENTATION is the indentation depth before reindent." + (let ((offset (sp--calculate-indentation-offset old-column old-indentation))) + (move-to-column offset))) + +;; TODO: rename to preserve-current-column +(defmacro sp--keep-indentation (&rest body) + "Execute BODY and restore the column. + +If point was in code move it along if the line is reinvented so +it is the same distance relative to first code column. + +If point was previously in the indentation region but would end +up in code, move it to the first code column. + +If point was in the indentation region and is still there after +BODY, do nothing." + (declare (indent 0) + (debug (body))) + (let ((c (make-symbol "c")) + (i (make-symbol "i"))) + `(let ((,c (current-column)) + (,i (sp--current-indentation))) + ,@body + (sp--back-to-indentation ,c ,i)))) + +;; Please contribute these if you come across some! +(defvar sp--self-insert-commands + '(self-insert-command + org-self-insert-command + LaTeX-insert-left-brace) + "List of commands that are some sort of `self-insert-command'. + +Many modes rebind \"self-inserting\" keys to \"smart\" versions +which do some additional processing before delegating the +insertion to `self-insert-command'. Smartparens needs to be able +to distinguish these to properly handle insertion and reinsertion +of pairs and wraps.") + +;; Please contribute these if you come across some! +(defvar sp--special-self-insert-commands + '( + TeX-insert-dollar + TeX-insert-quote + quack-insert-opening-paren + quack-insert-closing-paren + quack-insert-opening-bracket + quack-insert-closing-bracket + racket-insert-closing-paren + racket-insert-closing-bracket + racket-insert-closing-brace + ) + "List of commands which are handled as if they were `self-insert-command's. + +Some modes redefine \"self-inserting\" keys to \"smart\" versions +which do some additional processing but do _not_ delegate the +insertion to `self-insert-command', instead inserting via +`insert'. Smartparens needs to be able to distinguish these to +properly handle insertion and reinsertion of pairs and wraps. + +The `sp--post-self-insert-hook-handler' is called in the +`post-command-hook' for these commands.") + +(defun sp--self-insert-command-p () + "Return non-nil if `this-command' is some sort of `self-insert-command'." + (memq this-command sp--self-insert-commands)) + +(defun sp--special-self-insert-command-p () + "Return non-nil if `this-command' is \"special\" self insert command. + +A special self insert command is one that inserts a character but +does not trigger `post-self-insert-hook'." + (memq this-command sp--special-self-insert-commands)) + +(defun sp--signum (x) + "Return 1 if X is positive, -1 if negative, 0 if zero." + (cond ((> x 0) 1) ((< x 0) -1) (t 0))) + +;; The structure returned by sp-get-sexp is a plist with following properties: +;; +;; :beg - point in the buffer before the opening delimiter (ignoring prefix) +;; :end - point in the buffer after the closing delimiter +;; :op - opening delimiter +;; :cl - closing delimiter +;; :prefix - expression prefix +;; +;; This structure should never be accessed directly and should only be +;; exposed by the sp-get macro. This way, we can later change the +;; internal representation without much trouble. + +(defmacro sp-compare-sexps (a b &optional fun what-a what-b) + "Return non-nil if the expressions A and B are equal. + +Two expressions are equal if their :beg property is the same. + +If optional argument FUN is non-nil, it is the comparison +function. + +If optional argument WHAT-A is non-nil, use it as a keyword on +which to do the comparsion (default to :beg). + +If optional argument WHAT-B is non-nil, use it as a keyword on +which to do the comparsion (default to WHAT-A)." + (declare (debug (form form &optional functionp keywordp keywordp))) + (setq fun (or fun 'equal)) + (setq what-a (or what-a :beg)) + (setq what-b (or what-b what-a)) + `(,fun (sp-get ,a ,what-a) (sp-get ,b ,what-b))) + +(defun sp-message (key &optional return) + "Display a message. + +KEY is either a string or list of strings, or a keyword, +in which case the string list is looked up in +`sp-message-alist'. The string to be displayed is chosen based on +the `sp-message-width' variable. + +If RETURN is non-nil return the string instead of printing it." + (let ((msgs (cond ((listp key) key) + ((stringp key) (list key)) + (t (cdr (assq key sp-message-alist)))))) + (when (and msgs sp-message-width) + (if (eq sp-message-width t) + (if return (car msgs) (message "%s." (car msgs))) + (let ((maxlen (if (eq sp-message-width 'frame) + (frame-width) + sp-message-width)) + (s nil)) + (dolist (msg msgs) + (if (and (<= (length msg) maxlen) + (> (length msg) (length s))) + (setf s msg))) + (when s + (if return s (message "%s." s)))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adding/removing of pairs/bans/allows etc. + +(defun sp--merge-prop (prop new-pair old-pair) + "Merge a property PROP from NEW-PAIR into OLD-PAIR. + +The list OLD-PAIR must not be nil." + (let ((new-val (plist-get new-pair prop))) + (cl-case prop + (:close (plist-put old-pair :close new-val)) + (:prefix (plist-put old-pair :prefix new-val)) + (:suffix (plist-put old-pair :suffix new-val)) + (:skip-match (plist-put old-pair :skip-match new-val)) + (:trigger (plist-put old-pair :trigger new-val)) + (:trigger-wrap (plist-put old-pair :trigger-wrap new-val)) + ((:actions :when :unless :pre-handlers :post-handlers) + (cl-case (car new-val) + (:add (plist-put old-pair prop (-union (plist-get old-pair prop) (cdr new-val)))) + (:rem (plist-put old-pair prop (-difference (plist-get old-pair prop) (cdr new-val)))) + (t + (cond + ;; this means we have ((:add ...) (:rem ...)) argument + ((and new-val + (listp (car new-val)) + (memq (caar new-val) '(:add :rem))) + (let ((a (assq :add new-val)) + (r (assq :rem new-val))) + (plist-put old-pair prop (-union (plist-get old-pair prop) (cdr a))) + (plist-put old-pair prop (-difference (plist-get old-pair prop) (cdr r))))) + (t + (plist-put old-pair prop (plist-get new-pair prop)))))))))) + +(defun sp--merge-pairs (old-pair new-pair) + "Merge OLD-PAIR and NEW-PAIR. +This modifies the OLD-PAIR by side effect." + (--each new-pair + ;; In plists, items at even positions are keys + (when (= 0 (% it-index 2)) + (sp--merge-prop it new-pair old-pair))) + old-pair) + +(defun sp--update-pair (new-pair old-pair) + "Copy properties from NEW-PAIR to OLD-PAIR. + +The list OLD-PAIR must not be nil." + (--each new-pair + ;; In plists, items at even positions are keys + (when (= 0 (% it-index 2)) + (when (or (not (plist-get old-pair it)) + ;; HACK: we don't want to overwrite list properties + ;; that aren't just :add with :add because this + ;; would break the "idempotency". + (not (equal '(:add) (plist-get new-pair it)))) + (plist-put old-pair it (plist-get new-pair it))))) + old-pair) + +(defun sp--update-pair-list (pair mode) + "Update the PAIR for major mode MODE. + +If this pair is not defined yet for this major mode, add it. If +this pair is already defined, replace all the properties in the +old definition with values from PAIR." + ;; get the structure relevant to mode. t means global setting + (let ((struct (--first (eq mode (car it)) sp-pairs))) + (if (not struct) + (!cons (cons mode (list pair)) sp-pairs) + ;; this does NOT merge changes, only replace the values at + ;; properties. Open delimiter works as ID as usual. + (let ((old-pair (--first (equal (plist-get pair :open) + (plist-get it :open)) + (cdr struct))) + (open (plist-get pair :open))) + (if (not old-pair) + (progn + (unless (or (plist-get pair :close) + (sp--get-pair open (assq t sp-pairs))) + (error "Pair %s was never defined, please specify closing delimiter in instead of passing `nil'" open)) + (setcdr struct (cons pair (cdr struct)))) + (sp--update-pair pair old-pair))))) + sp-pairs) + +(defun sp--get-pair (open list) + "Get the pair with id OPEN from list LIST." + (--first (equal open (plist-get it :open)) list)) + +(defun sp--get-pair-definition (open list &optional prop) + "Get the definition of a pair identified by OPEN from list LIST. + +If PROP is non-nil, return the value of that property instead." + (let ((pair (sp--get-pair open list))) + (cl-case prop + ((nil) pair) + (:op-l (length (plist-get pair :open))) + (:cl-l (length (plist-get pair :close))) + (:len (+ (length (plist-get pair :open)) + (length (plist-get pair :close)))) + (:post-handlers + (-remove #'listp (plist-get pair :post-handlers))) + (:post-handlers-cond + (-filter #'listp (plist-get pair :post-handlers))) + (:when + (-remove #'listp (plist-get pair :when))) + (:when-cond + (-flatten (-concat (-filter #'listp (plist-get pair :when))))) + (t (plist-get pair prop))))) + +(defun sp-get-pair-definition (open mode &optional prop) + "Get the definition of pair identified by OPEN. + +OPEN is the opening delimiter, MODE is the major mode symbol or t +for global definition. + +If PROP is non-nil, return the value of that property instead." + (sp--get-pair-definition open (cdr (assq mode sp-pairs)) prop)) + +(defun sp-get-pair (open &optional prop) + "Return the definition of pair defined by OPEN in the current buffer. + +The value is fetched from `sp-local-pairs'. + +If PROP is non-nil, return the value of that property instead." + (sp--get-pair-definition open sp-local-pairs prop)) + +(defun sp--merge-pair-configurations (specific &optional current) + "Merge SPECIFIC pair configuration to the CURRENT configuration. + +CURRENT defaults to `sp-local-pairs' if it is non-nil or the +global definition from `sp-pairs' if `sp-local-pairs' is nil." + (let* ((global (or current sp-local-pairs (cdr (assq t sp-pairs)))) + (local specific) + (result nil)) + ;; copy the pairs on global list first. This creates new plists + ;; so we can modify them without changing the global "template" + ;; values. + (dolist (old-pair global) + (!cons (list :open (plist-get old-pair :open)) result)) + + ;; merge the global list with result. This basically "deep copy" + ;; global list. We use `sp--merge-pairs' because it also clones + ;; the list properties (actions, filters etc.) + (dolist (new-pair global) + (let ((old-pair (sp--get-pair (plist-get new-pair :open) result))) + (sp--merge-pairs old-pair new-pair))) + + ;; for each local pair, merge it into the global definition + (dolist (new-pair local) + (let ((old-pair (sp--get-pair (plist-get new-pair :open) result))) + (if old-pair + (sp--merge-pairs old-pair new-pair) + ;; pair does not have global definition, simply copy it over + (!cons + ;; this "deep copy" the new-pair + (sp--merge-pairs (list :open (plist-get new-pair :open)) new-pair) + ;; TODO: remove the nil lists from the definitions + result)))) + result)) + +(defun sp-wrap-with-pair (pair) + "Wrap the following expression with PAIR. + +This function is a non-interactive helper. To use this function +interactively, bind the following lambda to a key: + + (lambda (&optional arg) (interactive \"P\") (sp-wrap-with-pair \"(\")) + +This lambda accepts the same prefix arguments as +`sp-select-next-thing'. + +If region is active and `use-region-p' returns true, the region +is wrapped instead. This is useful with selection functions in +`evil-mode' to wrap regions with pairs." + (let* ((arg (or current-prefix-arg 1)) + (sel (and (not (use-region-p)) + (sp-select-next-thing-exchange + arg + (cond + ;; point is inside symbol and smart symbol wrapping is disabled + ((and (sp-point-in-symbol) + (or (eq sp-wrap-entire-symbol 'globally) + (memq major-mode sp-wrap-entire-symbol))) + (point)) + ;; wrap from point, not the start of the next expression + ((and sp-wrap-from-point + (not (sp-point-in-symbol))) + (point)))))) + (active-pair (--first (equal (car it) pair) sp-pair-list)) + (rb (region-beginning)) + (re (region-end))) + (goto-char re) + (insert (cdr active-pair)) + (goto-char rb) + (insert (car active-pair)) + (if (use-region-p) + (sp--indent-region rb re) + (sp-get sel (sp--indent-region :beg :end))))) + +(cl-defun sp-pair (open + close + &key + trigger + trigger-wrap + (actions '(wrap insert autoskip navigate)) + when + unless + pre-handlers + post-handlers + wrap + bind + insert) + "Add a pair definition. + +OPEN is the opening delimiter. Every pair is uniquely determined +by this string. + +CLOSE is the closing delimiter. You can use nil for this +argument if you are updating an existing definition. In this +case, the old value is retained. + +TRIGGER is an optional trigger for the pair. The pair will be +inserted if either OPEN or TRIGGER is typed. This is usually +used as a shortcut for longer pairs or for pairs that can't be +typed easily. + +TRIGGER-WRAP is the same as TRIGGER but used for wrapping. + +ACTIONS is a list of actions that smartparens will perform with +this pair. Possible values are: + +- insert - autoinsert the closing pair when opening pair is + typed. +- wrap - wrap an active region with the pair defined by opening + delimiter if this is typed while region is active. +- autoskip - if the sexp is active or `sp-autoskip-closing-pair' is + set to \\='always, skip over the closing delimiter if user types its + characters in order. +- navigate - enable this pair for navigation/highlight and strictness + checks +- escape - allow autoescaping of this delimiter in string contexts + +If the ACTIONS argument has value :rem, the pair is removed. +This can be used to remove default pairs you don't want to use. +For example: (sp-pair \"[\" nil :actions :rem) + +WHEN is a list of predicates that test whether the action +should be performed in current context. The values in the list +should be names of the predicates (that is symbols, not +lambdas!). They should accept three arguments: opening +delimiter (which uniquely determines the pair), action and +context. The context argument can have values: + +- string - if point is inside string. +- comment - if point is inside comment. +- code - if point is inside code. This context is only + recognized in programming modes that define string semantics. + +If *any* filter returns t, the action WILL be performed. A number +of filters are predefined: `sp-point-after-word-p', +`sp-point-before-word-p', `sp-in-string-p', +`sp-point-before-eol-p' etc. + +When clause also supports a special format for delayed insertion. +The condition is a list with commands, predicates (with three +arguments as regular when form) or strings specifying the last +event. All three types can be combined in one list. The pair +will be inserted *after* the next command if it matches the any +command on the list, if the last event matches any string on the +list or if any predicate returns true. If the pair's :when +clause contains this special form, it will never be immediately +inserted and will always test for delayed insertion. + +UNLESS is a list of predicates. The conventions are the same as +for the WHEN list. If *any* filter on this list returns t, the +action WILL NOT be performed. The predicates in the WHEN list +are checked first, and if any of them succeeds, the UNLESS list +is not checked. + +Note: the functions on the WHEN/UNLESS lists are also called +\"filters\" in the documentation. + +All the filters are run *after* the trigger character is +inserted. + +PRE-HANDLERS is a list of functions that are called before there +has been some action caused by this pair. The arguments are the +same as for filters. Context is relative to the point *before* +the last inserted character. Because of the nature of the +wrapping operation, this hook is not called if the action is +wrapping. + +POST-HANDLERS is a list of functions that are called after there +has been some action caused by this pair. The arguments are the +same as for filters. Context is relative to current position of +point *after* the closing pair was inserted. + +After a wrapping action, the point might end on either side of +the wrapped region, depending on the original direction. You can +use the variable `sp-last-wrapped-region' to retrieve information +about the wrapped region and position the point to suit your +needs. + +A special syntax for conditional execution of hooks is also +supported. If the added item is a list (function command1 +command2...), where function is a 3 argument function described +above and command(s) can be either name of a command or a string +representing an event. If the last command or event as described +by `single-key-description' matches any on the list, the hook +will be executed. This means these hooks are run not after the +insertion, but after the *next* command is executed. + +Example: + ((lambda (id act con) + (save-excursion + (newline))) \"RET\" newline) + +This function will move the closing pair on its own line only if +the next command is `newline' or is triggered by RET. Otherwise +the pairs stay on the same line. + +WRAP is a key binding to which a \"wrapping\" action is bound. +The key should be in format that is accepted by `kbd'. This +option binds a lambda form: + + `(lambda (&optional arg) + (interactive \"P\") + (sp-wrap-with-pair ,OPEN)) + +to the specified key sequence. The binding is added to global +keymap. When executed, it wraps ARG (default 1) expressions with +this pair (like `paredit-wrap-round' and friends). Additionally, +it accepts the same prefix arguments as `sp-select-next-thing'. + +BIND is equivalent to WRAP. It is a legacy setting and will be +removed soon. + +INSERT is a key binding to which an \"insert\" action is bound. +The key should be in format that is accepted by `kbd'. This is +achieved by binding a lambda form: + + (lambda () (interactive) (sp-insert-pair \"pair-id\")) + +to the supplied key, where pair-id is the open delimiter of the +pair. The binding is added to the global map. You can also bind +a similar lambda manually. To only bind this in specific major +modes, use this property on `sp-local-pair' instead." + (if (eq actions :rem) + (let ((global-list (assq t sp-pairs))) + (setcdr global-list (--remove (equal (plist-get it :open) open) (cdr global-list))) + (--each (buffer-list) + (with-current-buffer it (sp--remove-local-pair open)))) + (let ((pair nil)) + (setq pair (plist-put pair :open open)) + (when close (plist-put pair :close close)) + (when trigger (plist-put pair :trigger trigger)) + (when trigger-wrap (plist-put pair :trigger-wrap trigger-wrap)) + (dolist (arg `((:actions . ,actions) + (:when . ,when) + (:unless . ,unless) + (:pre-handlers . ,pre-handlers) + (:post-handlers . ,post-handlers))) + ;; We only consider "nil" as a proper value if the property + ;; already exists in the pair. In that case, we will set it to + ;; nil. This allows for removing properties in global + ;; definitions. + (when (or (cdr arg) + (sp-get-pair-definition open t (car arg))) + (plist-put pair (car arg) (cdr arg)))) + (sp--update-pair-list pair t)) + (when (or wrap bind) (global-set-key (read-kbd-macro (or wrap bind)) + `(lambda (&optional arg) + (interactive "*P") + (sp-wrap-with-pair ,open)))) + (when insert (global-set-key (kbd insert) `(lambda () (interactive "*") (sp-insert-pair ,open))))) + (sp--update-local-pairs-everywhere) + sp-pairs) + +(cl-defun sp-local-pair (modes + open + close + &key + trigger + trigger-wrap + (actions '(:add)) + (when '(:add)) + (unless '(:add)) + (pre-handlers '(:add)) + (post-handlers '(:add)) + wrap + bind + insert + prefix + suffix + skip-match) + "Add a local pair definition or override a global definition. + +MODES can be a single mode or a list of modes where these settings +should be applied. + +PREFIX is a regular expression matching an optional prefix for +this pair in the specified major modes. If not specified, the +characters of expression prefix syntax class are automatically +considered instead. This can be used to attach custom prefixes +to pairs, such as prefix \"\\function\" in \\function{arg} in +`LaTeX-mode'. + +SUFFIX is a regular expression matching an optional suffix for +this pair in the specified major modes. If not specified, the +characters of punctuation syntax class are automatically +considered instead. + +The rest of the arguments have same semantics as in `sp-pair'. + +If the pair is not defined globally, ACTIONS defaults to (wrap +insert) instead of (:add) (which inherits global settings) + +The pairs are uniquely identified by the opening delimiter. If you +replace the closing one with a different string in the local +definition, this will override the global closing delimiter. + +The list arguments can optionally be of form starting with +\":add\" or \":rem\" when these mean \"add to the global list\" +and \"remove from the global list\" respectively. Otherwise, +the global list is replaced. If you wish to both add and remove +things with single call, use \"((:add ...) (:rem ...))\" as an +argument. Therefore, + + :when \\='(:add my-test) + +would mean \"use the global settings for this pair, but also this +additional test\". If no value is provided for list arguments, +they default to \"(:add)\" which means they inherit the list from +the global definition. + +To disable a pair in a major mode, simply set its actions set to +nil. This will ensure the pair is not even loaded when the mode is +activated. + +If WRAP is non-nil, the binding is added into major mode keymap +called \"foo-mode-map\". If the mode does not follow this +convention, you will need to bind the function manually (see +`sp-pair' to how the function is named for each particular pair). +The bindings are not added into `smartparens-mode-map' to prevent +clashes between different modes. + +BIND is equivalent to WRAP. It is a legacy setting and will be +removed soon. + +The binding for INSERT follows the same convention as BIND. See +`sp-pair' for more info. + +You can provide a function SKIP-MATCH, that will take three +arguments: the currently matched delimiter, beginning of match +and end of match. If this function returns true, the +`sp-get-paired-expression' matcher will ignore this match. You +can use this to skip over expressions that serve multiple +functions, such as if/end pair or unary if in Ruby or * in +markdown when it signifies list item instead of emphasis. In +addition, there is a global per major-mode option, see +`sp-navigate-skip-match'." + (if (eq actions :rem) + (dolist (m (-flatten (list modes))) + (let ((mode-pairs (assq m sp-pairs))) + (setcdr mode-pairs + (--remove (equal (plist-get it :open) open) + (cdr mode-pairs)))) + (sp-with-buffers-using-mode m + (sp--remove-local-pair open))) + (dolist (m (-flatten (list modes))) + (let* ((pair nil)) + (setq pair (plist-put pair :open open)) + (when close (plist-put pair :close close)) + (when trigger (plist-put pair :trigger trigger)) + (when trigger-wrap (plist-put pair :trigger-wrap trigger-wrap)) + (when prefix (plist-put pair :prefix prefix)) + (when suffix (plist-put pair :suffix suffix)) + (when skip-match (plist-put pair :skip-match skip-match)) + (when (and (not (sp-get-pair-definition open t)) + (equal actions '(:add))) + (setq actions '(wrap insert autoskip navigate))) + (plist-put pair :actions actions) + (plist-put pair :when when) + (plist-put pair :unless unless) + (plist-put pair :pre-handlers pre-handlers) + (plist-put pair :post-handlers post-handlers) + (sp--update-pair-list pair m) + (-when-let* ((symbol (intern (concat (symbol-name m) "-map"))) + (map (and (boundp symbol) (symbol-value symbol)))) + (when (or wrap bind) (define-key map + (read-kbd-macro (or wrap bind)) + `(lambda (&optional arg) + (interactive "*P") + (sp-wrap-with-pair ,open)))) + (when insert (define-key map + (kbd insert) + `(lambda () (interactive "*") (sp-insert-pair ,open)))))))) + (sp--update-local-pairs-everywhere (-flatten (list modes))) + sp-pairs) + +(cl-defun sp-local-tag (modes trig open close &key + (transform 'identity) + (actions '(wrap insert)) + post-handlers) + "Add a tag definition. + +MODES is a mode or a list of modes where this tag should +activate. It is impossible to define global tags. + +TRIG is the trigger sequence. It can be a string of any length. +If more triggers share a common prefix, the shortest trigger is +executed. + +OPEN is the format of the opening tag. This is inserted before +the active region. + +CLOSE is the format of the closing tag. This is inserted after +the active region. + +Opening and closing tags can optionally contain the _ character. + +If the opening tag contains the _ character, after you type the +trigger, the region is wrapped with \"skeleton\" tags and a +special tag editing mode is entered. The text you now type is +substituted for the _ character in the opening tag. + +If the closing tag contains the _ character, the text from the +opening pair is mirrored to the closing pair and substituted for +the _ character. + +TRANSFORM is a function name (symbol) that is called to perform a +transformation of the opening tag text before this is inserted to +the closing tag. For example, in html tag it might simply select +the name of the tag and cut off the tag attributes (like +class/style etc.). Defaults to identity. + +ACTIONS is a list of actions this tag should support. Currently, +only \"wrap\" action is supported. Usually, you don't need to +specify this argument. + +POST-HANDLERS is a list of functions that are called after the +tag is inserted. If the tag does contain the _ character, these +functions are called after the tag editing mode is exited. Each +function on this list should accept two arguments: the trigger +string and the action." + (dolist (mode (-flatten (list modes))) + (let* ((tag-list (assq mode sp-tags)) + (tag (--first (equal trig (plist-get it :trigger)) (cdr tag-list))) + (new-tag nil)) + (setq new-tag (plist-put new-tag :trigger trig)) + (plist-put new-tag :open open) + (plist-put new-tag :close close) + (when transform (plist-put new-tag :transform transform)) + (when actions (plist-put new-tag :actions actions)) + (when post-handlers (plist-put new-tag :post-handlers post-handlers)) + (if tag-list + (if (not actions) + (setcdr tag-list (--remove (equal trig (plist-get it :trigger)) (cdr tag-list))) + (if (not tag) + (setcdr tag-list (cons new-tag (cdr tag-list))) + (sp--update-pair new-tag tag))) + ;; mode doesn't exist + (when actions + (!cons (cons mode (list new-tag)) sp-tags)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Overlay management + +;; burlywood4 +(defface sp-pair-overlay-face + '((t (:inherit highlight))) + "The face used to highlight pair overlays." + :group 'smartparens) + +(defface sp-wrap-overlay-face + '((t (:inherit sp-pair-overlay-face))) + "The face used to highlight wrap overlays. + +When the user wraps a region with multi-character pair a special +insertion mode is entered. This face is used for the overlays +where the possible wrappings are displayed. + +The opening and closing delimiters use +`sp-wrap-overlay-opening-pair' and `sp-wrap-overlay-closing-pair' +respectively." + :group 'smartparens) + +(defface sp-wrap-overlay-opening-pair + '((t (:inherit sp-wrap-overlay-face + :foreground "green"))) + "The face used to highlight opening pairs for wrapping. + +See `sp-wrap-overlay-face'." + :group 'smartparens) + +(defface sp-wrap-overlay-closing-pair + '((t (:inherit sp-wrap-overlay-face + :foreground "red"))) + "The face used to highlight closing pairs for wrapping. + +See `sp-wrap-overlay-face'." + :group 'smartparens) + +(defface sp-wrap-tag-overlay-face + '((t (:inherit sp-pair-overlay-face))) + "The face used to highlight wrap tag overlays." + :group 'smartparens) + +(defvar-local sp-pair-overlay-list '() + "List of overlays used for tracking inserted pairs. + +When a pair is inserted, an overlay is created over it. When the +user starts typing the closing pair we will not insert it again. +If user leaves the overlay, it is canceled and the insertion +works again as usual.") + +(defvar-local sp-wrap-overlays nil + "Cons pair of wrap overlays.") + +(defvar-local sp-wrap-tag-overlays nil + "Cons pair of tag wrap overlays.") + +(defvar sp-pair-overlay-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-g") + '(menu-item nil sp-remove-active-pair-overlay :filter + (lambda (cmd) + (unless (bound-and-true-p company-my-keymap) + cmd)))) + map) + "Keymap for the pair overlays.") + +(defvar sp-wrap-overlay-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-g") 'sp-wrap-cancel) + map) + "Keymap for the wrap overlays.") + +(defun sp--overlays-at (&optional pos) + "Wrapper around `overlays-at' to get smartparens overlays. + +POS is the same as for `overlays-at'. + +Smartparens functions must use this function instead of +`overlays-at' directly." + ;; TODO: we should probably also check the returned value + (--filter (overlay-get it 'type) (overlays-at (or pos (point))))) + +(defun sp--point-in-overlay-p (overlay) + "Return t if point is in OVERLAY." + (and (< (point) (overlay-end overlay)) + (> (point) (overlay-start overlay)))) + +(defun sp--get-overlay-length (overlay) + "Compute the length of OVERLAY." + (- (overlay-end overlay) (overlay-start overlay))) + +(defun sp--get-active-overlay (&optional type) + "Get active overlay. + +Active overlay is the shortest overlay at point. Optional +argument TYPE restrict overlays to only those with given type." + (let ((overlays (sp--overlays-at))) + (when type + (setq overlays (--filter (eq (overlay-get it 'type) type) overlays))) + (cond + ((not overlays) nil) + ((not (cdr overlays)) (car overlays)) + (t + (--reduce (if (< (sp--get-overlay-length it) (sp--get-overlay-length acc)) it acc) overlays))))) + +(defun sp--pair-overlay-create (start end id) + "Create an overlay over the currently inserted pair. + +This overlay is used for tracking the position of the point and +marks the active expression. START and END are the boundaries of +the overlay, ID is the id of the pair." + (let ((overlay (make-overlay start end))) + ;; set priority to 99 so that yasnippet with 100 overloads the + ;; keymap #625 + (overlay-put overlay 'priority 99) + (overlay-put overlay 'keymap sp-pair-overlay-keymap) + (overlay-put overlay 'pair-id id) + (overlay-put overlay 'type 'pair) + (!cons overlay sp-pair-overlay-list) + (sp--pair-overlay-fix-highlight) + (add-hook 'post-command-hook 'sp--pair-overlay-post-command-handler nil t))) + +(defun sp-wrap-cancel () + "Cancel the active wrapping." + (interactive) + (unwind-protect + (-let (((obeg . oend) sp-wrap-overlays)) + (when (and (not (called-interactively-p 'any)) + (sp--delete-selection-p)) + (kill-region (overlay-end obeg) (overlay-start oend))) + (delete-region (overlay-start oend) (overlay-end oend)) + (when (> sp-wrap-point sp-wrap-mark) + (let ((beg (delete-and-extract-region (overlay-start obeg) (overlay-end obeg)))) + (goto-char (overlay-start oend)) + (insert beg)))) + (sp-wrap--clean-overlays))) + +(defun sp-wrap--clean-overlays () + "Delete wrap overlays." + (-let [(obeg . oend) sp-wrap-overlays] + (delete-overlay obeg) + (delete-overlay oend) + (setq sp-wrap-overlays nil))) + +(defun sp--pair-overlay-fix-highlight () + "Fix highlighting of the pair overlays. + +Only the active overlay should be highlighted." + (--each (sp--overlays-at) (overlay-put it 'face nil)) + (let* ((active (sp--get-active-overlay)) + (type (and active (overlay-get active 'type)))) + (if active + (cond + ((eq 'wrap-tag type) + (when sp-highlight-wrap-tag-overlay + (overlay-put active 'face 'sp-wrap-tag-overlay-face))) + ((eq 'pair type) + (when sp-highlight-pair-overlay + (overlay-put active 'face 'sp-pair-overlay-face)))) + ;; edge case where we're at the end of active overlay. If + ;; there is a wrap-tag overlay, restore it's face + (when sp-wrap-tag-overlays + (overlay-put (car sp-wrap-tag-overlays) 'face 'sp-wrap-tag-overlay-face))))) + +(defun sp--pair-overlay-post-command-handler () + "Remove all invalid pair overlays. + +An invalid overlay is one that doesn't have point inside it or +is of zero length. + +Also remove all pair overlays if point moved backwards and +`sp-cancel-autoskip-on-backward-movement' is non-nil." + ;; if the point moved backwards, remove all overlays + (if (and sp-cancel-autoskip-on-backward-movement + (< (point) sp-previous-point)) + (dolist (o sp-pair-overlay-list) (sp--remove-overlay o)) + ;; else only remove the overlays where point is outside them or + ;; their length is zero + (dolist (o (--remove (and (sp--point-in-overlay-p it) + (> (sp--get-overlay-length it) 0)) + sp-pair-overlay-list)) + (sp--remove-overlay o))) + (when sp-pair-overlay-list + (setq sp-previous-point (point)))) + +(defun sp--reset-memoization (&rest ignored) + "Reset memoization as a safety precaution. + +IGNORED is a dummy argument used to eat up arguments passed from +the hook where this is executed." + (setf (sp-state-last-syntax-ppss-point sp-state) nil + (sp-state-last-syntax-ppss-result sp-state) nil)) + +(defun sp-remove-active-pair-overlay () + "Deactivate the active overlay. See `sp--get-active-overlay'." + (interactive) + (-when-let (active-overlay (sp--get-active-overlay 'pair)) + (sp--remove-overlay active-overlay))) + +(defun sp--remove-overlay (overlay) + "Remove OVERLAY." + ;; if it's not a pair overlay, nothing happens here anyway + (setq sp-pair-overlay-list (--remove (equal it overlay) sp-pair-overlay-list)) + ;; if we have zero pair overlays, remove the post-command hook + (when (not sp-pair-overlay-list) + (remove-hook 'post-command-hook 'sp--pair-overlay-post-command-handler t) + ;; this is only updated when sp--pair-overlay-post-command-handler + ;; is active. Therefore, we need to reset this to 1. If not, newly + ;; created overlay could be removed right after creation - if + ;; sp-previous-point was greater than actual point + (setq sp-previous-point -1)) + (delete-overlay overlay) + (sp--pair-overlay-fix-highlight)) + +(defun sp--replace-overlay-text (o string) + "Replace text inside overlay O with STRING." + (save-excursion + (goto-char (overlay-start o)) + (insert string) + (delete-region (point) (overlay-end o)))) + +(defun sp--get-overlay-text (o) + "Get text inside overlay O." + (buffer-substring (overlay-start o) (overlay-end o))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Action predicates + +(defun sp-in-string-p (_id _action context) + "Return t if point is inside string or comment, nil otherwise." + (eq context 'string)) + +(defun sp-in-string-quotes-p (_id action context) + "Special string test for quotes. + +On insert action, test the string context one character back from +point. Return nil at `bobp'. + +On escape action use the value of CONTEXT." + (cond + ((eq action 'insert) + (if (bobp) nil + (save-excursion (backward-char 1) (sp-point-in-string)))) + ((eq action 'escape) + (eq context 'string)))) + +(defun sp-in-docstring-p (_id _action context) + "Return t if point is inside elisp docstring, nil otherwise." + (and (eq context 'string) + (save-excursion + (--when-let (car (sp-get-quoted-string-bounds)) + (goto-char it) + (ignore-errors (backward-sexp 3)) + (looking-at-p (regexp-opt '("defun" "defmacro" + "cl-defun" "cl-defmacro" + "defun*" "defmacro*" + "lambda" "-lambda"))))))) + +(defun sp-in-code-p (_id _action context) + "Return t if point is inside code, nil otherwise." + (eq context 'code)) + +(defun sp-in-comment-p (_id _action context) + "Return t if point is inside comment, nil otherwise." + (eq context 'comment)) + +(defun sp-in-math-p (_id _action _context) + "Return t if point is inside code, nil otherwise." + (when (functionp 'texmathp) + (texmathp))) + +(defun sp-point-before-eol-p (_id action _context) + "Return t if point is followed by optional white spaces and end of +line, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-at-p "\\s-*$"))) + +(defun sp-point-after-bol-p (id action _context) + "Return t if point follows beginning of line and possibly white +spaces, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-back-p (concat "^\\s-*" (regexp-quote id))))) + +(defun sp-point-at-bol-p (id action _context) + "Return t if point is at the beginning of line, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-back-p (concat "^" (regexp-quote id))))) + +(defun sp-point-before-symbol-p (_id action _context) + "Return t if point is followed by a symbol, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-at-p "\\s_"))) + +(defun sp-point-before-word-p (_id action _context) + "Return t if point is followed by a word, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-at-p "\\sw\\|\\s_"))) + +(defun sp-point-after-word-p (id action _context) + "Return t if point is after a word, nil otherwise. +This predicate is only tested on \"insert\" action." + ;; TODO: remove condition with sp-defpair + (when (memq action '(insert escape)) + (sp--looking-back-p (concat "\\(\\sw\\|\\s_\\)" (regexp-quote id))))) + +(defun sp-point-before-same-p (id action _context) + "Return t if point is followed by ID, nil otherwise. +This predicate is only tested on \"insert\" action." + (when (eq action 'insert) + (sp--looking-at-p (regexp-quote id)))) + +(defun sp-point-in-empty-line-p (id _action _context) + "Return t if point is on an empty line, nil otherwise." + (and (sp--looking-at-p "\\s-*$") + (sp--looking-back-p (concat "^\\s-*" (regexp-quote id))))) + +(defun sp-char-escaped-p (_id action _context) + "Return non-nil if character before point is escaped with \\." + (when (eq action 'insert) + (unless (= (point) (point-min)) + (save-excursion + (backward-char 1) + (looking-back "\\\\" 1))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Pair insertion/deletion/skipping + +(defun sp--do-action-p (id action &optional use-inside-string) + "Return t if pair ID can perform ACTION. + +If ACTION is a list, return t if at least one action from the +list can be performed. + +If USE-INSIDE-STRING is non-nil, use value of +`sp-point-inside-string' instead of testing with +`sp-point-in-string-or-comment'." + (setq action (-flatten (list action))) + (let* ((actions (sp-get-pair id :actions)) + (when-l (sp-get-pair id :when)) + (unless-l (sp-get-pair id :unless)) + (in-string (if use-inside-string + sp-point-inside-string + (sp-point-in-string))) + (context (cond + (in-string 'string) + ((sp-point-in-comment) 'comment) + (t 'code))) + a r) + (while (and action (not r)) + (setq a (car action)) + (setq r (when (memq a actions) + ;;(and (when-clause) (not (unless-clause))) + (and (or (not when-l) + (--some (funcall it id a context) when-l)) + (or (not unless-l) + (not (--some (funcall it id a context) unless-l)))))) + (!cdr action)) + r)) + +(defun sp--get-handler-context (type) + "Return the context constant. TYPE is type of the handler." + (let ((in-string (cl-case type + (:pre-handlers + (save-excursion + (unless (bobp) (backward-char 1)) + (sp-point-in-string-or-comment))) + (:post-handlers + (sp-point-in-string-or-comment))))) + (if in-string 'string 'code))) + +(defun sp--get-context (&optional point in-string in-comment) + "Return the context of POINT. + +If the optional arguments IN-STRING or IN-COMMENT non-nil, their +value is used instead of a test." + (save-excursion + (goto-char (or point (point))) + (cond + ((or in-string (sp-point-in-string)) 'string) + ((or in-comment (sp-point-in-comment)) 'comment) + (t 'code)))) + +(defun sp--parse-insertion-spec (fun) + "Parse the insertion specification FUN and return a form to evaluate." + (let ((spec nil) + (after nil) + (last 1)) + (cl-labels ((push-non-empty + (what) + (unless (equal (cadr what) "") + (push what spec)))) + (with-temp-buffer + (insert fun) + (goto-char (point-min)) + (while (re-search-forward "\\(|\\|\\[\\)" nil t) + (cond + ((equal (match-string 0) "[") + (if (save-excursion (backward-char 1) (eq (preceding-char) 92)) + (push-non-empty `(insert ,(concat (buffer-substring-no-properties last (- (point) 2)) "["))) + (push-non-empty `(insert ,(buffer-substring-no-properties last (1- (point))))) + (let* ((p (point)) + (fun-end (progn + (re-search-forward "]" nil t) + (1- (point)))) + (fun-spec (buffer-substring-no-properties p fun-end)) + (instruction (cond + ((equal fun-spec "i") + '(indent-according-to-mode)) + ((equal (aref fun-spec 0) ?d) + `(delete-char ,(string-to-number (substring fun-spec 1))))))) + (when instruction (push instruction spec))))) + ((equal (match-string 0) "|") + (cond + ((save-excursion (backward-char 1) (eq (preceding-char) 92)) + (push-non-empty `(insert ,(concat (buffer-substring-no-properties last (- (point) 2)) "|")))) + (t + (push-non-empty `(insert ,(buffer-substring-no-properties last (1- (point))))) + (push 'save-excursion spec) + (when (eq (following-char) 124) + (forward-char 1) + (setq after '(indent-according-to-mode))))))) + (setq last (point))) + (push-non-empty `(insert ,(buffer-substring-no-properties last (point-max))))) + (let* ((specr (nreverse spec)) + (specsplit (--split-with (not (eq it 'save-excursion)) specr)) + (re (-concat (car specsplit) (if (cadr specsplit) (cdr specsplit) nil)))) + (cons 'progn (if after (-snoc re after) re)))))) + +(defun sp--run-function-or-insertion (fun id action context) + "Run a function or insertion. + +If FUN is a function, call it with `funcall' with ID, ACTION and +CONTEXT as arguments. + +If FUN is a string, interpret it as \"insertion specification\", +see `sp-pair' for description." + (cond + ((functionp fun) + (funcall fun id action context)) + ((stringp fun) + (eval (sp--parse-insertion-spec fun))))) + + +(defvar sp-handler-context nil + "Special variable holding context during handler execution.") + +;; TODO: get rid of `sp-handler-context' and make all the handlers (we +;; should call them hooks) take better arguments, what we pass now is +;; useless almost always +(defun sp--run-hook-with-args (id type action &optional context-values) + "Run all the hooks for pair ID of type TYPE on action ACTION. + +CONTEXT-VALUES is a plist with arbitrary values (depending on the +action). A dynamic varable `sp-handler-context' will be bound to +this value during execution of the handler." + (ignore-errors + (let ((hook (sp-get-pair id type)) + (context (sp--get-handler-context type))) + (if hook + (let ((sp-handler-context context-values)) + (--each hook (sp--run-function-or-insertion it id action context))) + (run-hook-with-args 'tag-hook id action context))))) + +;; TODO: add a test for a symbol property that would tell this handler +;; not to re=set `sp-last-operation'. Useful for example in "macro +;; functions" like `my-wrap-with-paren'. +(defun sp--post-command-hook-handler () + "Handle the situation after some command has executed." + (sp--with-case-sensitive + (when (sp--special-self-insert-command-p) + (sp--post-self-insert-hook-handler)) + (ignore-errors + (when smartparens-mode + ;; handle the wrap overlays + (when sp-wrap-overlays + (let* ((overlay (car sp-wrap-overlays)) + (start (overlay-start overlay)) + (end (overlay-end overlay)) + (p (point))) + (when (or (< p sp-previous-point) + (> p end) + (< p start)) + (sp-wrap-cancel)))) + (when sp-wrap-overlays + (setq sp-previous-point (point))) + + ;; Here we run the delayed hooks. See issue #80 + (cond + ((eq (car-safe (sp-state-delayed-hook sp-state)) :next) + (setf (car (sp-state-delayed-hook sp-state)) :this)) + ((eq (car-safe (sp-state-delayed-hook sp-state)) :this) + (let* ((pair (cdr (sp-state-delayed-hook sp-state))) + (hooks (sp-get-pair pair :post-handlers-cond))) + (--each hooks + (let ((fun (car it)) + (conds (cdr it))) + (when (or (--any? (eq this-command it) conds) + (--any? (equal (single-key-description last-command-event) it) conds)) + (sp--run-function-or-insertion + fun pair 'insert + (sp--get-handler-context :post-handlers))))) + (setf (sp-state-delayed-hook sp-state) nil) + (setq sp-last-inserted-pair nil)))) + + ;; Here we run the delayed insertion. Some details in issue #113 + (when (and (not (eq sp-last-operation 'sp-insert-pair-delayed)) + sp-delayed-pair) + (let* ((pair (car sp-delayed-pair)) + (beg (cdr sp-delayed-pair)) + (conds (sp-get-pair pair :when-cond)) + (open-pair pair) + (close-pair (sp-get-pair pair :close))) + (when (and conds + (--any? (cond + ((and (commandp it) + (not (stringp it))) + (eq this-command it)) + ((stringp it) + (equal (single-key-description last-command-event) it)) + ((ignore-errors (funcall it pair 'insert (sp--get-handler-context :post-handlers))))) conds)) + ;; TODO: refactor this and the same code in + ;; `sp-insert-pair' to a separate function + (sp--run-hook-with-args open-pair :pre-handlers 'insert) + (insert close-pair) + (backward-char (length close-pair)) + (sp--pair-overlay-create beg + (+ (point) (length close-pair)) + open-pair) + ;; no auto-escape here? Should be fairly safe + (sp--run-hook-with-args open-pair :post-handlers 'insert) + (setq sp-last-inserted-pair open-pair) + ;; TODO: this is probably useless + (setq sp-last-operation 'sp-insert-pair))) + (setq sp-delayed-pair nil)) + + (when (eq sp-last-operation 'sp-insert-pair-delayed) + (setq sp-last-operation nil)) + + (unless (or (sp--self-insert-command-p) + (sp--special-self-insert-command-p)) + ;; unless the last command was a self-insert, remove the + ;; information about the last wrapped region. It is only used + ;; for: 1. deleting the wrapping immediately after the wrap, + ;; 2. re-wrapping region immediatelly after a sucessful wrap. + ;; Therefore, the deletion should have no ill-effect. If the + ;; necessity will arise, we can add a different flag. + (setq sp-last-wrapped-region nil) + (setq sp-last-operation nil)) + + (when show-smartparens-mode + (if (member this-command sp-show-enclosing-pair-commands) + (sp-show--pair-enc-function) + (when (not (eq this-command 'sp-highlight-current-sexp)) + (sp-show--pair-delete-enc-overlays)))))))) + +(defmacro sp--setaction (action &rest forms) + "Use ACTION as a flag to evaluating FORMS. + +If ACTION is nil, evaluate FORMS and set it to the value of the +last form; otherwise do nothing." + (declare (debug (form body))) + `(unless ,action + (setq ,action (progn ,@forms)))) + +;; TODO: this introduces a regression, where doing C-4 [ inserts [[[[] +;; figure out how to detect the argument to self-insert-command that +;; resulted to this insertion +(defun sp--post-self-insert-hook-handler () + "Handler for `post-self-insert-hook'." + (with-demoted-errors "sp--post-self-insert-hook-handler: %S" + (when smartparens-mode + (sp--with-case-sensitive + (catch 'done + (let (action) + (when (region-active-p) + (condition-case err + (sp-wrap--initialize) + (user-error + (message (error-message-string err)) + ;; we need to remove the undo record of the insertion + (unless (eq buffer-undo-list t) + ;; pop all undo info until we hit an insertion node + (sp--undo-pop-to-last-insertion-node) + ;; get rid of it and insert an undo boundary marker + (pop buffer-undo-list) + (undo-boundary)) + (restore-buffer-modified-p sp-buffer-modified-p) + (throw 'done nil)))) + (cond + (sp-wrap-overlays + (sp-wrap)) + (t + ;; TODO: this does not pick correct pair!! it uses insert and not wrapping code + (sp--setaction + action + (-when-let ((_ . open-pairs) (sp--all-pairs-to-insert nil 'wrap)) + (catch 'done + (-each open-pairs + (-lambda ((&keys :open open :close close)) + (--when-let (sp--wrap-repeat-last (cons open close)) + (throw 'done it))))))) + (unless overwrite-mode (sp--setaction action (sp-insert-pair))) + (sp--setaction action (sp-skip-closing-pair)) + (unless action (sp-escape-open-delimiter)) + ;; if nothing happened, we just inserted a character, so + ;; set the apropriate operation. + (unless action + (setq sp-last-operation 'sp-self-insert)))))))))) + +;; TODO: make a proper data structure for state tracking and describe +;; why we need each of these. +(defun sp--save-pre-command-state () + "Save some of the buffer state before `pre-command-hook'." + (when smartparens-mode + (setq sp-point-inside-string (sp-point-in-string)) + (setq sp-pre-command-point (point)) + (setq sp-buffer-modified-p (buffer-modified-p)))) + +(defun sp--get-pair-list () + "Get all non-stringlike pairs. + +Return all pairs that are recognized in this `major-mode' and do +not have same opening and closing delimiter. This is used for +navigation functions." + (--filter (not (string= (car it) (cdr it))) sp-pair-list)) + +(defun sp--get-stringlike-list () + "Get all string-like pairs. + +Return all pairs that are recognized in this `major-mode' that +have same opening and closing delimiter." + (--filter (string= (car it) (cdr it)) sp-pair-list)) + +(defun sp--get-allowed-pair-list () + "Get all allowed non string-like pairs. + +Return all pairs that are recognized in this `major-mode', do not +have same opening and closing delimiter and are allowed in the +current context. See also `sp--get-pair-list'." + (--filter (and (sp--do-action-p (car it) 'navigate) + (not (equal (car it) (cdr it)))) sp-pair-list)) + +(defun sp--get-allowed-stringlike-list () + "Get all allowed string-like pairs. + +Return all pairs that are recognized in this `major-mode', +have the same opening and closing delimiter and are allowed in +the current context." + (--filter (and (sp--do-action-p (car it) 'navigate) + (equal (car it) (cdr it))) sp-pair-list)) + +(defun sp--get-pair-list-context (&optional action) + "Return all pairs that are recognized in this `major-mode' and +are allowed in the current context." + (setq action (or action 'insert)) + (--filter (sp--do-action-p (car it) action) sp-pair-list)) + +(defun sp--get-pair-list-wrap () + "Return the list of all pairs that can be used for wrapping." + (--filter (sp--do-action-p (car it) 'wrap) sp-pair-list)) + +(defun sp--wrap-regexp (string start end) + "Wraps regexp with start and end boundary conditions to avoid +matching symbols in symbols." + (concat "\\(?:" (when start "\\<") string (when end "\\>") "\\)")) + +(defun sp--regexp-for-group (parens &rest strings) + "Generates an optimized regexp matching all string, but with +extra boundary conditions depending on parens." + (let* ((start (car parens)) + (end (cadr parens))) + (sp--wrap-regexp (regexp-opt strings) start end))) + +(defun sp--strict-regexp-opt (strings &optional ignored) + "Like regexp-opt, but with extra boundary conditions to ensure +that the strings are not matched in-symbol." + (if strings + (with-syntax-table + ;; HACK: this is a terrible hack to make ' be treated as a + ;; punctuation. Many text modes set it as word character which + ;; messes up the regexps + (let ((table (make-syntax-table (syntax-table)))) + (modify-syntax-entry ?' "." table) + table) + (--> strings + (-group-by (lambda (string) + (list (and (string-match-p "\\`\\<" string) t) + (and (string-match-p "\\>\\'" string) t))) + it) + (mapconcat (lambda (g) (apply 'sp--regexp-for-group g)) it "\\|") + (concat "\\(?:" it "\\)"))) + "^\\<$")) + +(defun sp--strict-regexp-quote (string) + "Like regexp-quote, but make sure that the string is not +matched in-symbol." + (sp--wrap-regexp (regexp-quote string) + (string-match-p "\\`\\<" string) + (string-match-p "\\>\\'" string))) + +(cl-defun sp--get-opening-regexp (&optional (pair-list (sp--get-pair-list))) + "Return regexp matching any opening pair." + (sp--strict-regexp-opt (--map (car it) pair-list))) + +(cl-defun sp--get-closing-regexp (&optional (pair-list (sp--get-pair-list))) + "Return regexp matching any closing pair." + (sp--strict-regexp-opt (--map (cdr it) pair-list))) + +(cl-defun sp--get-allowed-regexp (&optional (pair-list (sp--get-allowed-pair-list))) + "Return regexp matching any opening or closing +delimiter for any pair allowed in current context." + (sp--strict-regexp-opt (--mapcat (list (car it) (cdr it)) pair-list))) + +(cl-defun sp--get-stringlike-regexp (&optional (pair-list (sp--get-allowed-stringlike-list))) + "Return a regexp matching any string-like delimiter. + +In case PAIR-LIST is empty return a regexp that never matches +anything." + (if (consp pair-list) + (regexp-opt (--map (car it) pair-list)) + "^\\<$")) + +(defun sp--make-last-wraped-region (beg end open close) + "Return `sp-get-sexp' style plist about the last wrapped region. + +Note: this function does not retrieve the actual value of +`sp-last-wrapped-region', it merely construct the plist from the +provided values." + (let ((b (make-marker)) + (e (make-marker))) + (set-marker b beg) + (set-marker e end) + `(:beg ,b :end ,e :op ,open :cl ,close :prefix ""))) + +;; Wrapping is basically the same thing as insertion, only the closing +;; pair is placed at a distance. + +;; However, we want to be able to insert the *closing* delimiter and +;; go to the end of block. This will only work with delimiters which +;; are unique wrt their opening one. For more complex wrapping, there +;; will probably be an IDO/minibuffer interface. Openings are checked +;; first. + +;; Inserting the opening delimiter should put the point wherever it +;; was when we started insertion. + +(defun sp-wrap--can-wrap-p () + "Return non-nil if we can wrap a region. + +This is used in advices on various pre-command-hooks from +\"selection deleting\" modes to intercept their actions. + +Also added to `self-insert-uses-region-functions' to prevent +`delete-selection-mode' from replacing the region." + (let* ((list (sp--get-pair-list-wrap)) + (desc (sp--single-key-description last-command-event))) + (--any? (or (string-prefix-p desc (car it)) + (string-prefix-p desc (cdr it))) + list))) + +(defun sp--pair-to-wrap-comparator (prop a b) + "Comparator for wrapping pair selection. + +PROP specifies wrapping-end. A and B are pairs to be compared." + (< (length (plist-get a prop)) (length (plist-get b prop)))) + +(defun sp--pair-to-wrap (&optional prefix) + "Return information about possible wrapping pairs. + +If optional PREFIX is non-nil, this is used to determine the +possible wrapping pairs instead of the text in the wrapping +overlay." + (let* ((working-pairs + ;; TODO: abstract this into a new "sp--get-..." hierarchy + (--filter (sp--do-action-p (plist-get it :open) 'wrap) sp-local-pairs)) + (obeg (car sp-wrap-overlays)) + (prefix (or prefix (sp--get-overlay-text obeg))) + (opening-pairs (--filter (string-prefix-p prefix (plist-get it :open)) working-pairs)) + ;; HACK: Here, we will add special "trigger pairs" to the + ;; opening list. We set the opening delimiter to the + ;; trigger, leave the rest alone and put the real open into + ;; :open-real property. When we get the pair back, we will + ;; check this property, and if present, fix the pair back to + ;; the regular form + (wrapper-pairs (->> (--filter (string-prefix-p prefix (or (plist-get it :trigger-wrap) "")) working-pairs) + (-map (-lambda ((pair &as &plist :open open :trigger-wrap trigger-wrap)) + (setq pair (copy-sequence pair)) + (setq pair (plist-put pair :open trigger-wrap)) + (setq pair (plist-put pair :open-real open)) + pair)))) + (opening-pairs (-concat wrapper-pairs opening-pairs)) + (closing-pairs (--filter (string-prefix-p prefix (plist-get it :close)) working-pairs)) + (open (car (--sort (sp--pair-to-wrap-comparator :open it other) opening-pairs))) + ;; TODO: do we need the special sorting here? + (close (car (--sort (sp--pair-to-wrap-comparator :close it other) closing-pairs)))) + (list :open open + :close close + :opening opening-pairs + :closing closing-pairs))) + +(defun sp-wrap--initialize () + "Initialize wrapping." + (when (and sp-autowrap-region + (sp-wrap--can-wrap-p)) + ;; This is the length of string which was inserted by the last + ;; "self-insert" action. Typically this is 1, but sometimes a + ;; single key inserts two or more characters, such as " in latex + ;; where it translates into `` or ''. + (let ((inserted-string-length (- (point) sp-pre-command-point))) + ;; TODO: get rid of the following variables + (setq sp-wrap-point (- (point) inserted-string-length)) + (setq sp-wrap-mark (mark)) + ;; balance check + (with-silent-modifications + (let ((inserted-string + (prog1 (delete-and-extract-region sp-wrap-point (point)) + ;; HACK: in modes with string fences, the insertion + ;; of the delimiter causes `syntax-propertize' to + ;; fire, but the above deletion doesn't re-run it + ;; because the cache tells it the state is OK. We + ;; need to destroy the cache and re-run the + ;; `syntax-propertize' on the buffer. This might be + ;; expensive, but we only done this on wrap-init so + ;; it's fine, I guess. + (setq syntax-propertize--done -1) + (syntax-propertize (point-max)))) + (point-string-context (sp-get-quoted-string-bounds sp-wrap-point)) + (mark-string-context (sp-get-quoted-string-bounds (mark)))) + ;; If point and mark are inside the same string, we don't + ;; need to check if the region is OK. If both are outisde + ;; strings, we have to. If one is inside and the other is + ;; not, no matter what we would break, so we exit. + (cond + ;; inside the same string + ((and point-string-context mark-string-context + (eq (car point-string-context) + (car mark-string-context)))) + ;; neither is inside string + ((and (not point-string-context) + (not mark-string-context)) + (unless (sp-region-ok-p sp-wrap-point (mark)) + (user-error "Mismatched sexp state: wrapping would break structure"))) + ;; one is in and the other isn't + ((if point-string-context (not mark-string-context) mark-string-context) + (user-error "Mismatched string state: point %sin string, mark %sin string" + (if (car-safe point-string-context) "" "not ") + (if (car-safe mark-string-context) "" "not "))) + ;; both are in but in different strings + (t (user-error "Mismatched string state: point and mark are inside different strings"))) + (insert inserted-string))) + ;; if point > mark, we need to move point to mark and reinsert the + ;; just inserted character. + (when (> (point) (mark)) + (let ((char (delete-and-extract-region (- (point) inserted-string-length) (point)))) + (exchange-point-and-mark) + (insert char))) + (let* ((oleft (make-overlay (- (region-beginning) inserted-string-length) + (region-beginning) nil nil t)) + (oright (make-overlay (region-end) (region-end) nil nil t))) + (setq sp-wrap-overlays (cons oleft oright)) + (when sp-highlight-wrap-overlay + (overlay-put oleft 'face 'sp-wrap-overlay-face) + (overlay-put oright 'face 'sp-wrap-overlay-face)) + (overlay-put oleft 'priority 100) + (overlay-put oright 'priority 100) + (overlay-put oleft 'keymap sp-wrap-overlay-keymap) + (overlay-put oleft 'type 'wrap) + (setq sp-previous-point (point)) + (goto-char (1+ (overlay-start oleft))))))) + +(defun sp-wrap--finalize (wrapping-end open close) + "Finalize a successful wrapping. + +WRAPPING-END specifies the wrapping end. If we wrapped using +opening delimiter it is :open. If we wrapped using closing +delimiter it is :close. Position of point after wrapping depends +on this value---if :open, go where the wrapping was initalized, +if :close, go after the newly-formed sexp. + +OPEN and CLOSE are the delimiters." + (-let (((obeg . oend) sp-wrap-overlays)) + (sp--replace-overlay-text obeg open) + (sp--replace-overlay-text oend close) + (setq sp-last-operation 'sp-wrap-region) + (setq sp-last-wrapped-region + (sp--make-last-wraped-region + (overlay-start obeg) (overlay-end oend) + open close)) + (cond + ((eq wrapping-end :open) + (if sp-wrap-respect-direction + (progn + (set-mark (overlay-end oend)) + (goto-char (overlay-start obeg))) + (when (> sp-wrap-point sp-wrap-mark) + (set-mark (overlay-start obeg)) + (goto-char (overlay-end oend))))) + ((eq wrapping-end :close) + (set-mark (overlay-start obeg)) + (goto-char (overlay-end oend)))) + (sp-wrap--clean-overlays) + (sp--run-hook-with-args open :post-handlers 'wrap))) + +(defun sp-wrap () + "Try to wrap the active region with some pair. + +This function is not ment to be used to wrap sexps with pairs +programatically. Use `sp-wrap-with-pair' instead." + (-let* (((&plist :open open :close close + :opening opening-pairs + :closing closing-pairs) (sp--pair-to-wrap)) + ((obeg . oend) sp-wrap-overlays)) + (cond + (open + (-let (((&plist :open open :close close :open-real open-real) open)) + (when sp-wrap-show-possible-pairs + (overlay-put + oend 'after-string + (mapconcat (lambda (x) + (if sp-highlight-wrap-overlay + (concat + (propertize + (plist-get x :open) 'face + 'sp-wrap-overlay-opening-pair) + (propertize + (plist-get x :close) + 'face 'sp-wrap-overlay-closing-pair)) + (concat (plist-get x :open) (plist-get x :close)))) + opening-pairs " "))) + (when (equal (sp--get-overlay-text obeg) open) + (sp-wrap--finalize :open (or open-real open) close)))) + ((and close (= 1 (length closing-pairs))) + (-let (((&plist :open open :close close) close)) + (when (equal (sp--get-overlay-text obeg) close) + (sp-wrap--finalize :close open close)))) + (t + (sp-wrap-cancel))))) + +(defun sp--escape-region (chars-to-escape beg end) + "Escape instances of CHARS-TO-ESCAPE between BEG and END. + +Return non-nil if at least one escaping was performed." + (save-excursion + (goto-char beg) + (let ((pattern (regexp-opt chars-to-escape)) + (end-marker (set-marker (make-marker) end)) + (re nil)) + (while (re-search-forward pattern end-marker t) + (setq re t) + (save-excursion + (goto-char (match-beginning 0)) + (insert sp-escape-char))) + re))) + +;; TODO: refactor the rewrap-sexp dependent parts out so that this +;; function has less dependencies on the action +;; TODO: add mode-dependent escape/unescape actions? +(defun sp-escape-wrapped-region (id action _context) + "Escape quotes and special chars when a region is (re)wrapped." + (when (and sp-escape-wrapped-region + (memq action '(wrap rewrap-sexp))) + (sp-get sp-last-wrapped-region + (let* ((parent-delim (save-excursion + (goto-char :beg) + (sp-get (sp-get-string) + (cond + ((and (< :beg (point)) + (< (point) :end)) + :op) + ((eq action 'rewrap-sexp) + (plist-get sp-handler-context :parent))))))) + (cond + ((equal parent-delim id) + (sp--escape-region (list id sp-escape-char) :beg :end)) + (parent-delim + (sp--escape-region (list id) :beg-in :end-in)) + (t + (sp--escape-region (list id sp-escape-char) :beg-in :end-in))))))) + +(defun sp-escape-quotes-after-insert (id action context) + "Escape quotes inserted via `sp-insert-pair'." + (when (and sp-escape-quotes-after-insert + (eq action 'insert) + ;; we test not being inside string because if we were + ;; before inserting the "" pair it is now split into two + ;; -> which moves us outside the pair + (not (eq context 'string)) + ;; the inserted character must have string syntax, + ;; otherwise no "context" flip happens + (eq (syntax-class + (syntax-after + (save-excursion + (backward-char (length id)) + (point)))) 7)) + (let ((open id) + (close (sp-get-pair id :close))) + (sp--escape-region (list open close) + (- (point) (length open)) + (+ (point) (length close)))))) + +(defun sp--buffer-is-string-balanced-p () + "Check if the buffer is string-balanced. + +A string-balanced buffer is one where where is no unclosed +string, that is, the string state at the end of the buffer is +\"closed\"." + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (let ((syntax (sp--syntax-ppss))) + (or (< (car syntax) 0) + (nth 3 syntax)))))) + +(defun sp-escape-open-delimiter () + "Escape just inserted opening pair if `sp-insert-pair' was skipped. + +This is useful for escaping of \" inside strings when its pairing +is disabled. This way, we can control autoescape and closing +delimiter insertion separately." + (-when-let (open (plist-get (sp--pair-to-insert 'escape) :open)) + (when (and (sp--do-action-p open 'escape) + sp-point-inside-string + ;; do not escape if we are looking at a closing + ;; delimiter, that means we closed an opened string, + ;; most likely. + (sp--buffer-is-string-balanced-p) + ;; in some text modes like org-mode which do not + ;; respect escapes, an "escaped" quote will still + ;; behave as regular quote, but we want to ignore it to + ;; be logically consistent. This will prevent a buffer + ;; with \" followed by newly inserted " auto-escaping + ;; the inserted quotes (which actually closes the + ;; string and makes the buffer balanced) + (save-excursion + (backward-char (length open)) + (-when-let (string-start (nth 8 (sp--syntax-ppss))) + (goto-char string-start) + (not (sp-char-is-escaped-p))))) + (sp--escape-region (list open) (- (point) (length open)) (point))))) + +;; kept to not break people's config... remove later +(defun sp-match-sgml-tags (tag) + "Split the html tag TAG at the first space and return its name." + (let* ((split (split-string tag " ")) + (close (car split))) + close)) +(make-obsolete 'sp-match-sgml-tags "do not use this function as the tag system has been removed." "2015-02-07") + +(defun sp--is-number-cons (c) + "Return non-nil if C is a cons cell with numbers at `car' and `cdr'." + (and (consp c) (numberp (car c)) (numberp (cdr c)))) + +;; TODO: more research is needed +(defun sp--undo-pop-to-last-insertion-node () + "Pop all undo info until an insertion node (beg . end) is found. + +This can potentially remove some undo important information." + (while (and buffer-undo-list + (or (null (car buffer-undo-list)) ;; is nil + ;; is not undo action we're interested in + (not (sp--is-number-cons (car buffer-undo-list))))) + (pop buffer-undo-list))) + +;; modified from: https://github.com/Fuco1/smartparens/issues/90#issuecomment-18800369 +(defun sp--split-last-insertion-undo (len) + "Split the last insertion node in the `buffer-undo-list' to +include separate pair node." + (sp--undo-pop-to-last-insertion-node) + (when buffer-undo-list + (let* ((previous-undo-actions (cdr buffer-undo-list)) + (beg (caar buffer-undo-list)) + (end (cdar buffer-undo-list)) + first-action second-action) + (unless (< beg (- end len)) + ;; We need to go back more than one action. Given the pairs + ;; are limited to 10 chars now and the chunks seem to be 20 + ;; chars, we probably wouldn't need more. + (pop buffer-undo-list) + (sp--undo-pop-to-last-insertion-node) + (when buffer-undo-list + (setq beg (caar buffer-undo-list)) + (setq previous-undo-actions (cdr buffer-undo-list)))) + (setq first-action (cons beg (- end len))) + (setq second-action (cons (- end len) end)) + (setq buffer-undo-list + (append (list nil second-action nil first-action) + previous-undo-actions))))) + +;; TODO: remove ACTION argument and make the selection process more +;; unified (see also sp--pair-to-wrap which depends on buffer state +;; among other things) +(defun sp--all-pairs-to-insert (&optional looking-fn action) + "Return all pairs that can be inserted at point. + +Return nil if such pair does not exist. + +Pairs inserted using a trigger have higher priority over pairs +without a trigger and only one or the other list is returned. + +In other words, if any pair can be inserted using a trigger, only +pairs insertable by trigger are returned. + +ACTION is an implementation detail. Usually it has the value +\\='insert when we determine pairs to insert. On repeated wrapping +however we pass the value 'wrap. This will be refactored away in +the upcoming version." + (setq looking-fn (or looking-fn 'sp--looking-back-p)) + (setq action (or action 'insert)) + (let ((working-pairs + ;; TODO: abstract this into a new "sp--get-..." hierarchy + (--filter (sp--do-action-p (plist-get it :open) action) sp-local-pairs))) + (-if-let (trigs (--filter (and (plist-get it :trigger) + (funcall looking-fn (sp--strict-regexp-quote (plist-get it :trigger)))) + working-pairs)) + (cons :trigger trigs) + (-when-let (pairs (--filter (funcall looking-fn (sp--strict-regexp-quote (plist-get it :open))) working-pairs)) + (cons :open pairs))))) + +(defun sp--pair-to-insert-comparator (prop a b) + (cond + ;; in case of triggers shorter always wins + ((eq prop :trigger) + (< (length (plist-get a :trigger)) (length (plist-get b :trigger)))) + ;; Shorter wins only if the shorter's closing is a prefix of the + ;; longer's closing. In other words, if we are looking at + ;; shorter's closing and we are trying to nest it. + (t + (if (< (length (plist-get a :open)) (length (plist-get b :open))) + (and (string-prefix-p (plist-get a :close) (plist-get b :close)) + (sp--looking-at-p (plist-get a :close))) + (not (and (string-prefix-p (plist-get b :close) (plist-get a :close)) + (sp--looking-at-p (plist-get b :close)))))))) + +(defun sp--pair-to-insert (&optional action) + "Return pair that can be inserted at point. + +Return nil if such pair does not exist. + +If more triggers or opening pairs are possible select the +shortest one." + (-when-let ((property . pairs) (sp--all-pairs-to-insert nil action)) + (car (--sort (sp--pair-to-insert-comparator property it other) pairs)))) + +(defun sp--longest-prefix-to-insert () + "Return pair with the longest :open which can be inserted at point." + (-when-let (pairs (--filter (sp--looking-back-p (sp--strict-regexp-quote (plist-get it :open))) sp-local-pairs)) + (car (--sort (> (length (plist-get it :open)) (length (plist-get other :open))) pairs)))) + +(defun sp--pair-to-uninsert () + "Return pair to uninsert. + +If the current to-be-inserted pair shares a prefix with +another (shorter) pair, we must first remove the effect of +inserting its closing pair before inserting the current one. + +The previously inserted pair must be the one with the longest +common prefix excluding the current pair." + (-when-let (lp (sp--longest-prefix-to-insert)) + (save-excursion + (backward-char (length (plist-get lp :open))) + (-when-let ((property . pairs) (sp--all-pairs-to-insert 'sp--looking-at-p)) + (car (--sort (> (length (plist-get it property)) (length (plist-get other property))) + ;; remove pairs whose open is longer than the + ;; current longest possible prefix---otherwise + ;; they would overflow to the closing pair + ;; TODO: this ignores the possibility when lp is + ;; inserted by trigger. We assume triggers are + ;; shorter than the openings and this situation, + ;; if ever, should be very rare + (--remove (>= (length (plist-get it :open)) + (length (plist-get lp :open))) pairs))))))) + +(defun sp--insert-pair-get-pair-info (active-pair) + "Get basic info about the to-be-inserted pair." + (let ((open-pair (plist-get active-pair :open))) + (list + open-pair + (plist-get active-pair :close) + (-if-let (tr (plist-get active-pair :trigger)) + (if (sp--looking-back-p (sp--strict-regexp-quote tr)) tr open-pair) + open-pair)))) + +(defun sp-insert-pair (&optional pair) + "Automatically insert the closing pair if it is allowed in current context. + +If PAIR is provided, use this as pair ID instead of looking +through the recent history of pressed keys. + +You can disable this feature completely for all modes and all pairs by +setting `sp-autoinsert-pair' to nil. + +You can globally disable insertion of closing pair if point is +followed by the matching opening pair. It is disabled by +default." + (sp--with-case-sensitive + (catch 'done + (-let* ((active-pair (unwind-protect + ;; This fake insertion manufactures proper + ;; context for the tests below... in effect + ;; we must make it look as if the user + ;; typed in the opening part themselves + ;; TODO: it is duplicated in the test + ;; below, maybe it wouldn't hurt to + ;; restructure this function a bit + (progn + (when pair (insert pair)) + (sp--pair-to-insert)) + (when pair (delete-char (- (length pair)))))) + ((open-pair close-pair trig) (sp--insert-pair-get-pair-info active-pair))) + ;; We are not looking at a closing delimiter which might mean we + ;; are in an already existing sexp. If the to-be-inserted pair + ;; has a prefix which is also a pair we migth be extending the + ;; opener of a sexp with this opener. In which case we should + ;; probably rewrap. + (unless (sp--looking-at-p (sp--get-closing-regexp)) + (when (and open-pair + (= 1 (- (point) sp-pre-command-point))) + (-when-let (prefix-pair (sp-get-pair (substring open-pair 0 -1))) + (let ((last-char-of-open-pair (substring open-pair -1))) + (unwind-protect + (progn + (delete-char -1) + (--when-let (sp-get-thing t) + (save-excursion + (sp-get it + (delete-region :end-in :end) + (goto-char :end-in) + (insert close-pair))) + (throw 'done t))) + (insert last-char-of-open-pair)))))) + (if (not (unwind-protect + (progn + (when pair (insert pair)) + ;; TODO: all these tests must go into `sp--pair-to-insert' + (and sp-autoinsert-pair + active-pair + (if (memq sp-autoskip-closing-pair '(always always-end)) + (or (not (equal open-pair close-pair)) + (not (sp-skip-closing-pair nil t))) + t) + (sp--do-action-p open-pair 'insert t) + ;; was sp-autoinsert-if-followed-by-same + (or (not (sp--get-active-overlay 'pair)) + (not (sp--looking-at (sp--strict-regexp-quote open-pair))) + (and (equal open-pair close-pair) + (eq sp-last-operation 'sp-insert-pair) + (save-excursion + (backward-char (length trig)) + (sp--looking-back (sp--strict-regexp-quote open-pair)))) + (not (equal open-pair close-pair))))) + (when pair (delete-char (- (length pair)))))) + ;; if this pair could not be inserted, we try the procedure + ;; again with this pair removed from sp-pair-list to give + ;; chance to other pairs sharing a common suffix (for + ;; example \[ and [) + (let ((new-sp-pair-list (--remove (equal (car it) open-pair) sp-pair-list)) + (new-sp-local-pairs (--remove (equal (plist-get it :open) open-pair) sp-local-pairs))) + (when (> (length sp-pair-list) (length new-sp-pair-list)) + (let ((sp-pair-list new-sp-pair-list) + (sp-local-pairs new-sp-local-pairs)) + (sp-insert-pair)))) + ;; setup the delayed insertion here. + (if (sp-get-pair open-pair :when-cond) + (progn + (setq sp-delayed-pair (cons open-pair (- (point) (length open-pair)))) + (setq sp-last-operation 'sp-insert-pair-delayed)) + (unless pair (delete-char (- (length trig)))) + (insert open-pair) + (sp--run-hook-with-args open-pair :pre-handlers 'insert) + ;; The re-binding of these dynamic variables is a hack to + ;; combat the similar rebinding in the branch above where + ;; we retry `sp-insert-pair' with some pairs removed. + ;; This however causes them to be uninserted improperly, + ;; so for this one operation we need to restore the state + ;; to the "full" pair list. TODO: in the future we might + ;; want to pass the state around explicitly so we have + ;; better control. + (--when-let (let ((sp-pair-list (sp-state-pair-list sp-state)) + (sp-local-pairs (sp-state-local-pairs sp-state))) + (sp--pair-to-uninsert)) + (let ((cl (plist-get it :close))) + (when (and (sp--looking-at-p (sp--strict-regexp-quote cl)) + (> (- (length close-pair) (length cl)) 0)) + (delete-char (length cl))))) + (insert close-pair) + (backward-char (length close-pair)) + (sp--pair-overlay-create (- (point) (length open-pair)) + (+ (point) (length close-pair)) + open-pair) + (when sp-undo-pairs-separately + (sp--split-last-insertion-undo (+ (length open-pair) (length close-pair))) + ;; TODO: abc\{abc\} undo undo \{asd\} . next undo removes the + ;; entire \{asd\} if we do not insert two nils here. + ;; Normally, repeated nils are ignored so it shouldn't + ;; matter. It would still be useful to inspect further. + (push nil buffer-undo-list) + (push nil buffer-undo-list)) + (sp--run-hook-with-args open-pair :post-handlers 'insert) + (setq sp-last-inserted-pair open-pair) + (setf (sp-state-delayed-hook sp-state) (cons :next open-pair)) + (setq sp-last-operation 'sp-insert-pair))))))) + +(defun sp--wrap-repeat-last (active-pair) + "If the last operation was a wrap and `sp-wrap-repeat-last' is +non-nil, repeat the wrapping with this pair around the last +active region." + (unless (= 0 sp-wrap-repeat-last) + (when sp-last-wrapped-region + (let* ((b (sp-get sp-last-wrapped-region :beg)) + (e (sp-get sp-last-wrapped-region :end)) + (op (sp-get sp-last-wrapped-region :op)) + (oplen (length op)) + (cllen (sp-get sp-last-wrapped-region :cl-l)) + (acolen (length (car active-pair)))) + (when (and + (cond + ((= 1 sp-wrap-repeat-last) + (equal (car active-pair) op)) + ((= 2 sp-wrap-repeat-last))) + (memq sp-last-operation '(sp-self-insert sp-wrap-region)) + (or (= (point) (+ b oplen acolen)) + (= (point) (+ e acolen)))) + (delete-char (- acolen)) + (if (< (point) e) + (progn (goto-char (+ b oplen)) + (insert (car active-pair)) + (goto-char (- e cllen)) + (insert (cdr active-pair)) + (setq sp-last-wrapped-region + (sp--make-last-wraped-region + (+ b oplen) (point) + (car active-pair) (cdr active-pair))) + (goto-char (+ b oplen acolen))) + (goto-char b) + (insert (car active-pair)) + (goto-char e) + (insert (cdr active-pair)) + (setq sp-last-wrapped-region + (sp--make-last-wraped-region + b (+ e acolen) (car active-pair) (cdr active-pair)))) + (setq sp-last-operation 'sp-wrap-region) + (sp--run-hook-with-args (car active-pair) :post-handlers 'wrap) + sp-last-operation))))) + +(defun sp--char-is-part-of-stringlike (char) + "Return non-nil if CHAR is part of a string-like delimiter of length 1." + (->> (sp--get-stringlike-list) + (--filter (= 1 (length (cdr it)))) + (-map 'car) + (--any? (string-match-p (regexp-quote char) it)))) + +(defun sp--char-is-part-of-closing (char &optional pair-list) + "Return non-nil if CHAR is part of a pair delimiter of length 1. +Specifically, return the pair for which CHAR is the closing +delimiter." + (let ((regexp (regexp-quote char))) + (->> (or pair-list (sp--get-pair-list)) + (--filter (= 1 (length (cdr it)))) + (--find (string-match-p regexp (cdr it)))))) + +;; TODO: this only supports single-char delimiters. Maybe it should +;; that that way. +(defun sp-skip-closing-pair (&optional last test-only) + "Automatically skip the closing delimiters of pairs. + +If point is inside an inserted pair, and the user only moved +forward with point (that is, only inserted text), if the closing +pair is typed, we shouldn't insert it again but skip forward. We +call this state \"active sexp\". The setting +`sp-cancel-autoskip-on-backward-movement' controls when an active +expression become inactive. + +For example, pressing ( is followed by inserting the pair (|). If +we then type \\='word\\=' and follow by ), the result should be (word)| +instead of (word)|). + +This behaviour can be customized by various settings of +`sp-autoskip-closing-pair' and `sp-autoskip-opening-pair'. + +Additionally, this behaviour can be selectively disabled for +specific pairs by removing their \"autoskip\" action. You can +achieve this by using `sp-pair' or `sp-local-pair' with +\":actions \\='(:rem autoskip)\"." + (sp--with-case-sensitive + (when (or (and (eq sp-autoskip-closing-pair t) + sp-pair-overlay-list + (sp--get-active-overlay 'pair)) + (memq sp-autoskip-closing-pair '(always always-end))) + ;; TODO: ugly hack to override 'navigate with 'autoskip. Each of + ;; these submodules should set-up their own environment somehow + ;; and thread it through the entire computation + (cl-letf (((symbol-function 'sp--get-allowed-stringlike-list) + (lambda () + (--filter (and (sp--do-action-p (car it) 'autoskip) + (equal (car it) (cdr it))) sp-pair-list)))) + ;; these two are pretty hackish ~_~ + (cl-labels ((get-sexp + (last) + (delete-char -1) + (insert " ") + (prog1 (sp-get-sexp) + (delete-char -1) + (insert last))) + (get-enclosing-sexp + (last) + (delete-char -1) + (insert " ") + (prog1 (sp-get-enclosing-sexp) + (delete-char -1) + (insert last)))) + (let ((last (or last (sp--single-key-description last-command-event)))) + (-if-let (active-sexp + (cond + ((-when-let* ((ov (sp--get-active-overlay 'pair)) + (op (overlay-get ov 'pair-id)) + (cl (cdr (assoc op sp-pair-list)))) + ;; if the sexp is active, we are inside it. + (when (and (= 1 (length op)) + (equal last cl)) + (list :beg (overlay-start ov) + :end (overlay-end ov) + :op op + :cl cl + :prefix "" + :suffix "")))) + ((sp--char-is-part-of-stringlike last) + ;; a part of closing delimiter is typed. There are four + ;; options now: + ;; - we are inside the sexp, at its end + ;; - we are inside the sexp, somewhere in the middle + ;; - we are outside, in front of a sexp + ;; - we are outside, somewhere between sexps + (cond + ((and (sp--looking-at (sp--get-stringlike-regexp)) + (not (sp--skip-match-p (match-string-no-properties 0) + (match-beginning 0) + (match-end 0)))) + ;; if we're looking at the delimiter, and it is valid in + ;; current context, get the sexp. + (get-sexp last)) + ;; here comes the feature when we're somewhere in the + ;; middle of the sexp (or outside), if ever supported. + )) + ((sp--char-is-part-of-closing last) + (cond + ((and (sp--looking-at (sp--get-closing-regexp)) + (not (sp--skip-match-p (match-string-no-properties 0) + (match-beginning 0) + (match-end 0)))) + (get-sexp last)) + ((eq sp-autoskip-closing-pair 'always) + (get-enclosing-sexp last)))))) + (if (and active-sexp + (equal (sp-get active-sexp :cl) last) + (sp--do-action-p (sp-get active-sexp :op) 'autoskip) + ;; if the point is inside string and preceded + ;; by an odd number of `sp-escape-char's, we + ;; should not skip as that would leave the + ;; string broken. + (or (not (sp-point-in-string)) + (not (sp-char-is-escaped-p (1- (point)))))) + (-when-let (re (cond + ((= (point) (sp-get active-sexp :beg)) + ;; we are in front of a string-like sexp + (when sp-autoskip-opening-pair + (if test-only t + (delete-char -1) + (forward-char) + (setq sp-last-operation 'sp-skip-closing-pair)))) + ((= (point) (sp-get active-sexp :end-in)) + (if test-only t + (delete-char 1) + (setq sp-last-operation 'sp-skip-closing-pair))) + ((sp-get active-sexp + (and (> (point) :beg-in) + (< (point) :end-in))) + (if test-only t + (delete-char -1) + (sp-up-sexp nil t))))) + (unless (or test-only + sp-buffer-modified-p) + (set-buffer-modified-p nil)) + (unless test-only + (sp--run-hook-with-args (sp-get active-sexp :op) :post-handlers 'skip-closing-pair)) + re) + ;; if we can't skip and are in strict mode we must not + ;; insert anything if it is a closing character + (sp--inhibit-insertion-of-closing-delim last)) + (sp--inhibit-insertion-of-closing-delim last)))))))) + +(defun sp--inhibit-insertion-of-closing-delim (last) + "Inhibit insertion of closing delimiter in `smartparens-strict-mode'. + +If we are not inserting inside string or a comment, and the LAST +inserted character is closing delimiter for a pair that performs +autoskip, and we can not jump out of its enclosing sexp (i.e. it +does not match), we are not allowed to insert it literally +because it would break the balance; so we delete the +just-inserted character." + (when (and smartparens-strict-mode + (-when-let (pair (sp--char-is-part-of-closing + last (sp--get-allowed-pair-list))) + (memq 'autoskip (sp-get-pair (car pair) :actions))) + (not (sp-point-in-string-or-comment))) + (delete-char -1) + (set-buffer-modified-p sp-buffer-modified-p) + (sp-message :cant-insert-closing-delimiter) + nil)) + +(defun sp-delete-pair (&optional arg) + "Automatically delete opening or closing pair, or both, depending on +position of point. + +If the point is inside an empty pair, automatically delete both. That +is, [(|) turns to [|, [{|} turns to [|. Can be disabled by setting +`sp-autodelete-pair' to nil. + +If the point is behind a closing pair or behind an opening pair delete +it as a whole. That is, {}| turns to {|, {| turns to |. Can be +disabled by setting `sp-autodelete-closing-pair' and +`sp-autodelete-opening-pair' to nil. + +If the last operation was a wrap and `sp-autodelete-wrap' is +enabled, invoking this function will unwrap the expression, that +is remove the just added wrapping." + ;; NOTE: Only use delete-char inside this function, so we + ;; don't activate the advice recursively! + + ;; only activate if argument is 1 (this is 0-th argument of the + ;; delete-backward-char), otherwise the user wants to delete + ;; multiple character, so let him do that + (sp--with-case-sensitive + (when (and (= arg 1) + smartparens-mode) + (if (and sp-autodelete-wrap + (eq sp-last-operation 'sp-wrap-region)) + (let ((p (point)) + (b (sp-get sp-last-wrapped-region :beg)) + (e (sp-get sp-last-wrapped-region :end)) + (o (sp-get sp-last-wrapped-region :op-l)) + (c (sp-get sp-last-wrapped-region :cl-l))) + ;; if the last operation was `sp-wrap-region', and we are at + ;; the position of either opening or closing pair, delete the + ;; just-inserted pair + (when (or (= p (+ b o)) + (= p e)) + (insert "x") ;dummy char to account for the regularly deleted one + (save-excursion + (goto-char e) + (delete-char (- c)) + (goto-char b) + (delete-char o)) + (setq sp-last-operation 'sp-delete-pair-wrap))) + (let ((p (point)) + (inside-pair (--first (and (sp--looking-back (sp--strict-regexp-quote (car it))) + (sp--looking-at (concat "[ \n\t]*" (sp--strict-regexp-quote (cdr it))))) + sp-pair-list)) + (behind-pair (--first (sp--looking-back (sp--strict-regexp-quote (cdr it))) sp-pair-list)) + (opening-pair (--first (sp--looking-back (sp--strict-regexp-quote (car it))) sp-pair-list))) + + (cond + ;; we're just before the closing quote of a string. If there + ;; is an opening or closing pair behind the point, remove + ;; it. This is only really relevant if the pair ends in the + ;; same character as string quote. We almost never want to + ;; delete it as an autopair (it would "open up the string"). + ;; So, word\"|" and should produce word\|" or + ;; word|" (if \" is autopair) instead of word\|. + ((and (sp-point-in-string) + (not (sp-point-in-string (1+ p))) + (sp-point-in-string (1- p))) ;; the string isn't empty + (cond ;; oh, you ugly duplication :/ + ((and behind-pair sp-autodelete-closing-pair) + (delete-char (- (1- (length (car behind-pair))))) + (setq sp-last-operation 'sp-delete-pair-closing)) + ((and opening-pair sp-autodelete-opening-pair) + (delete-char (- (1- (length (car opening-pair))))) + (setq sp-last-operation 'sp-delete-pair-opening)))) + ;; we're inside a pair + ((and inside-pair sp-autodelete-pair) + (let* ((beg (save-excursion + (search-backward (car inside-pair)))) + (end (save-excursion + (search-forward (cdr inside-pair)))) + (cs (sp--get-context p)) + (ce (sp--get-context end)) + (current-sexp (sp-get-sexp))) + (when (and (or (not (eq cs 'comment)) ;; a => b <=> ~a v b + (eq ce 'comment)) + (eq beg (sp-get current-sexp :beg)) + (eq end (sp-get current-sexp :end)) + (equal (sp-get current-sexp :op) (car inside-pair)) + (equal (sp-get current-sexp :cl) (cdr inside-pair))) + (delete-char (- end p)) + (delete-char (- (1- (length (car inside-pair))))) + (setq sp-last-operation 'sp-delete-pair)))) + ;; we're behind a closing pair + ((and behind-pair sp-autodelete-closing-pair) + (delete-char (- (1- (length (cdr behind-pair))))) + (setq sp-last-operation 'sp-delete-pair-closing)) + ;; we're behind an opening pair and there's no closing pair + ((and opening-pair sp-autodelete-opening-pair) + (delete-char (- (1- (length (car opening-pair))))) + (setq sp-last-operation 'sp-delete-pair-opening)))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Navigation + +(defun sp--looking-at (regexp) + "Like `looking-at', but always case sensitive." + (sp--with-case-sensitive + (looking-at regexp))) + +(defun sp--looking-at-p (regexp) + "Like `looking-at-p', but always case sensitive." + (sp--with-case-sensitive + (looking-at-p regexp))) + +(defun sp--looking-back (regexp &optional limit not-greedy) + "Return non-nil if text before point matches regular expression REGEXP. + +With optional argument LIMIT search only that many characters +backward. If LIMIT is nil, default to `sp-max-pair-length'. + +If optional argument NON-GREEDY is t search for any matching +sequence, not necessarily the longest possible." + (setq limit (or limit sp-max-pair-length)) + (sp--with-case-sensitive + (let ((from (max 1 (- (point) limit))) + (to (point)) + (greedy (not not-greedy)) + has-match) + (if greedy + (save-excursion + (goto-char from) + (save-match-data + (while (and (not has-match) (< (point) to)) + ;; don't use looking-at because we can't limit that search + (if (and (save-excursion (re-search-forward regexp to t)) + (= (match-end 0) to)) + (setq has-match (match-data)) + (forward-char 1)))) + (when has-match + (set-match-data has-match) + t)) + (save-excursion + (not (null (search-backward-regexp (concat "\\(?:" regexp "\\)\\=") from t)))))))) + +(defun sp--looking-back-p (regexp &optional limit not-greedy) + "Same as `sp--looking-back' but do not change the match data." + (save-match-data + (sp--looking-back regexp limit not-greedy))) + +(defun sp--search-backward-regexp (regexp &optional bound noerror count) + "Works just like `search-backward-regexp', but returns the +longest possible match. That means that searching for +\"defun|fun\" backwards would return \"defun\" instead of +\"fun\", which would be matched first. + +This is an internal function. Only use this for searching for +pairs!" + (setq count (or count 1)) + (setq bound (or (sp--get-backward-bound) bound)) + (sp--with-case-sensitive + (let (r) + (while (> count 0) + (when (search-backward-regexp regexp bound noerror) + (goto-char (match-end 0)) + (if (sp--looking-back regexp) + (setq r (goto-char (match-beginning 0))) + (if noerror nil (error "Search failed: %s" regexp)))) + (setq count (1- count))) + r))) + +(defun sp--search-forward-regexp (regexp &optional bound noerror count) + "Just like `search-forward-regexp', but always case sensitive." + (setq bound (or (sp--get-forward-bound) bound)) + (sp--with-case-sensitive + (search-forward-regexp regexp bound noerror count))) + +(defun sp--search-forward-in-context (regexp &optional bound noerror count) + "Just like `sp--search-forward-regexp' but only accept results in same context. + +The context at point is considered the reference context." + (let ((context (sp--get-context)) + (re)) + (--dotimes (or count 1) + (save-excursion + (while (and (setq re (sp--search-forward-regexp regexp bound noerror)) + (not (eq (sp--get-context) context))))) + (when re (goto-char re))) + re)) + +(defun sp--search-backward-in-context (regexp &optional bound noerror count) + "Just like `sp--search-backward-regexp' but only accept results in same context. + +The context at point is considered the reference context." + (let ((context (sp--get-context)) + (re)) + (--dotimes (or count 1) + (save-excursion + (while (and (setq re (sp--search-backward-regexp regexp bound noerror)) + (not (eq (sp--get-context) context)))) + (when re (goto-char re)))) + re)) + +(defun sp-get-quoted-string-bounds (&optional point) + "Return the bounds of the string around POINT. + +POINT defaults to `point'. + +If the point is not inside a quoted string, return nil." + (setq point (or point (point))) + (save-excursion + (goto-char point) + (let ((parse-data (syntax-ppss))) + (when (nth 3 parse-data) + (let* ((open (nth 8 parse-data)) + (close (save-excursion + (parse-partial-sexp + (point) (point-max) + nil nil parse-data 'syntax-table) + (point)))) + (cons open close)))))) + +;; TODO: the repeated conditions are ugly, refactor this! +(defun sp-get-comment-bounds () + "If the point is inside a comment, return its bounds." + (when (or (sp-point-in-comment) + (looking-at "[[:space:]]+\\s<")) + (let ((open (save-excursion + (--when-let (nth 8 (sp--syntax-ppss)) + (goto-char it)) + (while (and (not (bobp)) + (or (when (sp-point-in-comment) + (backward-char 1) + t) + (when (save-excursion + (beginning-of-line) + (looking-at "^[[:space:]]+\\s<")) + (when (>= (forward-line -1) 0) + (end-of-line)) + t)))) + ;; this means we got here by `sp-point-in-comment' condition + (unless (and (bobp) (sp-point-in-comment)) + (forward-char)) + (point))) + (close (save-excursion + (while (and (not (eobp)) + (or (sp-point-in-comment) + (looking-at "[[:space:]]+\\s<"))) + (forward-char 1)) + (let ((pp (1- (point)))) + (when (not (or (eobp) + (sp-point-in-comment) + (looking-at "[[:space:]]+\\s<") + (and (eq (char-syntax + (char-after pp)) ?>) + (not (eq (char-after pp) ?\n))) + (/= (logand + (lsh 1 18) + (car (syntax-after pp))) 0) + (/= (logand + (lsh 1 19) + (car (syntax-after pp))) 0))) + (backward-char 1))) + (point)))) + (cons open close)))) + +(defun sp--get-string-or-comment-bounds () + "Get the bounds of string or comment the point is in." + (or (sp-get-quoted-string-bounds) + (sp-get-comment-bounds))) + +(defmacro sp--search-and-save-match (search-fn pattern bound res beg end str) + "Save the last match info." + `(progn + (setq ,res (funcall ,search-fn ,pattern ,bound t)) + (when ,res + (setq ,beg (match-beginning 0)) + (setq ,end (match-end 0)) + (setq ,str (match-string 0))) + ,res)) + +(cl-defun sp--skip-match-p (ms mb me + &key + (global-skip (cdr (--first (memq major-mode (car it)) sp-navigate-skip-match))) + (pair-skip (sp-get-pair ms :skip-match))) + "Return non-nil if this match should be skipped. + +This function uses two tests, one specified in +`sp-navigate-skip-match' (this is global setting for all pairs in +given major mode) and by a function specified in :skip-match +property of the pair. + +If you are calling this function in a heavy loop, you can supply +the test functions as keyword arguments to speed up the lookup." + (save-match-data + (or (when global-skip (funcall global-skip ms mb me)) + (when pair-skip (funcall pair-skip ms mb me))))) + +(defmacro sp--valid-initial-delimiter-p (form) + "Test the last match using `sp--skip-match-p'. The form should +be a function call that sets the match data." + (declare (debug (form))) + (let ((match (make-symbol "match")) + (pair-skip (make-symbol "pair-skip"))) + `(and ,form + (let* ((,match (match-string 0)) + (,pair-skip (or (sp-get-pair ,match :skip-match) + (sp-get-pair (car (--first + (equal (cdr it) ,match) + sp-pair-list)) + :skip-match)))) + (not (sp--skip-match-p + ,match + (match-beginning 0) + (match-end 0) + :pair-skip ,pair-skip)))))) + +(defun sp--elisp-skip-match (ms mb _me) + "Function used to test for escapes in lisp modes. + +Non-nil return value means to skip the result." + (and ms + (> mb 1) + (save-excursion + (goto-char mb) + (save-match-data + (or (and (sp--looking-back "\\\\" 1 t) + ;; it might be a part of ?\\ token + (not (sp--looking-back "\\?\\\\\\\\" 3 t))) + (and (not (sp-point-in-string-or-comment)) + (sp--looking-back "\\?" 1 t) ;;TODO surely we can do better + (not (sp--looking-back "\\\\\\?" 2 t)) + (not (sp--looking-back "\\s_\\?" 2 t)) + (not (sp--looking-back "\\sw\\?" 2 t)))))))) + +(defun sp--backslash-skip-match (ms mb _me) + (and ms + (save-excursion + (goto-char mb) + (sp--looking-back "\\\\" 1 t)))) + +;; TODO: since this function is used for all the navigation, we should +;; optimize it a lot! Get some elisp profiler! Also, we should split +;; this into smaller functions (esp. the "first expression search" +;; business) +(defun sp-get-paired-expression (&optional back) + "Find the nearest balanced pair expression after point. + +The expressions considered are those delimited by pairs on +`sp-pair-list'." + (sp--with-case-sensitive + (save-excursion + (let* ((search-fn (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (global-skip-fn (cdr (--first (memq major-mode (car it)) sp-navigate-skip-match))) + (pair-list (sp--get-allowed-pair-list)) + ;; TODO UGLY HACK!!! When the situation is: + ;; ..)|;; comment + ;; the context the point gets is the comment. But if we + ;; are searching backward, that is incorrect, because in + ;; that case we want the context of the closing pair. + ;; Therefore, if the direction is backward, we need to move + ;; one point backward, then test the comment/string thing, + ;; then compute the correct bounds, and then restore the + ;; point so the search will pick up the ) + + ;; However, we need to distinguish the cases where we are + ;; in comment and trying to get out, and when we are in any + ;; context and we jump into string (in that case, we should + ;; report code context!). For example: + ;; "foo"|;bar + ;; or + ;; "foo"|bar + ;; should both report code context + ;; and "|(foo)" should report string context. + + ;; Beware the case when we have a string inside a comment, like + ;; (foo) ;; bar "baz"| qux + ;; In this case we want to report comment context even when + ;; backing into the "" (which however is commented) + + ;; Yet another case is when we are not in a comment but + ;; directly after one and we search backwards, consider: + ;; /* foo bar */| + ;; in C-like language. In this case, we want to report the + ;; context as comment. + + ;; In some languages, special paren syntax with a prefix + ;; serves to mark strings. This means that regular + ;; delimiters, like () are used to delimit strings. For + ;; example, in ruby the sequence %w(...) signifies a + ;; string. If the point is after such a sequence and we + ;; are searching back, we must use the string context, + ;; because the paren is now a string delimiter. This is + ;; usually implemented with "string fence" syntax, so we + ;; will simply check for that. + + ;; Thanks for being consistent at handling syntax bounds Emacs! + (in-string-or-comment (if back + (let ((in-comment (sp-point-in-comment)) + (in-string (sp-point-in-string))) + (save-excursion + (unless (= (point) (point-min)) + (backward-char) + (cond + ((eq (car (syntax-after (point))) 15) (point)) + (in-comment (when (sp-point-in-comment) (1+ (point)))) + ((and (not in-comment) (sp-point-in-comment)) (1+ (point))) + ((or in-comment in-string) (1+ (point))))))) + (when (sp-point-in-string-or-comment) (point)))) + (string-bounds (and in-string-or-comment + (progn + (goto-char in-string-or-comment) + (sp--get-string-or-comment-bounds)))) + (fw-bound (if in-string-or-comment (cdr string-bounds) (point-max))) + (bw-bound (if in-string-or-comment (car string-bounds) (point-min))) + s e forward mb me ms r done + possible-pairs possible-interfering-pairs possible-ops possible-cls) + (while (and (not done) + (sp--search-and-save-match + search-fn + ;; #556 The regexp we use here might exclude or + ;; include extra pairs in case the next match is in + ;; a different context. There's no way to know + ;; beforehand where we land, so we need to consider + ;; *all* pairs in the search and then re-check with + ;; a regexp based on the context of the found pair + (sp--get-allowed-regexp + ;; use all the pairs! + (sp--get-pair-list)) + (if back bw-bound fw-bound) + r mb me ms)) + ;; search for the first opening pair. Here, only consider tags + ;; that are allowed in the current context. + (unless (or (not (save-excursion + (if back + (progn + (goto-char me) + (sp--looking-back-p (sp--get-allowed-regexp))) + (goto-char mb) + (sp--looking-at-p (sp--get-allowed-regexp))))) + (sp--skip-match-p ms mb me :global-skip global-skip-fn)) + ;; if the point originally wasn't inside of a string or comment + ;; but now is, jump out of the string/comment and only search + ;; the code. This ensures that the comments and strings are + ;; skipped if we search inside code. + (if (and (not in-string-or-comment) + (if back + ;; When searching back, the point lands on the + ;; first character of whatever pair we've found + ;; and it is in the proper context, for example + ;; "|(foo)" + (sp-point-in-string-or-comment) + ;; However, when searching forward, the point + ;; lands after the last char of the pair so to get + ;; its context we must back up one character + (sp-point-in-string-or-comment (1- (point))))) + (-if-let (bounds (sp--get-string-or-comment-bounds)) + (let ((jump-to (if back (car bounds) (cdr bounds)))) + (goto-char jump-to) + ;; Can't move out of comment because eob, #427 + (when (eobp) + (setq done t))) + (setq done t)) + (setq done t)))) + (when r + (setq possible-pairs (--filter (or (equal ms (car it)) + (equal ms (cdr it))) + pair-list)) + (setq possible-ops (-map 'car possible-pairs)) + (setq possible-cls (-map 'cdr possible-pairs)) + (setq pair-list (-difference pair-list possible-pairs)) + (setq possible-interfering-pairs pair-list) + (while possible-interfering-pairs + (setq possible-interfering-pairs + (--filter (or (-contains? possible-ops (car it)) + (-contains? possible-cls (cdr it))) + pair-list)) + (setq pair-list (-difference pair-list possible-interfering-pairs)) + (setq possible-ops (append possible-ops (-map 'car possible-interfering-pairs))) + (setq possible-cls (append possible-cls (-map 'cdr possible-interfering-pairs)))) + (when (--any? (equal ms it) possible-ops) + (setq forward t) + (setq s mb) + (when back + (forward-char (length ms)))) + (when (--any? (equal ms it) possible-cls) + (setq forward nil) + (setq e me) + (when (not back) + (backward-char (length ms)))) + (let* ((opens (if forward possible-ops possible-cls)) + (closes (if forward possible-cls possible-ops)) + (needle (sp--strict-regexp-opt (append possible-ops possible-cls))) + (search-fn (if forward 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (depth 1) + (eof (if forward 'eobp 'bobp)) + (b (if forward fw-bound bw-bound)) + (open (substring-no-properties ms)) + (close (substring-no-properties ms)) + (failure (funcall eof)) + (skip-match-pair-fns (->> possible-ops + (--mapcat (-when-let (smf (sp-get-pair it :skip-match)) + (list (cons it smf) (cons (sp-get-pair it :close) smf))))))) + (while (and (> depth 0) (not (funcall eof))) + (sp--search-and-save-match search-fn needle b r mb me ms) + (if r + (unless (or (and (not in-string-or-comment) + (if forward (save-excursion + (backward-char) + (sp-point-in-string-or-comment)) + (sp-point-in-string-or-comment))) + ;; check the individual pair skipper. We + ;; need to test all the possible-ops, + ;; which makes it a bit ugly :/ + (let ((skip-match-pair-fn + (cdr (--first (equal (car it) ms) skip-match-pair-fns)))) + (sp--skip-match-p ms mb me :global-skip global-skip-fn :pair-skip skip-match-pair-fn))) + (when (--any? (equal ms it) opens) (setq depth (1+ depth))) + (when (--any? (equal ms it) closes) (setq depth (1- depth)))) + (unless (minibufferp) + (sp-message :unmatched-expression)) + (setq depth -1) + (setq failure t))) + (if forward + (setq e me) + (setq s mb)) + (setq close (substring-no-properties ms)) + (if (or failure + (/= depth 0)) + (progn + (unless (minibufferp) + (sp-message :unmatched-expression)) + nil) + (let ((end-in-cos (sp-point-in-string-or-comment (1- e)))) ;; fix the "point on comment" issue + (cond + ((or (and (sp-point-in-string-or-comment s) (not end-in-cos)) + (and (not (sp-point-in-string-or-comment s)) end-in-cos)) + (unless (minibufferp) + (sp-message :delimiter-in-string)) + nil) + (t + (let* ((op (if forward open close))) + (list :beg s + :end e + :op op + :cl (if forward close open) + :prefix (sp--get-prefix s op) + :suffix (sp--get-suffix e op))))))))))))) + +;; TODO: this does not consider unbalanced quotes in comments!!! +(defun sp--find-next-stringlike-delimiter (needle search-fn-f &optional limit skip-fn) + "Find the next string-like delimiter, considering the escapes +and the skip-match predicate." + (let (hit match) + (while (and (not hit) + (funcall search-fn-f needle limit t)) + (save-match-data + (setq match (match-string-no-properties 0)) + (unless (or (save-match-data + (save-excursion + (goto-char (match-beginning 0)) + (or (sp--looking-back-p "\\\\" 2) ;; assumes \ is always the escape... bad? + (and (eq major-mode 'emacs-lisp-mode) + (not (sp-point-in-string)) + (sp--looking-back-p "?" 1))))) + ;; TODO: HACK: global-skip is hack here!!! + (sp--skip-match-p match (match-beginning 0) (match-end 0) + :pair-skip (or skip-fn + (sp-get-pair match :skip-match)) + :global-skip nil)) + (setq hit (match-data))))) + hit)) + +(defun sp-get-stringlike-expression (&optional back) + "Find the nearest string-like expression after point. + +String-like expression is expression enclosed with the same +opening and closing delimiter, such as *...*, \"...\", `...` etc." + (sp--with-case-sensitive + (save-excursion + (let ((needle (sp--get-stringlike-regexp)) + (search-fn-f (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (search-fn-b (if back 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (count 0) + m b e skip-match-fn limit ok) + (when (not (equal needle "")) + (when (sp--find-next-stringlike-delimiter needle search-fn-f) + ;; assumes \ is always the escape... bad? + (setq m (match-string-no-properties 0)) + (setq needle (regexp-quote m)) + (setq skip-match-fn (sp-get-pair m :skip-match)) + (cond + ((sp-point-in-string) + (setq limit (sp-get-quoted-string-bounds))) + ((sp-point-in-comment) + (setq limit (sp-get-comment-bounds)))) + (save-excursion + (while (sp--find-next-stringlike-delimiter needle 'search-backward-regexp (car limit) skip-match-fn) + (setq count (1+ count)))) + (when (= (mod count 2) 0) + (sp--find-next-stringlike-delimiter needle search-fn-b nil)) + (save-excursion + (setq ok (sp--find-next-stringlike-delimiter needle 'sp--search-backward-regexp (car limit))) + (setq e (match-beginning 0))) + (setq ok (and ok (sp--find-next-stringlike-delimiter needle 'search-forward-regexp (cdr limit)))) + (setq b (match-end 0)) + (when ok + (let ((mb b) (me e)) + (setq b (min mb me)) + (setq e (max mb me))) + (list :beg b :end e :op m :cl m :prefix (sp--get-prefix b m) :suffix (sp--get-suffix e m))))))))) + +(defun sp--textmode-stringlike-regexp (delimiters &optional direction) + "Get a regexp matching text-mode string-like DELIMITERS. + +Capture group 1 or 2 has the delimiter itself, depending on the +direction (forward, backward). + +If DIRECTION is :open, create a regexp matching opening only. + +If DIRECTION is :close, create a regexp matching closing only. + +If DIRECTION is nil, create a regexp matching both directions." + (let* ((delims (regexp-opt delimiters)) + (re (concat + (if (or (not direction) + (eq direction :open)) + (concat "\\(?:" "\\(?:\\`\\|[ \t\n\r]\\)" "\\(" delims "\\)" "[^ \t\n\r]\\)") "") + (if (not direction) "\\|" "") + (if (or (not direction) + (eq direction :close)) + (concat "\\(?:[^ \t\n\r]" "\\(" delims "\\)" "\\(?:[ \t\n\r[:punct:]]\\|\\'\\)" "\\)") "")))) + re)) + +(defun sp--find-next-textmode-stringlike-delimiter (needle search-fn-f &optional limit) + "Find the next string-like delimiter, considering the escapes +and the skip-match predicate." + (let (hit) + (while (and (not hit) + (funcall search-fn-f needle limit t)) + (save-match-data + (let* ((group (if (match-string 1) 1 2)) + (match (match-string-no-properties group)) + (mb (match-beginning group)) + (me (match-end group)) + (skip-fn (sp-get-pair match :skip-match))) + (unless (sp--skip-match-p match mb me :pair-skip skip-fn :global-skip nil) + (setq hit (list match (if (= group 1) :open :close))))))) + hit)) + +(defun sp-get-textmode-stringlike-expression (&optional back) + "Find the nearest text-mode string-like expression. + +If BACK is non-nil search in the backwards direction. + +Text-mode string-like expression is one where the delimiters must +be surrounded by whitespace from the outside. For example, + +foo *bar* baz + +is a valid expression enclosed in ** pair, but + +foo*bar*baz OR foo *bar*baz OR foo*bar* baz + +are not. + +This is the case in almost every markup language, and so we will +adjust the parsing to only consider such pairs as delimiters. +This makes the parsing much faster as it transforms the problem +to non-stringlike matching and we can use a simple +counting (stack) algorithm." + (save-excursion + (let ((restart-from (point)) + (bounds (or (sp-get-comment-bounds) + (cons (point-min) (point-max)))) + hit re) + (while (not hit) + (goto-char restart-from) + (save-excursion + (ignore-errors + (if back (forward-char) (backward-char))) + (let* ((delimiters (-map 'car (sp--get-allowed-stringlike-list))) + (needle (sp--textmode-stringlike-regexp delimiters)) + (search-fn-f (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (limit-f (if (not back) (cdr bounds) (car bounds)))) + (-if-let ((delim type) (sp--find-next-textmode-stringlike-delimiter needle search-fn-f limit-f)) + (let ((search-fn (if (eq type :open) 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (limit (if (eq type :open) (cdr bounds) (car bounds))) + (needle (sp--textmode-stringlike-regexp (list delim) (if (eq type :open) :close :open)))) + (setq restart-from (point)) + ;; this adjustments are made because elisp regexp + ;; can't do lookahead assertions... so we match and + ;; then back up. + (ignore-errors + (when (and (not back) (eq type :open)) (backward-char (1+ (length delim)))) + (when (and (not back) (eq type :close) (not (eobp))) (backward-char 1)) + (when (and back (eq type :close)) (forward-char (1+ (length delim)))) + (when (and back (eq type :open) (not (bobp))) (forward-char 1))) + (let ((other-end (point))) + (when (sp--find-next-textmode-stringlike-delimiter needle search-fn limit) + ;; Beware, we also need to test the beg/end of + ;; buffer, because we have that variant in the + ;; regexp. In that case the match does not + ;; consume anything and we needn't do any + ;; correction. + (let* ((this-end (if (eq type :open) + (max (point-min) (if (eobp) (point) (1- (point)))) + (min (point-max) (if (bobp) (point) (1+ (point)))))) + (b (min this-end other-end)) + (e (max this-end other-end))) + (setq re (list :beg b + :end e + :op delim + :cl delim + :prefix (sp--get-prefix b delim) :suffix (sp--get-suffix e delim))) + (setq hit t) + ;; We ignore matches that contain two + ;; consecutive newlines, as that usually means + ;; there's a new paragraph somewhere inbetween + ;; TODO: make this customizable + (when (sp-get re + (save-excursion + (goto-char :beg) + (re-search-forward "\n\n\\|\r\r" :end t))) + (setq re nil) + (setq hit nil)))))) + (setq hit :no-more))))) + re))) + +(defun sp-get-string-or-nested-string (&optional back) + "Get a string with `sp-get-string' or `sp-get-stringlike-expression'. + +It might happen that the string delimiter we are looking at is +nested inside another string delimited by string fences (for +example nested \" and ' in python). In this case we can't use +`sp-get-string' parser because it would pick up the outer string. + +So if we are inside a string and `syntax-ppss' returns t as +delimiter we need to use `sp-get-stringlike-expression'. The +same situation happens when the character following the point has +syntax class 7 (string) or char syntax 34 (same thing as syntax +class but less general), but the character different from what +`syntax-ppss' returns as the outer string delimiter." + (if (let ((in-string (sp-point-in-string))) + (or (eq t in-string) + (and (not (eq in-string nil)) + (not (eq in-string (char-after)))))) + (save-excursion + (save-restriction + (widen) + (-let (((beg . end) (sp-get-quoted-string-bounds))) + (narrow-to-region beg end)) + (sp-get-stringlike-expression back))) + (sp-get-string back))) + +(defun sp-use-textmode-stringlike-parser-p () + "Test if we should use textmode stringlike parser or not." + (let ((modes (-filter 'symbolp sp-navigate-use-textmode-stringlike-parser)) + (derived (-map 'cdr (-remove 'symbolp sp-navigate-use-textmode-stringlike-parser)))) + (or (--any? (eq major-mode it) modes) + (apply 'derived-mode-p derived)))) + +(defun sp-get-stringlike-or-textmode-expression (&optional back delimiter) + "Return a stringlike expression using stringlike or textmode parser. + +DELIMITER is a candidate in case we performed a search before +calling this function and we know it's the closest string +delimiter to try. This is purely a performance hack, do not rely +on it when calling directly." + (if (sp-use-textmode-stringlike-parser-p) + (sp-get-textmode-stringlike-expression back) + ;; performance hack. If the delimiter is a character in + ;; syntax class 34, grab the string-like expression using + ;; `sp-get-string' + (if (and delimiter + (= (length delimiter) 1) + (eq (char-syntax (string-to-char delimiter)) 34)) + (sp-get-string-or-nested-string back) + (sp-get-stringlike-expression back)))) + +(defun sp-get-expression (&optional back) + "Find the nearest balanced expression of any kind. + +For markup and text modes a special, more efficient stringlike +parser is available, see `sp-get-textmode-stringlike-expression'. +By default, this is enabled in all modes derived from +`text-mode'. You can change it by customizing +`sp-navigate-use-textmode-stringlike-parser'." + (let ((pre (sp--get-allowed-regexp)) + (sre (sp--get-stringlike-regexp)) + (search-fn (if (not back) 'sp--search-forward-regexp 'sp--search-backward-regexp)) + (ps (if back (1- (point-min)) (1+ (point-max)))) + (ss (if back (1- (point-min)) (1+ (point-max)))) + (string-delim nil)) + (setq ps (if (equal pre "") ps + (or (save-excursion (funcall search-fn pre nil t)) ps))) + (setq ss (if (equal sre "") ss + (or (--when-let (save-excursion + (sp--find-next-stringlike-delimiter sre search-fn)) + (setq string-delim (match-string 0)) + (save-match-data + (set-match-data it) + (if back (match-beginning 0) (match-end 0)))) + ss))) + ;; TODO: simplify this logic somehow... (this really depends + ;; on a rewrite of the core parser logic: separation of "find + ;; the valid opening" and "parse it") + + ;; Here, we sacrifice readability for performance. Because we + ;; only use regexp to look forward for the closest pair, it + ;; might occasionally happen that what we picked in fact + ;; *can't* form a pair and it returns error (for example, it + ;; is an unclosed pair or a quote between words like'so, which + ;; doesn't form a pair). In such a case, or when the pair + ;; found is further than the other possible pair type (for + ;; example, we think we should parse stringlike, but we skip + ;; the first occurrence and the next one is only after a + ;; regular pair, which we should've picked instead), we must + ;; try the other parser as well. + (-let (((type . re) (if (or (and (not back) (< ps ss)) + (and back (> ps ss))) + (cons :regular (sp-get-paired-expression back)) + (cons :string (sp-get-stringlike-or-textmode-expression back string-delim))))) + (when re + (sp-get re + (cond + ;; If the returned sexp is regular, but the + ;; to-be-tried-string-expression is before it, we try + ;; to parse it as well, it might be a complete sexp in + ;; which case it should be returned. + ((and (eq type :regular) + (or (and (not back) (< ss :beg)) + (and back (> ss :end)))) + (or (sp-get-stringlike-or-textmode-expression back string-delim) re)) + ((and (eq type :string) + (or (and (not back) (< ps :beg)) + (and back (> ps :end)))) + (or (sp-get-paired-expression back) re)) + (t re))))))) + +(defun sp-get-sexp (&optional back) + "Find the nearest balanced expression that is after (before) point. + +Search backward if BACK is non-nil. This also means, if the +point is inside an expression, this expression is returned. + +If `major-mode' is member of `sp-navigate-consider-sgml-tags', +sgml tags will also be considered as sexps in current buffer. + +If the search starts outside a comment, all subsequent comments +are skipped. + +If the search starts inside a string or comment, it tries to find +the first balanced expression that is completely contained inside +the string or comment. If no such expression exist, a warning is +raised (for example, when you comment out imbalanced expression). +However, if you start a search from within a string and the next +complete sexp lies completely outside, this is returned. Note +that this only works in modes where strings and comments are +properly defined via the syntax tables. + +The return value is a plist with following keys: + + :beg - point in the buffer before the opening + delimiter (ignoring prefix) + :end - point in the buffer after the closing delimiter + :op - opening delimiter + :cl - closing delimiter + :prefix - expression prefix + :suffix - expression suffix + +However, you should never access this structure directly as it is +subject to change. Instead, use the macro `sp-get' which also +provide shortcuts for many commonly used queries (such as length +of opening/closing delimiter or prefix)." + (sp--maybe-init) + (sp--with-case-sensitive + (cond + (sp-prefix-tag-object + (sp-get-sgml-tag back)) + (sp-prefix-pair-object + (sp-get-paired-expression back)) + ((memq major-mode sp-navigate-consider-sgml-tags) + (let ((paired (sp-get-expression back))) + (if (and paired + (equal "<" (sp-get paired :op))) + ;; if the point is inside the tag delimiter, return the pair. + (if (sp-get paired (and (<= :beg-in (point)) (>= :end-in (point)))) + paired + ;; if the tag can't be completed, we can at least return + ;; the <> pair + (or (sp-get-sgml-tag back) paired)) + ;; we can still try the tag if the first < or > is closer than + ;; the pair. This is a bit too complicated... seems like a + ;; more clever solution would be needed in the future, esp if + ;; we add the python hack. + (cond + ((and (not back) + (< (save-excursion + (or (search-forward "<" nil t) (point-max))) + (or (sp-get paired :beg) (point-max)))) + (or (sp-get-sgml-tag) paired)) + ((and back + (> (save-excursion + (or (search-backward ">" nil t) (point-min))) + (or (sp-get paired :end) (point-max)))) + (or (sp-get-sgml-tag t) paired)) + (t paired))))) + (t (sp-get-expression back))))) + +(defun sp--get-hybrid-sexp-beg () + "Get the beginning of hybrid sexp. +See `sp-get-hybrid-sexp' for definition." + (save-excursion + (cl-labels ((indent-or-beg-of-line + (lb) + (if (sp-point-in-blank-line) + lb + (back-to-indentation) + (point)))) + (let ((p (progn (when (sp-point-in-symbol) (sp-backward-sexp)) (point))) + (lb (line-beginning-position)) + (cur (--if-let (save-excursion (sp-backward-sexp)) it (list :end 0))) ;hack + last) + (if (< (sp-get cur :end) lb) + ;; if the line is not empty, we move the beg to the indent + (indent-or-beg-of-line lb) + (while (sp-get cur + (and cur + (> :end lb) + (<= :end p))) + (setq last cur) + (setq cur (sp-backward-sexp))) + (if last + (sp-get last :beg-prf) + ;; happens when there is no sexp before the opening delim of + ;; the enclosing sexp. In case it is on line above, we take + ;; the maximum wrt lb. + (sp-get cur (max :beg-in (indent-or-beg-of-line lb))))))))) + +(defun sp--narrow-to-line () + "Narrow to the current line." + (narrow-to-region (line-beginning-position) (line-end-position))) + +(defun sp--get-hybrid-sexp-end () + "Get the end of hybrid sexp. +See `sp-get-hybrid-sexp' for definition." + (save-excursion + (cl-labels ((skip-prefix-backward + (p) + (save-excursion + (goto-char p) + (save-restriction + (sp--narrow-to-line) + (skip-syntax-backward " .") + (point))))) + (let ((p (progn (when (sp-point-in-symbol) (sp-backward-sexp)) (point))) + (le (line-end-position)) + (cur (--if-let (save-excursion (sp-forward-sexp)) it (list :beg (1+ (point-max))))) ;hack + last) + (if (> (sp-get cur :beg) le) + (if (sp-point-in-blank-line) le (skip-prefix-backward le)) + (while (sp-get cur + (and cur + (< :beg le) + (>= :beg p))) + (setq last cur) + (setq cur (sp-forward-sexp))) + (let ((r (skip-prefix-backward + (if last + (sp-get last :end) + ;; happens when there is no sexp before the closing delim of + ;; the enclosing sexp. In case it is on line below, we take + ;; the minimum wrt le. + (sp-get cur (min :end-in le)))))) + (goto-char r) + ;; fix the situation when point ends in comment + (cond + ((sp-point-in-comment) + (if (= (line-number-at-pos p) + (line-number-at-pos r)) + (line-end-position) + (goto-char p) + (line-end-position))) + (t r)))))))) + +(defun sp--get-hybrid-suffix (p) + "Get the hybrid sexp suffix, which is any punctuation after +the end, possibly preceded by whitespace." + (save-excursion + (goto-char p) + (buffer-substring-no-properties + p + (save-restriction + (sp--narrow-to-line) + (skip-syntax-forward " ") + (if (not (looking-at "\\s.")) + p + (skip-syntax-forward ".") + (point)))))) + +(defun sp-get-hybrid-sexp () + "Return the hybrid sexp around point. + +A hybrid sexp is defined as the smallest balanced region containing +the point while not expanding further than the current line. That is, +any hanging sexps will be included, but the expansion stops at the +enclosing list boundaries or line boundaries." + (let ((end (sp--get-hybrid-sexp-end))) + (list :beg (sp--get-hybrid-sexp-beg) + :end end + :op "" + :cl "" + :prefix "" + :suffix (sp--get-hybrid-suffix end)))) + +(defun sp-get-enclosing-sexp (&optional arg) + "Return the balanced expression that wraps point at the same level. + +With ARG, ascend that many times. This function expects a positive +argument." + (setq arg (or arg 1)) + (save-excursion + (let ((n arg) + (ok t) + (okr)) + (while (and (> n 0) ok) + (setq ok t) + (setq okr nil) + ;; if we are inside string, get the string bounds and "string + ;; expression" + (when (sp-point-in-string) + (setq okr (sp-get-string))) + ;; get the "normal" expression defined by pairs + (let ((p (point))) + (setq ok (sp-get-sexp)) + (cond + ((and ok (= (sp-get ok :beg) p)) + (goto-char (sp-get ok :end)) + (setq n (1+ n))) + ((and ok (< (sp-get ok :beg) p)) + (goto-char (sp-get ok :end))) + (t + (while (and ok (>= (sp-get ok :beg) p)) + (setq ok (sp-get-sexp)) + (when ok (goto-char (sp-get ok :end))))))) + ;; if the pair expression is enclosed inside a string, return + ;; the pair expression, otherwise return the string expression + (when okr + (unless (and ok + (sp-compare-sexps ok okr >=) + (sp-compare-sexps ok okr <= :end)) + (setq ok okr) + (goto-char (sp-get ok :end)))) + (setq n (1- n))) + (if (not (and (not ok) + sp-navigate-comments-as-sexps)) + ok + (when (sp-point-in-comment) + (let* ((cb (sp-get-comment-bounds)) + (b (save-excursion + (goto-char (car cb)) + (sp-skip-backward-to-symbol t) + (point))) + (e (save-excursion + (goto-char (cdr cb)) + (sp-skip-forward-to-symbol t) + (point)))) + (list :beg b :end e :op "" :cl "" :prefix sp-comment-char))))))) + +(defun sp-get-list-items (&optional lst) + "Return the information about expressions inside LST. + +LST should be a data structure in format as returned by +`sp-get-sexp'. + +The return value is a list of such structures in order as they +occur inside LST describing each expression, with LST itself +prepended to the front. + +If LST is nil, the list at point is used (that is the list +following point after `sp-backward-up-sexp' is called)." + (let ((r nil)) + (save-excursion + (unless lst + (setq lst (sp-backward-up-sexp))) + (when lst + (goto-char (sp-get lst :beg-in)) + (while (< (point) (sp-get lst :end)) + (!cons (sp-forward-sexp) r)) + (cons lst (nreverse (cdr r))))))) + +(cl-defun sp--get-prefix (&optional (p (point)) op) + "Get the prefix of EXPR. + +Prefix is any continuous sequence of characters in \"expression +prefix\" syntax class. You can also specify a set of syntax code +characters or a regexp for a specific major mode. See +`sp-sexp-prefix'. + +The point is expected to be at the opening delimiter of the sexp +and the prefix is searched backwards. + +If the prefix property is defined for OP, the associated regexp +is used to retrieve the prefix instead of the global setting." + (sp--with-case-sensitive + (save-excursion + (goto-char p) + (let* ((pref (sp-get-pair op :prefix)) + (prefix + (if pref + (if (sp--looking-back pref sp-max-prefix-length) + (match-string-no-properties 0) + "") + (-if-let (mmode-prefix (cdr (assoc major-mode sp-sexp-prefix))) + (cond + ((and (eq (car mmode-prefix) 'regexp) + (sp--looking-back (cadr mmode-prefix))) + (match-string-no-properties 0)) + ((eq (car mmode-prefix) 'syntax) + (skip-syntax-backward (cadr mmode-prefix)) + (buffer-substring-no-properties (point) p)) + (t "")) + (backward-prefix-chars) + (buffer-substring-no-properties (point) p))))) + ;; do not consider it a prefix if it matches some opening or + ;; closing delimiter which is allowed for parsing in current + ;; context + (goto-char p) + (if (and (< 0 (length prefix)) + (or (sp--do-action-p prefix 'navigate) + (sp--do-action-p + (car (--first (equal (cdr it) prefix) + sp-pair-list)) + 'navigate))) + "" + prefix))))) + +(cl-defun sp--get-suffix (&optional (p (point)) op) + "Get the suffix of EXPR. + +Suffix is any continuous sequence of characters in the +\"punctuation suffix\" syntax class. You can also specify a set +of syntax code characters or a regexp for a specific major mode. +See `sp-sexp-suffix'. + +If the suffix property is defined for OP, the associated regexp +is used to retrieve the suffix instead of the global setting." + (sp--with-case-sensitive + (save-excursion + (goto-char p) + (let* ((suff (sp-get-pair op :suffix)) + (suffix + (if suff + (if (sp--looking-at suff) + (match-string-no-properties 0) + "") + (-if-let (mmode-suffix (cdr (assoc major-mode sp-sexp-suffix))) + (cond + ((and (eq (car mmode-suffix) 'regexp) + (sp--looking-at (cadr mmode-suffix))) + (match-string-no-properties 0)) + ((eq (car mmode-suffix) 'syntax) + (skip-syntax-forward (cadr mmode-suffix)) + (buffer-substring-no-properties p (point))) + (t "")) + (skip-syntax-forward ".") + (buffer-substring-no-properties p (point)))))) + ;; do not consider it a suffix if it matches some opening or + ;; closing delimiter which is allowed for parsing in current + ;; context + (goto-char p) + (if (and (< 0 (length suffix)) + (or (sp--do-action-p suffix 'navigate) + (sp--do-action-p + (car (--first (equal (cdr it) suffix) + sp-pair-list)) + 'navigate))) + "" + suffix))))) + +(defun sp-get-symbol (&optional back) + "Find the nearest symbol that is after point, or before point if BACK is non-nil. + +This also means, if the point is inside a symbol, this symbol is +returned. Symbol is defined as a chunk of text recognized by +`sp-forward-symbol'. + +The return value is a plist with the same format as the value +returned by `sp-get-sexp'." + (sp--maybe-init) + (let (b e last-or-first) + (save-excursion + (if back + (progn + (sp-skip-backward-to-symbol) + (when (= (point) (point-min)) (setq last-or-first t)) + (sp-forward-symbol -1) + (setq b (point)) + (sp-forward-symbol 1) + (setq e (point))) + (sp-skip-forward-to-symbol) + (when (= (point) (point-max)) (setq last-or-first t)) + (sp-forward-symbol 1) + (setq e (point)) + (sp-forward-symbol -1) + (setq b (point)))) + (unless last-or-first + (list :beg b :end e :op "" :cl "" :prefix (sp--get-prefix b) :suffix (sp--get-suffix e))))) + +(defun sp--get-string (bounds) + "Return the `sp-get-sexp' format info about the string. + +This function simply transforms BOUNDS, which is a cons (BEG +. END) into format compatible with `sp-get-sexp'." + (let* ((op (char-to-string (char-after (car bounds)))) + (cl (char-to-string (char-before (cdr bounds))))) + ;; if the closing and opening isn't the same token, we should + ;; return nil + (when (equal op cl) + (list :beg (car bounds) + :end (cdr bounds) + :op cl + :cl cl + :prefix (sp--get-prefix (car bounds) op) + :suffix (sp--get-suffix (cdr bounds) cl))))) + +(defun sp-get-string (&optional back) + "Find the nearest string after point, or before if BACK is non-nil. + +This also means if the point is inside a string, this string is +returned. If there are another symbols between point and the +string, nil is returned. That means that this function only +return non-nil if the string is the very next meaningful +expression. + +The return value is a plist with the same format as the value +returned by `sp-get-sexp'." + (sp--maybe-init) + (if (sp-point-in-comment) + (sp-get-stringlike-expression back) + (if (sp-point-in-string) + (let ((r (sp-get-quoted-string-bounds))) + (sp--get-string r)) + (save-excursion + (sp-skip-into-string back) + (--when-let (sp-get-quoted-string-bounds) + (sp--get-string it)))))) + +(defun sp-get-whitespace () + "Get the whitespace around point. + +Whitespace here is defined as any of the characters: space, tab +and newline." + (list :beg (save-excursion (skip-chars-backward " \t\n") (point)) + :end (save-excursion (skip-chars-forward " \t\n") (point)) + :op "" + :cl "" + :prefix "" + :suffix "")) + +(defun sp--sgml-get-tag-name (match) + (let ((sub (if (equal "/" (substring match 1 2)) + (substring match 2) + (substring match 1)))) + (car (split-string sub "\\( \\|>\\)")))) + +(defun sp--sgml-opening-p (tag) + (not (equal "/" (substring tag 1 2)))) + +(defun sp--sgml-ignore-tag (tag) + "Return non-nil if tag should be ignored in search, nil otherwise." + (member tag '("!--" "!DOCTYPE"))) + +(defun sp-get-sgml-tag (&optional back) + (sp--maybe-init) + (sp--with-case-sensitive + (save-excursion + (let ((search-fn (if (not back) 'sp--search-forward-regexp 'search-backward-regexp)) + tag tag-name needle + open-start open-end + close-start close-end) + (when (and (funcall search-fn "" nil t) + (progn + (setq tag (substring-no-properties (match-string 0))) + (setq tag-name (sp--sgml-get-tag-name tag)) + (not (sp--sgml-ignore-tag tag-name)))) + (setq needle (concat "" nil t) + (setq open-end (point)))) + (cond + ((and (not back) (not forward)) + (goto-char (match-beginning 0))) + ((and back forward) + (goto-char (match-end 0)))) + (while (> depth 0) + (if (funcall search-fn needle nil t) + (if (sp--sgml-opening-p (match-string 0)) + (if forward (setq depth (1+ depth)) (setq depth (1- depth))) + (if forward (setq depth (1- depth)) (setq depth (1+ depth)))) + (setq depth -1))) + (if (eq depth -1) + (progn (sp-message :no-matching-tag) nil) + (save-excursion + (if forward + (progn + (setq close-start (match-beginning 0)) + (search-forward-regexp ">" nil t) + (setq close-end (point))) + (setq close-start (point)) + (search-forward-regexp ">" nil t) + (setq close-end (point)))) + (let ((op (buffer-substring-no-properties open-start open-end)) + (cl (buffer-substring-no-properties close-start close-end))) + (list :beg (if forward open-start close-start) + :end (if forward close-end open-end) + :op (if forward op cl) + :cl (if forward cl op) + :prefix "" + :suffix ""))))))))) + +(defun sp--end-delimiter-closure (pairs pair-list) + "Compute the \"end-delimiter\" closure of set PAIRS. + +PAIRS can be: +- single pair ID +- single cons with opening and closing delimiter +- list of pair IDs +- list of conses of opening and closing delimiters + +For example, if we have pairs (if . end) and (def . end), then +the closure of \"if\" pair are both of these because they share +the closing delimiter. Therefore, in the navigation functions, +both have to be considered by the parser." + (let* ((pairs (-flatten (list pairs))) + (pairs (if (consp (car pairs)) (-map 'car pairs) pairs)) + (pairs (--filter (member (car it) pairs) pair-list)) + (closure (-mapcat + (lambda (x) + (--filter (equal (cdr x) (cdr it)) pair-list)) + pairs))) + closure)) + +(defun sp-restrict-to-pairs (pairs function) + "Call the FUNCTION restricted to PAIRS. + +PAIRS is either an opening delimiter of a list of opening +delimiters. + +FUNCTION is a function symbol. + +For example, you can restrict function `sp-down-sexp' to the +pair (\"{\" . \"}\") for easier navigation of blocks in C-like +languages." + (let* ((pairs (-flatten (list pairs))) + (new-pairs (--filter (member (car it) pairs) sp-pair-list)) + (sp-pair-list (sp--end-delimiter-closure new-pairs sp-pair-list))) + (call-interactively function))) + +(defun sp-restrict-to-object (object function) + "Call the FUNCTION restricted to OBJECT. + +OBJECT is one of following symbols (you have to quote it!): +- `sp-prefix-pair-object' +- `sp-prefix-tag-object' +- `sp-prefix-symbol-object' + +This function will enable this prefix and then call FUNCTION. + +FUNCTION is a function symbol. + +This function is equivalent to doing: + + (let ((sp-prefix-object t)) + (call-interactively function)) + +For example, you can restrict function `sp-forward-sexp' to just +the pairs for easier navigation of blocks in C-like languages." + (cl-letf (((symbol-value object) t)) + (call-interactively function))) + +;; TODO: add shorter alias? +(defun sp-restrict-to-pairs-interactive (pairs function) + "Return an interactive lambda that calls FUNCTION restricted to PAIRS. + +See `sp-restrict-to-pairs'. + +This function implements a \"decorator pattern\", that is, you +can apply another scoping function to the output of this function +and the effects will added together. In particular, you can +combine it with: + +- `sp-restrict-to-object-interactive' + +You can also bind the output of this function directly to a key, like: + + (global-set-key (kbd ...) + (sp-restrict-to-pairs-interactive \"{\" \\='sp-down-sexp)) + +This will be a function that descends down only into { } pair, +ignoring all others." + (lambda (&optional _arg) + (interactive "*P") + (sp-restrict-to-pairs pairs function))) + +(defun sp-restrict-to-object-interactive (object function) + "Return an interactive lambda that calls FUNCTION restricted to OBJECT. + +See `sp-restrict-to-object'. + +This function implements a \"decorator pattern\", that is, you +can apply another scoping function to the output of this function +and the effects will added together. In particular, you can +combine it with: + +- `sp-restrict-to-pairs-interactive' + +You can also bind the output of this function directly to a key, like: + + (global-set-key (kbd ...) (sp-restrict-to-object-interactive + \\='sp-prefix-pair-object + \\='sp-forward-sexp)) + +This will be a function that navigates only by using paired +expressions, ignoring strings and sgml tags." + (lambda (&optional _arg) + (interactive "*P") + (sp-restrict-to-object object function))) + +(defun sp-prefix-tag-object (&optional _arg) + "Read the command and invoke it on the next tag object. + +If you specify a regular emacs prefix argument this is passed to +the executed command. Therefore, executing +\"\\[universal-argument] 2 \\[sp-prefix-tag-object] \\[sp-forward-sexp]\" will move two tag +expressions forward, ignoring possible symbols or paired +expressions inbetween. + +Tag object is anything delimited by sgml tag." + (interactive "P") + (let* ((cmd (read-key-sequence "" t)) + (com (key-binding cmd)) + (sp-prefix-tag-object t)) + (if (commandp com) + (call-interactively com) + (execute-kbd-macro cmd)))) + +(defun sp-prefix-pair-object (&optional _arg) + "Read the command and invoke it on the next pair object. + +If you specify a regular emacs prefix argument this is passed to +the executed command. Therefore, executing +\"\\[universal-argument] 2 \\[sp-prefix-pair-object] \\[sp-forward-sexp]\" will move two paired +expressions forward, ignoring possible symbols inbetween. + +Pair object is anything delimited by pairs from `sp-pair-list'." + (interactive "P") + (let* ((cmd (read-key-sequence "" t)) + (com (key-binding cmd)) + (sp-prefix-pair-object t)) + (if (commandp com) + (call-interactively com) + (execute-kbd-macro cmd)))) + +(defun sp-prefix-symbol-object (&optional _arg) + "Read the command and invoke it on the next pair object. + +If you specify a regular emacs prefix argument this is passed to +the executed command. Therefore, executing +\"\\[universal-argument] 2 \\[sp-prefix-symbol-object] \\[sp-forward-sexp]\" will move two symbols +forward, ignoring any structure. + +Symbol is defined as a chunk of text recognized by +`sp-forward-symbol'." + (interactive "P") + (let* ((cmd (read-key-sequence "" t)) + (com (key-binding cmd)) + (sp-prefix-symbol-object t)) + (if (commandp com) + (call-interactively com) + (execute-kbd-macro cmd)))) + +(defun sp-prefix-save-excursion (&optional _arg) + "Execute the command keeping the point fixed. + +If you specify a regular emacs prefix argument this is passed to +the executed command." + (interactive "P") + (let* ((cmd (read-key-sequence "" t)) + (com (key-binding cmd))) + (sp--keep-indentation + (save-excursion + (if (commandp com) + (call-interactively com) + (execute-kbd-macro cmd)))))) + +(defun sp-get-thing (&optional back) + "Find next thing after point, or before if BACK is non-nil. + +Thing is either symbol (`sp-get-symbol'), +string (`sp-get-string') or balanced expression recognized by +`sp-get-sexp'. + +If `sp-navigate-consider-symbols' is nil, only balanced +expressions are considered." + (sp--maybe-init) + (sp--with-case-sensitive + (cond + (sp-prefix-tag-object (sp-get-sgml-tag back)) + (sp-prefix-pair-object (sp-get-paired-expression back)) + (sp-prefix-symbol-object (sp-get-symbol back)) + (t + (if back + (if (not sp-navigate-consider-symbols) + (sp-get-sexp t) + (save-excursion + (cond + ((sp-point-in-empty-string) + (sp-get-string t)) + (t + (sp-skip-backward-to-symbol t nil t) + (cond + ;; this is an optimization, we do not need to look up + ;; the "pair" expression first. If this fails, follow + ;; up with regular sexps + ((and (memq major-mode sp-navigate-consider-sgml-tags) + (or (sp--looking-back ">") + ;; sp-skip-backward-to-symbol moves the + ;; point to the end of an element name in + ;; js2-jsx-mode + (looking-at ">")) + (sp-get-sgml-tag t))) + ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-closing-regexp (sp--get-allowed-pair-list)) nil)) + (sp-get-sexp t)) + ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-opening-regexp (sp--get-allowed-pair-list)) nil)) + (sp-get-sexp t)) + ((and (eq (syntax-class (syntax-after (1- (point)))) 7) + (not (sp-char-is-escaped-p (1- (point))))) + (sp-get-string-or-nested-string t)) + ((sp--valid-initial-delimiter-p (sp--looking-back (sp--get-stringlike-regexp) nil)) + (sp-get-expression t)) + ;; We might be somewhere inside the prefix of the + ;; sexp after the point. Since the prefix can be + ;; specified as regexp and not syntax class, it might + ;; itself by a symbol which would invalidly get + ;; picked here. + (t (-when-let (sym (sp-get-symbol t)) + (save-excursion + (sp-get sym (goto-char :end)) + (if (sp--valid-initial-delimiter-p (sp--looking-at (sp--get-opening-regexp (sp--get-allowed-pair-list)))) + (let* ((ms (match-string 0)) + (pref (sp--get-prefix (point) ms))) + (if (and pref + (not (equal pref ""))) + (sp-get-sexp t) + sym)) + sym))))))))) + (if (not sp-navigate-consider-symbols) + (sp-get-sexp nil) + (save-excursion + (cond + ((sp-point-in-empty-string) + (sp-get-string nil)) + (t + (sp-skip-forward-to-symbol t nil t) + (cond + ((and (memq major-mode sp-navigate-consider-sgml-tags) + (or (looking-at "<") + ;; sp-skip-forward-to-symbol moves the point + ;; to the beginning of an element name in + ;; js2-jsx-mode + (and (sp--looking-back "= because the first skip to + ;; symbol might have skipped some prefix + ;; chars which make prefix of the symbol + ;; which together make prefix of a sexp. + ;; For example \foo{} in latex, where \ is + ;; prefix of symbol foo and \foo is prefix + ;; of { + (if (and pref + (not (equal pref "")) + (>= point-before-prefix (- (point) (length pref)))) + (sp-get-sexp nil) + sym)) + sym)))))))))))))) + +(defun sp-narrow-to-sexp (arg) + "Make text outside current balanced expression invisible. +A numeric arg specifies to move up by that many enclosing expressions. + +See also `narrow-to-region' and `narrow-to-defun'." + (interactive "p") + (-when-let (enc (sp-get-enclosing-sexp arg)) + (sp-get enc (narrow-to-region :beg-prf :end)))) + +(defun sp-forward-sexp (&optional arg) + "Move forward across one balanced expression. + +With ARG, do it that many times. Negative arg -N means move +backward across N balanced expressions. If there is no forward +expression, jump out of the current one (effectively doing +`sp-up-sexp'). + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions. + +Examples: (prefix arg in comment) + + |(foo bar baz) -> (foo bar baz)| + + (|foo bar baz) -> (foo| bar baz) + + (|foo bar baz) -> (foo bar| baz) ;; 2 + + (foo (bar baz|)) -> (foo (bar baz)|)" + (interactive "^p") + (setq arg (or arg 1)) + (if (< arg 0) + (sp-backward-sexp (- arg)) + (let* ((n arg) + (ok t)) + (while (and ok (> n 0)) + (setq ok (sp-get-thing)) + (setq n (1- n)) + (when ok (goto-char (sp-get ok :end)))) + ok))) + +(put 'sp-forward-sexp 'CUA 'move) + +(defun sp-backward-sexp (&optional arg) + "Move backward across one balanced expression (sexp). + +With ARG, do it that many times. Negative arg -N means move +forward across N balanced expressions. If there is no previous +expression, jump out of the current one (effectively doing +`sp-backward-up-sexp'). + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions. + +Examples: (prefix arg in comment) + + (foo bar baz)| -> |(foo bar baz) + + (foo| bar baz) -> (|foo bar baz) + + (foo bar| baz) -> (|foo bar baz) ;; 2 + + ((|foo bar) baz) -> (|(foo bar) baz)" + (interactive "^p") + (setq arg (or arg 1)) + (if (< arg 0) + (sp-forward-sexp (- arg)) + (let* ((n arg) + (ok t)) + (while (and ok (> n 0)) + (setq ok (sp-get-thing t)) + (setq n (1- n)) + (when ok (goto-char (sp-get ok :beg)))) + ok))) + +(put 'sp-backward-sexp 'CUA 'move) + +(defun sp-next-sexp (&optional arg) + "Move forward to the beginning of next balanced expression. + +With ARG, do it that many times. If there is no next expression +at current level, jump one level up (effectively doing +`sp-backward-up-sexp'). Negative arg -N means move to the +beginning of N-th previous balanced expression. + +If `sp-navigate-interactive-always-progress-point' is non-nil, +and this is called interactively, the point will move to the +first expression in forward direction where it will end up +greater than the current location. + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions. + +Examples: + + ((foo) |bar (baz quux)) -> ((foo) bar |(baz quux)) + + ((foo) bar |(baz quux)) -> |((foo) bar (baz quux)) + +and with non-nil `sp-navigate-interactive-always-progress-point' + + (f|oo bar) -> (foo |bar) + + ((fo|o) (bar)) -> ((foo) |(bar))" + (interactive "^p") + (setq arg (or arg 1)) + (if (<= arg 0) + (sp-backward-sexp (- arg)) + (if (and sp-navigate-interactive-always-progress-point + (called-interactively-p 'any)) + (progn + (while (< 0 arg) + (let ((point-start (point))) + (while (--when-let (sp-forward-sexp) + (<= (sp-get it :beg) point-start)))) + (setq arg (1- arg))) + (goto-char (sp-get (sp-get-thing t) :beg))) + (if (= arg 1) + (-when-let (ok (sp-get-thing)) + (if (= (point) (sp-get ok :beg)) + (progn (sp-forward-sexp 2) + (sp-backward-sexp)) + (goto-char (sp-get ok :beg)) + ok)) + (sp-forward-sexp arg) + (sp-backward-sexp))))) + +(put 'sp-next-sexp 'CUA 'move) + +(defun sp-previous-sexp (&optional arg) + "Move backward to the end of previous balanced expression. + +With ARG, do it that many times. If there is no next +expression at current level, jump one level up (effectively +doing `sp-up-sexp'). Negative arg -N means move to the end of +N-th following balanced expression. + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions. + +If `sp-navigate-interactive-always-progress-point' is non-nil, +and this is called interactively, the point will move to the +first expression in backward direction where it will end up +less than the current location. + +Examples: + + ((foo) bar| (baz quux)) -> ((foo)| bar (baz quux)) + + ((foo)| bar (baz quux)) -> ((foo) bar (baz quux))| + +and if `sp-navigate-interactive-always-progress-point' is non-nil + + (foo b|ar baz) -> (foo| bar baz) + + (foo (b|ar baz)) -> (foo| (bar baz))" + (interactive "^p") + (setq arg (or arg 1)) + (if (<= arg 0) + (sp-forward-sexp (- arg)) + (if (and sp-navigate-interactive-always-progress-point + ;; (called-interactively-p 'any) + ) + (progn + (while (< 0 arg) + (let ((point-start (point))) + (while (--when-let (sp-backward-sexp) + (>= (sp-get it :end) point-start)))) + (setq arg (1- arg))) + (goto-char (sp-get (sp-get-thing) :end))) + (if (= arg 1) + (-when-let (ok (sp-get-thing t)) + (if (= (point) (sp-get ok :end)) + (progn (sp-backward-sexp 2) + (sp-forward-sexp)) + (goto-char (sp-get ok :end)) + ok)) + (sp-backward-sexp arg) + (sp-forward-sexp))))) + +(put 'sp-previous-sexp 'CUA 'move) + +(defun sp-forward-parallel-sexp (&optional arg) + "Move forward across one balanced expressions at the same depth. + +If calling `sp-forward-sexp' at point would result in raising a +level up, loop back to the first expression at current level, +that is the first child of the enclosing sexp as defined by +`sp-get-enclosing-sexp'." + (interactive "^p") + (setq arg (or arg 1)) + (if (< arg 0) + (sp-backward-parallel-sexp (- arg)) + (let (re) + (while (> arg 0) + (setq arg (1- arg)) + (let ((next (sp-get-thing)) + (prev (sp-get-thing t))) + (setq + re + (cond + ((eq next nil) + (goto-char (point-min)) + (sp-forward-sexp)) + ((eq prev nil) + (goto-char (sp-get next :end)) + next) + (t (if (> (sp-get next :beg) (sp-get prev :beg)) + (progn + (goto-char (sp-get next :end)) + next) + (goto-char (sp-get next :beg-in)) + (sp-forward-sexp))))))) + re))) + +(defun sp-backward-parallel-sexp (&optional arg) + "Move backward across one balanced expressions at the same depth. + +If calling `sp-backward-sexp' at point would result in raising a +level up, loop back to the last expression at current level, that +is the last child of the enclosing sexp as defined by +`sp-get-enclosing-sexp'." + (interactive "^p") + (setq arg (or arg 1)) + (if (< arg 0) + (sp-forward-parallel-sexp (- arg)) + (let (re) + (while (> arg 0) + (setq arg (1- arg)) + (let ((next (sp-get-thing)) + (prev (sp-get-thing t))) + (setq + re + (cond + ((eq prev nil) + (goto-char (point-max)) + (sp-backward-sexp)) + ((eq next nil) + (goto-char (sp-get prev :beg)) + prev) + (t (if (< (sp-get prev :end) (sp-get next :end)) + (progn + (goto-char (sp-get prev :beg)) + prev) + (goto-char (sp-get prev :end-in)) + (sp-backward-sexp))))))) + re))) + +(defun sp--raw-argument-p (arg) + "Return t if ARG represents raw argument, that is a non-empty list." + (and (listp arg) (car arg))) + +(defun sp--negate-argument (arg) + "Return the argument ARG but negated. + +If the argument is a raw prefix argument (cons num nil) return a +list with its car negated. If the argument is just the - symbol, +return 1. If the argument is nil, return -1. Otherwise negate +the input number." + (cond + ((sp--raw-argument-p arg) (list (- (car arg)))) + ((eq arg '-) 1) + ((not arg) -1) + (t (- arg)))) + +(defun sp-down-sexp (&optional arg) + "Move forward down one level of sexp. + +With ARG, do this that many times. A negative argument -N means +move backward but still go down a level. + +If ARG is raw prefix argument \\[universal-argument], descend forward as much as +possible. + +If ARG is raw prefix argument \\[universal-argument] \\[universal-argument], jump to the beginning of +current list. + +If the point is inside sexp and there is no down expression to +descend to, jump to the beginning of current one. If moving +backwards, jump to end of current one. + +Examples: + + |foo (bar (baz quux)) -> foo (|bar (baz quux)) + + |foo (bar (baz quux)) -> foo (bar (|baz quux)) ;; 2 + + |foo (bar (baz (quux) blab)) -> foo (bar (baz (|quux) blab)) ;; \\[universal-argument] + + (foo (bar baz) |quux) -> (|foo (bar baz) quux) + + (blab foo |(bar baz) quux) -> (|blab foo (bar baz) quux) ;; \\[universal-argument] \\[universal-argument]" + (interactive "^P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (n (abs arg)) + (ok t) + (last-point -1)) + (if (and raw (= (abs arg) 16)) + ;; jump to the beginning/end of current list + (-when-let (enc (sp-get-enclosing-sexp)) + (if (> arg 0) + (goto-char (sp-get enc :beg-in)) + (goto-char (sp-get enc :end-in))) + (setq ok enc)) + ;; otherwise descend normally + (while (and ok (> n 0)) + (setq ok (sp-get-sexp (< arg 0))) + ;; if the prefix was C-u, we do not decrease n and instead set + ;; it to -1 when (point) == "last ok" + (if raw + (when (= (point) last-point) + (setq n -1)) + (setq n (1- n))) + (when ok + (setq last-point (point)) + (if (< arg 0) + (goto-char (sp-get ok :end-in)) + (goto-char (sp-get ok :beg-in)))))) + ok)) + +(put 'sp-down-sexp 'CUA 'move) + +(defun sp-backward-down-sexp (&optional arg) + "Move backward down one level of sexp. + +With ARG, do this that many times. A negative argument -N means +move forward but still go down a level. + +If ARG is raw prefix argument \\[universal-argument], descend backward as much as +possible. + +If ARG is raw prefix argument \\[universal-argument] \\[universal-argument], jump to the end of current +list. + +If the point is inside sexp and there is no down expression to +descend to, jump to the end of current one. If moving forward, +jump to beginning of current one. + +Examples: + + foo (bar (baz quux))| -> foo (bar (baz quux)|) + + (bar (baz quux)) foo| -> (bar (baz quux|)) foo ;; 2 + + foo (bar (baz (quux) blab))| -> foo (bar (baz (quux|) blab)) ;; \\[universal-argument] + + (foo| (bar baz) quux) -> (foo (bar baz) quux|) + + (foo (bar baz) |quux blab) -> (foo (bar baz) quux blab|) ;; \\[universal-argument] \\[universal-argument]" + (interactive "^P") + (sp-down-sexp (sp--negate-argument arg))) + +(put 'sp-backward-down-sexp 'CUA 'move) + +(defun sp-beginning-of-sexp (&optional arg) + "Jump to beginning of the sexp the point is in. + +The beginning is the point after the opening delimiter. + +With no argument, this is the same as calling +\\[universal-argument] \\[universal-argument] `sp-down-sexp' + +With ARG positive N > 1, move forward out of the current +expression, move N-2 expressions forward and move down one level +into next expression. + +With ARG negative -N < 1, move backward out of the current +expression, move N-1 expressions backward and move down one level +into next expression. + +With ARG raw prefix argument \\[universal-argument] move out of the current expressions +and then to the beginning of enclosing expression. + +Examples: + + (foo (bar baz) quux| (blab glob)) -> (|foo (bar baz) quux (blab glob)) + + (foo (bar baz|) quux (blab glob)) -> (foo (|bar baz) quux (blab glob)) + + (|foo) (bar) (baz quux) -> (foo) (bar) (|baz quux) ;; 3 + + (foo bar) (baz) (quux|) -> (|foo bar) (baz) (quux) ;; -3 + + ((foo bar) (baz |quux) blab) -> (|(foo bar) (baz quux) blab) ;; \\[universal-argument]" + (interactive "^P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (re (cond + ((and raw (= arg 4)) + (sp-up-sexp) + (sp-beginning-of-sexp)) + ((= arg 1) + (sp-down-sexp '(16))) + ((< arg 0) + (sp-backward-up-sexp) + (sp-forward-sexp (1+ arg)) + (sp-down-sexp)) + ((> arg 0) + (sp-up-sexp) + (sp-forward-sexp (- arg 2)) + (sp-down-sexp))))) + (sp--run-hook-with-args (sp-get re :op) :post-handlers 'beginning-of-sexp) + re)) + +(put 'sp-beginning-of-sexp 'CUA 'move) + +(defun sp-end-of-sexp (&optional arg) + "Jump to end of the sexp the point is in. + +The end is the point before the closing delimiter. + +With no argument, this is the same as calling +\\[universal-argument] \\[universal-argument] `sp-backward-down-sexp'. + +With ARG positive N > 1, move forward out of the current +expression, move N-1 expressions forward and move down backward +one level into previous expression. + +With ARG negative -N < 1, move backward out of the current +expression, move N-2 expressions backward and move down backward +one level into previous expression. + +With ARG raw prefix argument \\[universal-argument] move out of the current expressions +and then to the end of enclosing expression. + +Examples: + + (foo |(bar baz) quux (blab glob)) -> (foo (bar baz) quux (blab glob)|) + + (foo (|bar baz) quux (blab glob)) -> (foo (bar baz|) quux (blab glob)) + + (|foo) (bar) (baz quux) -> (foo) (bar) (baz quux|) ;; 3 + + (foo bar) (baz) (quux|) -> (foo bar|) (baz) (quux) ;; -3 + + ((foo |bar) (baz quux) blab) -> ((foo bar) (baz quux) blab|) ;; \\[universal-argument]" + (interactive "^P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (re (cond + ((and raw (= arg 4)) + (sp-up-sexp) + (sp-end-of-sexp)) + ((= arg 1) + (sp-down-sexp '(-16))) + ((< arg 0) + (sp-backward-up-sexp) + (sp-forward-sexp (+ 2 arg)) + (sp-backward-down-sexp)) + ((> arg 0) + (sp-up-sexp) + (sp-forward-sexp (1- arg)) + (sp-backward-down-sexp))))) + (sp--run-hook-with-args (sp-get re :op) :post-handlers 'end-of-sexp) + re)) + +(put 'sp-end-of-sexp 'CUA 'move) + +(defun sp-beginning-of-next-sexp (&optional arg) + "Jump to the beginning of next sexp on the same depth. + +Optional argument ARG defaults to 1 and means how many times we +should repeat. + +This acts exactly as `sp-beginning-of-sexp' but adds 1 to the +numeric argument. + +Examples: + + (f|oo) (bar) (baz) -> (foo) (|bar) (baz) + + (f|oo) (bar) (baz) -> (foo) (bar) (|baz) ;; 2" + (interactive "^P") + (if (sp--raw-argument-p arg) + (sp-beginning-of-sexp arg) + (let ((arg (prefix-numeric-value arg))) + (if (> arg 0) + (sp-beginning-of-sexp (1+ arg)) + (sp-beginning-of-sexp (1- arg)))))) + +(put 'sp-beginning-of-next-sexp 'CUA 'move) + +(defun sp-beginning-of-previous-sexp (&optional arg) + "Jump to the beginning of previous sexp on the same depth. + +Optional argument ARG defaults to 1 and means how many times we +should repeat. + +This acts exactly as `sp-beginning-of-sexp' with negative +argument but subtracts 1 from it. + +Examples: + + (foo) (b|ar) (baz) -> (|foo) (bar) (baz) + + (foo) (bar) (b|az) -> (|foo) (bar) (baz) ;; 2" + (interactive "^P") + (if (sp--raw-argument-p arg) + (sp-beginning-of-sexp (sp--negate-argument arg)) + (let ((arg (prefix-numeric-value arg))) + (if (> arg 0) + (sp-beginning-of-sexp (- (1+ arg))) + (sp-beginning-of-sexp (- (1- arg))))))) + +(put 'sp-beginning-of-previous-sexp 'CUA 'move) + +(defun sp-end-of-next-sexp (&optional arg) + "Jump to the end of next sexp on the same depth. + +Optional argument ARG defaults to 1 and means how many times we +should repeat. + +This acts exactly as `sp-end-of-sexp' but adds 1 to the +numeric argument. + +Examples: + + (f|oo) (bar) (baz) -> (foo) (bar|) (baz) + + (f|oo) (bar) (baz) -> (foo) (bar) (baz|) ;; 2" + (interactive "^P") + (if (sp--raw-argument-p arg) + (sp-end-of-sexp arg) + (let ((arg (prefix-numeric-value arg))) + (if (> arg 0) + (sp-end-of-sexp (1+ arg)) + (sp-end-of-sexp (1- arg)))))) + +(put 'sp-end-of-next-sexp 'CUA 'move) + +(defun sp-end-of-previous-sexp (&optional arg) + "Jump to the end of previous sexp on the same depth. + +Optional argument ARG defaults to 1 and means how many times we +should repeat. + +This acts exactly as `sp-end-of-sexp' with negative +argument but subtracts 1 from it. + +Examples: + + (foo) (b|ar) (baz) -> (foo|) (bar) (baz) + + (foo) (bar) (b|az) -> (foo|) (bar) (baz) ;; 2" + (interactive "^P") + (if (sp--raw-argument-p arg) + (sp-end-of-sexp (sp--negate-argument arg)) + (let ((arg (prefix-numeric-value arg))) + (if (> arg 0) + (sp-end-of-sexp (- (1+ arg))) + (sp-end-of-sexp (- (1- arg))))))) + +(put 'sp-end-of-previous-sexp 'CUA 'move) + +;; TODO: split the reindent code so we can call it inside strings on +;; sexps like [foo ]... We can't reindent that by default because it +;; can be a regular expression or something where the whitespace +;; matters. For now, disable reindent in strings if the sexp is not +;; the string quote itself. +(defun sp-up-sexp (&optional arg interactive) + "Move forward out of one level of parentheses. + +With ARG, do this that many times. A negative argument means +move backward but still to a less deep spot. + +The argument INTERACTIVE is for internal use only. + +If called interactively and `sp-navigate-reindent-after-up' is +enabled for current major-mode, remove the whitespace between end +of the expression and the last \"thing\" inside the expression. +This behaviour can be suppressed for syntactic string sexps by +setting `sp-navigate-reindent-after-up-in-string' to nil. + +If `sp-navigate-close-if-unbalanced' is non-nil, close the +unbalanced expressions automatically. + +Examples: + + (foo |(bar baz) quux blab) -> (foo (bar baz) quux blab)| + + (foo (bar |baz) quux blab) -> (foo (bar baz) quux blab)| ;; 2 + + (foo bar |baz -> (foo bar baz)| ;; re-indent the expression +​ ) + + (foo |(bar baz) -> (foo)| (bar baz) ;; close unbalanced expr." + (interactive "^p\np") + (setq arg (or arg 1)) + (sp--with-case-sensitive + (let ((ok (sp-get-enclosing-sexp (abs arg)))) + (if ok + (progn + (if (> arg 0) + (goto-char (sp-get ok :end)) + (goto-char (sp-get ok :beg))) + (when (and (= (abs arg) 1) + (not (equal (sp-get ok :prefix) sp-comment-char)) + (or (memq major-mode (assq 'always sp-navigate-reindent-after-up)) + (and (memq major-mode (assq 'interactive sp-navigate-reindent-after-up)) + interactive)) + (or sp-navigate-reindent-after-up-in-string + (sp-get ok (not (sp-point-in-string :end-in)))) + ;; if the sexp to be reindented is not a string + ;; but is inside a string, we should rather do + ;; nothing than break semantics (in e.g. regexp + ;; [...]) + (let ((str (sp-point-in-string))) + (or (not str) + ;; op must be the delimiter of the string we're in + (eq (sp-get ok :op) + (or (eq str t) + (char-to-string str)))))) + ;; TODO: this needs different indent rules for different + ;; modes. Should we concern with such things? Lisp rules are + ;; funny in HTML... :/ + (save-excursion + (if (> arg 0) + (progn + (goto-char (sp-get ok :end-in)) + (let ((prev (sp-get-thing t))) + ;; if the expression is empty remove everything inside + (if (sp-compare-sexps ok prev) + (sp-get ok (delete-region :beg-in :end-in)) + (when (save-excursion + (skip-chars-backward " \t\n") + (= (point) (sp-get prev :end-suf))) + (delete-region (sp-get prev :end-suf) (point)))))) + (goto-char (sp-get ok :beg-in)) + (let ((next (sp-get-thing))) + (if (sp-compare-sexps ok next) + (sp-get ok (delete-region :beg-in :end-in)) + (when (save-excursion + (skip-chars-forward " \t\n") + (= (point) (sp-get next :beg-prf))) + (delete-region (point) (sp-get next :beg-prf))))))))) + ;; on forward up, we can detect that the pair was not closed. + ;; Therefore, jump sexps backwards until we hit the error, then + ;; extract the opening pair and insert it at point. Only works + ;; for pairs defined in `sp-pair-list'. + (when (and (> arg 0) + sp-navigate-close-if-unbalanced) + (let (active-pair) + (save-excursion + ;; add support for SGML tags here + (while (sp-backward-sexp)) + (sp-skip-backward-to-symbol t) + (when (sp--looking-back (sp--get-opening-regexp)) + (let* ((op (match-string 0))) + (setq active-pair (assoc op sp-pair-list))))) + (when active-pair + (sp-backward-sexp) + (sp-forward-sexp) + (insert (cdr active-pair)))))) + ok))) + +(put 'sp-up-sexp 'CUA 'move) + +(defun sp-backward-up-sexp (&optional arg interactive) + "Move backward out of one level of parentheses. + +With ARG, do this that many times. A negative argument means +move forward but still to a less deep spot. + +The argument INTERACTIVE is for internal use only. + +If called interactively and `sp-navigate-reindent-after-up' is +enabled for current major-mode, remove the whitespace between +beginning of the expression and the first \"thing\" inside the +expression. + +Examples: + + (foo (bar baz) quux| blab) -> |(foo (bar baz) quux blab) + + (foo (bar |baz) quux blab) -> |(foo (bar baz) quux blab) ;; 2 + + ( -> |(foo bar baz) +​ foo |bar baz)" + (interactive "^p\np") + (setq arg (or arg 1)) + (sp-up-sexp (- arg) interactive)) + +(put 'sp-backward-up-sexp 'CUA 'move) + +(defvar sp-last-kill-whitespace nil + "Save the whitespace cleaned after the last kill. + +If the next command is `sp-kill-sexp', append the whitespace +between the successive kills.") + +(defun sp--kill-or-copy-region (beg end &optional dont-kill) + "Kill or copy region between BEG and END according to DONT-KILL. +If `evil-mode' is active, copying a region will also add it to the 0 register. +Additionally, if command was prefixed with a register, copy the region +to that register." + (interactive "*") + (let ((result + (if dont-kill + (copy-region-as-kill beg end) + (kill-region beg end)))) + (when (bound-and-true-p evil-mode) + (when dont-kill + (evil-set-register ?0 (evil-get-register ?1))) + (when evil-this-register + (evil-set-register evil-this-register (evil-get-register ?1)) + (setq evil-this-register nil))) + result)) + +(defun sp-kill-sexp (&optional arg dont-kill) + "Kill the balanced expression following point. + +If point is inside an expression and there is no following +expression, kill the topmost enclosing expression. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction. + +With ARG being raw prefix \\[universal-argument], kill all the expressions from +point up until the end of current list. With raw prefix \\[negative-argument] \\[universal-argument], +kill all the expressions from beginning of current list up until +point. If point is inside a symbol, this is also killed. If +there is no expression after/before the point, just delete the +whitespace up until the closing/opening delimiter. + +With ARG being raw prefix \\[universal-argument] \\[universal-argument], kill current list (the list +point is inside). + +With ARG numeric prefix 0 (zero) kill the insides of the current +list, that is everything from after the opening delimiter to +before the closing delimiter. + +If ARG is nil, default to 1 (kill single expression forward) + +If second optional argument DONT-KILL is non-nil, save the to be +killed region in the kill ring, but do not kill the region from +buffer. + +With `sp-navigate-consider-symbols', symbols and strings are also +considered balanced expressions. + +Examples: + + (foo |(abc) bar) -> (foo | bar) ;; nil, defaults to 1 + + (foo (bar) | baz) -> | ;; 2 + + (foo |(bar) baz) -> | ;; \\[universal-argument] \\[universal-argument] + + (1 |2 3 4 5 6) -> (1|) ;; \\[universal-argument] + + (1 |2 3 4 5 6) -> (1 | 5 6) ;; 3 + + (1 2 3 4 5| 6) -> (1 2 3 | 6) ;; -2 + + (1 2 3 4| 5 6) -> (|5 6) ;; \\[negative-argument] \\[universal-argument] + + (1 2 | ) -> (1 2|) ;; \\[universal-argument], kill useless whitespace + + (1 2 3 |4 5 6) -> (|) ;; 0 + +Note: prefix argument is shown after the example in +\"comment\". Assumes `sp-navigate-consider-symbols' equal to t." + (interactive "*P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (n (abs arg)) + (ok t) + (b (point-max)) + (e (point))) + (cond + ;; kill to the end or beginning of list + ((and raw + (= n 4)) + (let ((next (sp-get-thing (< arg 0))) + (enc (sp-get-enclosing-sexp))) + (if (sp-compare-sexps next enc) + (when (not dont-kill) + (let ((del (sp-get-whitespace))) + (sp-get del (delete-region :beg :end)))) + (if (> arg 0) + (sp--kill-or-copy-region + (sp-get next :beg-prf) (sp-get enc :end-in) dont-kill) + (sp--kill-or-copy-region + (sp-get next :end) (sp-get enc :beg-in) dont-kill)) + (when (not dont-kill) + (let ((del (sp-get-whitespace))) + (sp-get del (delete-region :beg :end))))))) + ;; kill the enclosing list + ((and raw + (= n 16)) + (let ((lst (sp-backward-up-sexp))) + (sp-get lst (sp--kill-or-copy-region + :beg-prf :end dont-kill)))) + ;; kill inside of sexp + ((= n 0) + (let ((e (sp-get-enclosing-sexp))) + (when e + (sp-get e (sp--kill-or-copy-region + :beg-in :end-in dont-kill))))) + ;; regular kill + (t + (save-excursion + (while (and (> n 0) ok) + (setq ok (sp-forward-sexp (sp--signum arg))) + (sp-get ok + (when (< :beg-prf b) (setq b :beg-prf)) + (when (> :end e) (setq e :end))) + (setq n (1- n)))) + (when ok + (let ((bm (set-marker (make-marker) b))) + (if (eq last-command 'kill-region) + (progn + (when (member sp-successive-kill-preserve-whitespace '(1 2)) + (kill-append sp-last-kill-whitespace nil)) + (sp--kill-or-copy-region + (if (> b (point)) (point) b) e dont-kill)) + (sp--kill-or-copy-region b e dont-kill)) + ;; kill useless junk whitespace, but only if we're actually + ;; killing the region + (when (not dont-kill) + (sp--cleanup-after-kill) + ;; kill useless newlines + (when (string-match-p "\n" (buffer-substring-no-properties bm (point))) + (setq sp-last-kill-whitespace + (concat sp-last-kill-whitespace + (buffer-substring-no-properties bm (point)))) + (delete-region bm (point))) + (when (= 0 sp-successive-kill-preserve-whitespace) + (kill-append sp-last-kill-whitespace nil))))))))) + +(defun sp--cleanup-after-kill () + (unless (save-match-data (looking-back "^[\t\s]+" (1- (line-beginning-position)))) + (let ((bdel (save-excursion + (when (sp--looking-back-p " " 1) + (skip-chars-backward " \t") + (when (not (sp--looking-back-p (sp--get-opening-regexp))) + (forward-char))) + (point))) + (edel (save-excursion + (when (looking-at " ") + (skip-chars-forward " \t") + (when (not (or (sp--looking-at (sp--get-closing-regexp)) + (looking-at "$"))) + (backward-char))) + (point)))) + (when (eq this-command 'kill-region) + (setq sp-last-kill-whitespace + (if (/= 2 sp-successive-kill-preserve-whitespace) + (buffer-substring-no-properties bdel edel) + ""))) + (delete-region bdel edel))) + (if (memq major-mode sp-lisp-modes) + ;; WARNING: The above white-space killing routine might preserve + ;; less whitespace than there actually is because the indent + ;; might further eat some up + (indent-according-to-mode) + (unless (or (memq major-mode sp-no-reindent-after-kill-modes) + (memq indent-line-function + sp-no-reindent-after-kill-indent-line-functions)) + (save-excursion + (sp--indent-region (line-beginning-position) (line-end-position))) + (when (> (save-excursion + (back-to-indentation) + (current-indentation)) + (current-column)) + (back-to-indentation))))) + +(defun sp-backward-kill-sexp (&optional arg dont-kill) + "Kill the balanced expression preceding point. + +This is exactly like calling `sp-kill-sexp' with minus ARG. +In other words, the direction of all commands is reversed. For +more information, see the documentation of `sp-kill-sexp'. + +Examples: + + (foo (abc)| bar) -> (foo | bar) + + blab (foo (bar baz) quux)| -> blab | + + (1 2 3 |4 5 6) -> (|4 5 6) ;; \\[universal-argument]" + (interactive "*P") + (sp-kill-sexp (sp--negate-argument arg) dont-kill)) + +(defun sp-copy-sexp (&optional arg) + "Copy the following ARG expressions to the kill-ring. + +This is exactly like calling `sp-kill-sexp' with second argument +t. All the special prefix arguments work the same way." + (interactive "P") + (save-excursion + (sp-kill-sexp arg t))) + +(defun sp-backward-copy-sexp (&optional arg) + "Copy the previous ARG expressions to the kill-ring. + +This is exactly like calling `sp-backward-kill-sexp' with second argument +t. All the special prefix arguments work the same way." + (interactive "P") + (save-excursion + (sp-kill-sexp (sp--negate-argument arg) t))) + +(defun sp-clone-sexp () + "Clone sexp after or around point. + +If the form immediately after point is a sexp, clone it below the +current one and put the point in front of it. + +Otherwise get the enclosing sexp and clone it below the current +enclosing sexp." + (interactive "*") + (-when-let (ok (let ((sexp (sp-get-thing))) + (if (not (equal (sp-get sexp :op) "")) + sexp + (sp-get-enclosing-sexp)))) + (sp-get ok + (undo-boundary) + (if (< :beg-prf (point)) + ;; this is the case where point is inside a sexp, we place + ;; the "clone" before the current enclosing sexp and move + ;; the old one below. Note that the "net result" is the + ;; same as the other case, but the implementation must + ;; reflect different relative position of the point wrt + ;; "current" sexp. + (save-excursion + (goto-char :beg-prf) + (insert-buffer-substring-no-properties + (current-buffer) :beg-prf :end-suf) + (newline-and-indent)) + ;; in this case we are in front, so we move after the current + ;; one, place the clone and move it below + (goto-char :end-suf) + (save-excursion + (insert-buffer-substring-no-properties + (current-buffer) :beg-prf :end-suf)) + (newline-and-indent)) + (sp-indent-defun)))) + +(defun sp-kill-hybrid-sexp (arg) + "Kill a line as if with `kill-line', but respecting delimiters. + +With ARG being raw prefix \\[universal-argument] \\[universal-argument], kill the hybrid sexp +the point is in (see `sp-get-hybrid-sexp'). + +With ARG numeric prefix 0 (zero) just call `kill-line'. + +You can customize the behaviour of this command by customizing +`sp-hybrid-kill-excessive-whitespace' and +`sp-hybrid-kill-entire-symbol'. + +Examples: + + foo | bar baz -> foo | ;; nil + + foo (bar | baz) quux -> foo (bar |) quux ;; nil + + foo | bar (baz -> foo | ;; nil + quux) + + foo \"bar |baz quux\" quack -> foo \"bar |\" quack ;; nil + + foo (bar + baz) qu|ux (quack -> foo | hoo ;; \\[universal-argument] \\[universal-argument] + zaq) hoo + + foo | (bar -> foo | ;; C-0 + baz) baz)" + (interactive "*P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (orig-indent (save-excursion + (back-to-indentation) + (current-column))) + (orig-column (current-column))) + (cond + ((= arg 0) (kill-line)) + ((and raw (= arg 16)) + (let ((hl (sp-get-hybrid-sexp))) + (sp-get hl (kill-region :beg-prf :end-suf)))) + (t + (let ((hl (sp-get-hybrid-sexp))) + (save-excursion + (when (and (or (eq sp-hybrid-kill-entire-symbol t) + (and (functionp sp-hybrid-kill-entire-symbol) + (not (funcall sp-hybrid-kill-entire-symbol)))) + (sp-point-in-symbol)) + (sp-backward-sexp)) + (sp-get hl + (let ((end (min (point-max) (if (looking-at "[ \t]*$") + (1+ :end-suf) + :end-suf)))) + (when sp-hybrid-kill-excessive-whitespace + (save-excursion + (goto-char end) + (skip-chars-forward "\n\t\r\s") + (cond + ((eq 'kill sp-hybrid-kill-excessive-whitespace) + (setq end (point))) + (t (delete-region end (point)))))) + (kill-region (point) end))))) + (sp--cleanup-after-kill) + ;; if we've killed the entire line, do *not* contract the indent + ;; to just one space + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (line-end-position)) + (if (and (= 0 orig-column) + kill-whole-line) + (delete-char 1) ;; delete the newline + (let ((need-indent (- orig-indent (current-column)))) + (when (> need-indent 0) + (insert (make-string need-indent ?\ )))))))))) + +(defun sp-kill-whole-line () + "Kill current line in sexp-aware manner. + +First, go to the beginning of current line and then try to kill +as much as possible on the current line but without breaking +balance. + +If there is a hanging sexp at the end of line the it is killed as +well. + +If there is a closing delimiter for a sexp \"up\" current sexp, +the kill is not extended after it. For more details see +`sp-kill-hybrid-sexp'. + +Examples: + + (progn (progn + (some |long sexp)) -> |)" + (interactive "*") + (beginning-of-line) + (sp-kill-hybrid-sexp nil) + (let ((empty-last-line (save-excursion (beginning-of-line) (eobp)))) + ;; We can't kill the line if it is empty and the last line + (when (and (sp-point-in-blank-line) (not empty-last-line)) + (kill-whole-line)))) + +(defun sp--transpose-objects (first second) + "Transpose FIRST and SECOND object while preserving the +whitespace between them." + (save-excursion + (goto-char (sp-get second :beg-prf)) + (let ((ins (sp-get second (delete-and-extract-region :beg-prf :end))) + (between (delete-and-extract-region (sp-get first :end) (point)))) + (goto-char (sp-get first :beg-prf)) + (insert ins between)))) + +(defun sp-transpose-sexp (&optional arg) + "Transpose the expressions around point. + +The operation will move the point after the transposed block, so +the next transpose will \"drag\" it forward. + +With arg positive N, apply that many times, dragging the +expression forward. + +With arg negative -N, apply N times backward, pushing the word +before cursor backward. This will therefore not transpose the +expressions before and after point, but push the expression +before point over the one before it. + +Examples: + + foo |bar baz -> bar foo| baz + + foo |bar baz -> bar baz foo| ;; 2 + + (foo) |(bar baz) -> (bar baz) (foo)| + + (foo bar) -> (baz quux) ;; keeps the formatting +​ |(baz quux) |(foo bar) + + foo bar baz| -> foo baz| bar ;; -1" + (interactive "*P") + (let* ((arg (prefix-numeric-value arg)) + (n (abs arg))) + ;; if we're inside a symbol, we need to move out of it first + (when (> arg 0) + (when (sp-point-in-symbol) + (sp-forward-symbol))) + (while (> n 0) + (when (< arg 0) (sp-backward-sexp)) + (let* ((next (save-excursion (sp-forward-sexp))) + (prev (save-excursion (goto-char (sp-get next :beg-prf)) (sp-backward-sexp)))) + (sp--transpose-objects prev next) + (when (< arg 0) + (goto-char (+ (sp-get prev :beg-prf) (sp-get next :len)))) + (setq n (1- n)))))) + +(defun sp-transpose-hybrid-sexp (&optional arg) + "Transpose the hybrid sexps around point. + +`sp-backward-sexp' is used to enter the previous hybrid sexp. + +With ARG numeric prefix call `transpose-lines' with this +argument. + +The operation will move the point at the next line after the +transposed block if it is at the end of line already. + +Examples: + + foo bar baz (quux + |baz (quux -> quack) + quack) foo bar\\n| + + + [(foo) (bar) -> [(baz) + |(baz)] (foo) (bar)|] + + foo bar baz -> quux flux + |quux flux foo bar baz\\n|" + (interactive "*P") + (if (numberp arg) + (transpose-lines arg) + (let* ((next (save-excursion + (sp-forward-sexp) + (sp-backward-sexp) + (sp-get-hybrid-sexp))) + (prev (save-excursion + (goto-char (sp-get next :beg)) + (sp-backward-sexp) + (sp-get-hybrid-sexp)))) + (if (sp-compare-sexps prev next > :end) + (sp-message :invalid-context-prev) + (sp--transpose-objects prev next)) + (when (looking-at "[\n\t ]+") + (forward-line) + (back-to-indentation))))) + +(defun sp-push-hybrid-sexp () + "Push the hybrid sexp after point over the following one. + +`sp-forward-sexp' is used to enter the following hybrid sexp. + +Examples: + + |x = big_function_call(a, |(a, + b) b) = read_user_input() + -> + (a, x = big_function_call(a, + b) = read_user_input() b)" + (interactive "*") + (let* ((cur (sp-get-hybrid-sexp)) + (next (save-excursion + (goto-char (sp-get cur :end)) + (sp-forward-sexp) + (sp-get-hybrid-sexp)))) + (if (sp-compare-sexps cur next >) + (sp-message :invalid-context-cur) + (sp--transpose-objects cur next)))) + +;; The following two functions are inspired by "adjust-parens.el" +;; package available at +;; http://elpa.gnu.org/packages/adjust-parens-1.0.el +(defun sp-indent-adjust-sexp () + "Add the hybrid sexp at line into previous sexp. All forms +between the two are also inserted. Specifically, if the point is +on empty line, move the closing delimiter there, so the next +typed text will become the last item of the previous sexp. + +This acts similarly to `sp-add-to-previous-sexp' but with special +handling of empty lines." + (interactive "*") + (let* ((hsexp (sp-get-hybrid-sexp)) + (prev-sexp (save-excursion + (goto-char (sp-get hsexp :beg)) + (sp-get-sexp t)))) + (if (not (and prev-sexp hsexp + (sp-compare-sexps prev-sexp hsexp < :end :beg))) + (sp-message :no-structure-found) + (save-excursion + (sp-get prev-sexp + (goto-char (sp-get hsexp :end)) + (insert :cl) + (goto-char :end-in) + (delete-char :cl-l))) + (sp-get (sp-get-enclosing-sexp) (sp--indent-region :beg :end)) + (indent-according-to-mode) + (sp--run-hook-with-args (sp-get prev-sexp :op) :post-handlers 'indent-adjust-sexp)))) + +(defun sp-dedent-adjust-sexp () + "Remove the hybrid sexp at line from previous sexp. All +sibling forms after it are also removed (not deleted, just placed +outside of the enclosing list). Specifically, if the point is on +empty line followed by closing delimiter of enclosing list, move +the closing delimiter after the last item in the list. + +This acts similarly to `sp-forward-barf-sexp' but with special +handling of empty lines." + (interactive "*") + (-when-let (enc (sp-get-enclosing-sexp)) + (save-excursion + ;; if we're looking at whitespace and end of sexp, move the + ;; closing paren over the whitespace but *after* the last item + ;; in the list (barf would also go *before* the last item) + (sp-skip-forward-to-symbol t) + (if (= (point) (sp-get enc :end-in)) + (let ((prev-sexp (sp-get-thing t))) + (sp-get enc + (delete-char :cl-l) + (goto-char (sp-get prev-sexp :end)) + ;; see next TODO + (save-restriction + (sp--narrow-to-line) + (skip-syntax-forward " ") + (skip-syntax-forward ".")) + (insert :cl))) + ;; otherwise just C-u barf + (sp-skip-backward-to-symbol t) + (sp-forward-barf-sexp '(4)) + ;; we need to take special care of any hanging + ;; punctuation. TODO: this should be a sexp suffix? HACK until + ;; we fix barf to get the info. + (save-restriction + (sp-get (sp-backward-down-sexp) + (goto-char :end) + (delete-char (- :cl-l)) + (sp--narrow-to-line) + (skip-syntax-forward " ") + (skip-syntax-forward ".") + (insert :cl))) + (sp-get enc (sp--indent-region :beg :end)))) + (indent-according-to-mode) + (sp--run-hook-with-args (sp-get enc :op) :post-handlers 'dedent-adjust-sexp))) + +;; "When the hook is called point is *after* the just moved closing delimiter." +;; TODO: add hook +(defun sp-slurp-hybrid-sexp () + "Add hybrid sexp following the current list in it by moving the +closing delimiter. + +This is philosophically similar to `sp-forward-slurp-sexp' but +works better in \"line-based\" languages like C or Java. + +Because the structure is much looser in these languages, this +command currently does not support all the prefix argument +triggers that `sp-forward-slurp-sexp' does." + (interactive "*") + (let (slurped-within-line) + (-if-let* ((enc (sp-get-enclosing-sexp)) + (bsexp (save-excursion + (sp-get enc (goto-char :end)) + (when (sp-compare-sexps (sp-forward-sexp) enc >) + (sp-get-hybrid-sexp))))) + (save-excursion + (sp-get enc + (goto-char :end-suf) + (delete-char (- (+ :cl-l :suffix-l))) + ;; TODO: move to hook + (when (sp-point-in-blank-line) + (delete-region (line-beginning-position) (1+ (line-end-position)))) + (sp-forward-sexp) + + (when (eq (line-number-at-pos :beg) + (line-number-at-pos :end)) + (setq slurped-within-line t)) + ;; If we're slurping over multiple lines, include the suffix on the next line. + ;; I.e. while () {|} -> while () {\n foo(); \n} + (unless slurped-within-line + (sp-get (sp-get-hybrid-sexp) (goto-char :end-suf))) + (insert :cl :suffix)) + ;; TODO: move to hook + (sp-get (sp--next-thing-selection -1) + (save-excursion + (if (save-excursion + (goto-char :beg-in) + (looking-at "[ \t]*$")) + (progn + (goto-char :end-in) + (newline)) + ;; copy the whitespace after opening delim and put it in + ;; front of the closing. This will ensure pretty { foo } + ;; or {foo} + (goto-char :end-in) + (insert (buffer-substring-no-properties + :beg-in + (+ :beg-in (save-excursion + (goto-char :beg-in) + (skip-syntax-forward " "))))))) + (unless (or (looking-at "[ \t]*$") + (looking-at (sp--get-stringlike-regexp)) + (looking-at (sp--get-closing-regexp)) + slurped-within-line) + (newline))) + (sp-get (sp--next-thing-selection -1) (sp--indent-region :beg :end)) + ;; we need to call this again to get the new structure after + ;; indent. + (sp--next-thing-selection -1)) + (sp-message :invalid-structure) + nil))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; "paredit" operations + +(defun sp-forward-slurp-sexp (&optional arg) + "Add sexp following the current list in it by moving the closing delimiter. + +If the current list is the last in a parent list, extend that +list (and possibly apply recursively until we can extend a list +or end of file). + +If ARG is N, apply this function that many times. + +If ARG is negative -N, extend the opening pair instead (that is, +backward). + +If ARG is raw prefix \\[universal-argument], extend all the way to the end of the parent list. + +If both the current expression and the expression to be slurped +are strings, they are joined together. + +See also `sp-slurp-hybrid-sexp' which is similar but handles +C-style syntax better. + +Examples: + + (foo |bar) baz -> (foo |bar baz) + + [(foo |bar)] baz -> [(foo |bar) baz] + + [(foo |bar) baz] -> [(foo |bar baz)] + + ((|foo) bar baz quux) -> ((|foo bar baz quux)) ;; with \\[universal-argument] + + \"foo| bar\" \"baz quux\" -> \"foo| bar baz quux\"" + (interactive "*P") + (if (> (prefix-numeric-value arg) 0) + (let ((n (abs (prefix-numeric-value arg))) + (enc (sp-get-enclosing-sexp)) + (in-comment (sp-point-in-comment)) + next-thing ok) + (when enc + (save-excursion + (if (sp--raw-argument-p arg) + (progn + (goto-char (sp-get enc :end-suf)) + (setq next-thing (sp-get-enclosing-sexp)) + (when next-thing + (goto-char (sp-get next-thing :end-in)) + (sp--run-hook-with-args (sp-get enc :op) :pre-handlers 'slurp-forward + (list :arg arg :enc enc :next-thing next-thing)) + (sp-get enc (insert :cl :suffix)) + (goto-char (sp-get enc :end-suf)) + (delete-char (sp-get enc (- (+ :cl-l :suffix-l)))) + (sp--indent-region (sp-get enc :beg-prf) (sp-get next-thing :end)) + (sp--run-hook-with-args (sp-get enc :op) :post-handlers 'slurp-forward + (list :arg arg :enc enc :next-thing next-thing)))) + (while (> n 0) + (goto-char (sp-get enc :end-suf)) + (setq ok enc) + (setq next-thing (sp-get-thing nil)) + (while (sp-compare-sexps next-thing ok <) + (goto-char (sp-get next-thing :end-suf)) + (setq ok next-thing) + (setq next-thing (sp-get-thing nil))) + ;; do not allow slurping into a different context from + ;; inside a comment + (if (and in-comment + (save-excursion + (sp-get next-thing + (goto-char :beg) + (not (sp-point-in-comment))))) + (progn + (sp-message :cant-slurp-context) + (setq n -1)) + (if ok + (progn + (if (and (equal (sp-get next-thing :cl) "\"") + (equal (sp-get ok :cl) "\"")) + (progn + (sp--join-sexp ok next-thing) + (goto-char (- (sp-get next-thing :end) 2)) + (plist-put enc :end (- (sp-get next-thing :end) 2))) + (let ((inner-sexp + (save-excursion + (goto-char (sp-get ok :end-in)) + (sp-get-thing t)))) + (delete-char (sp-get ok (- (+ :cl-l :suffix-l)))) + ;; this calculation corrects the absence + ;; of already deleted cls + (goto-char (- (sp-get next-thing :end-suf) + (sp-get ok (+ :cl-l :suffix-l)))) + ;; only insert space if not inserting it + ;; would merge two sexps together + (when (and (sp-get ok (/= :len-in 0)) + (sp-compare-sexps + inner-sexp + (sp-get-thing t)) + (= (sp-get ok :end-suf) + (sp-get next-thing :beg-prf))) + (save-excursion + (goto-char (sp-get ok :end-in)) + (insert " ")))) + (sp--run-hook-with-args + (sp-get enc :op) :pre-handlers 'slurp-forward + (list :arg arg :enc enc :ok ok :next-thing next-thing)) + (sp-get ok (insert :cl :suffix)) + (sp--indent-region (sp-get ok :beg-prf) (point)) + ;; HACK: update the "enc" data structure if ok==enc + (when (= (sp-get enc :beg) (sp-get ok :beg)) (plist-put enc :end (point))) + (sp--run-hook-with-args + (sp-get enc :op) :post-handlers 'slurp-forward + (list :arg arg :enc enc :ok ok :next-thing next-thing))) + (setq n (1- n))) + (sp-message :cant-slurp) + (setq n -1)))))))) + (sp-backward-slurp-sexp (sp--negate-argument arg)))) + +(defun sp-backward-slurp-sexp (&optional arg) + "Add the sexp preceding the current list in it by moving the +opening delimiter. + +If the current list is the first in a parent list, extend that +list (and possibly apply recursively until we can extend a list +or beginning of file). + +If arg is N, apply this function that many times. + +If arg is negative -N, extend the closing pair instead (that is, +forward). + +If ARG is raw prefix \\[universal-argument], extend all the way +to the beginning of the parent list. + +If both the current expression and the expression to be slurped +are strings, they are joined together. + +Examples: + + foo (bar| baz) -> (foo bar| baz) + + foo [(bar| baz)] -> [foo (bar| baz)] + + [foo (bar| baz)] -> [(foo bar| baz)] + + (foo bar baz (|quux)) -> ((foo bar baz |quux)) ;; with \\[universal-argument] + + \"foo bar\" \"baz |quux\" -> \"foo bar baz |quux\"" + (interactive "*P") + (if (> (prefix-numeric-value arg) 0) + (let ((n (abs (prefix-numeric-value arg))) + (enc (sp-get-enclosing-sexp)) + (in-comment (sp-point-in-comment)) + next-thing ok) + (when enc + (save-excursion + (if (sp--raw-argument-p arg) + (progn + (goto-char (sp-get enc :beg-prf)) + (setq next-thing (sp-get-enclosing-sexp)) + (when next-thing + (delete-char (sp-get enc (+ :op-l :prefix-l))) + (goto-char (sp-get next-thing :beg-in)) + (sp--run-hook-with-args + (sp-get enc :op) :pre-handlers 'slurp-backward + (list :arg arg :enc enc :next-thing next-thing)) + (sp-get enc (insert :prefix :op)) + (sp--indent-region (sp-get next-thing :beg-in) (sp-get enc :end)) + (sp--run-hook-with-args + (sp-get enc :op) :post-handlers 'slurp-backward + (list :arg arg :enc enc :next-thing next-thing)))) + (while (> n 0) + (goto-char (sp-get enc :beg-prf)) + (setq ok enc) + (setq next-thing (sp-get-thing t)) + (while (sp-compare-sexps next-thing ok > :end) + (goto-char (sp-get next-thing :beg-prf)) + (setq ok next-thing) + (setq next-thing (sp-get-thing t))) + ;; do not allow slurping into a different context from + ;; inside a comment + (if (and in-comment + (save-excursion + (sp-get next-thing + (goto-char :beg) + (not (sp-point-in-comment))))) + (progn + (sp-message :cant-slurp-context) + (setq n -1)) + (if ok + (progn + (if (and (equal (sp-get next-thing :cl) "\"") + (equal (sp-get ok :cl) "\"")) + (progn + (sp--join-sexp next-thing ok) + (goto-char (sp-get next-thing :beg-prf)) + (plist-put enc :beg (sp-get next-thing :beg))) + (let ((inner-sexp + (save-excursion + (goto-char (sp-get ok :beg-in)) + (sp-get-thing)))) + (delete-char (sp-get ok (+ :op-l :prefix-l))) + (goto-char (sp-get next-thing :beg-prf)) + ;; only insert space if not inserting it + ;; would merge two sexps together + (when (and (sp-get ok (/= :len-in 0)) + (= (sp-get ok (- (sp-get inner-sexp :end) + :op-l :prefix-l)) + (sp-get (sp-get-thing) :end)) + (= (sp-get ok :beg-prf) + (sp-get next-thing :end-suf))) + (save-excursion + (goto-char (sp-get ok (- :beg-in :op-l :prefix-l))) + (insert " ")))) + (sp--run-hook-with-args + (sp-get enc :op) :pre-handlers 'slurp-backward + (list :arg arg :enc enc :ok ok :next-thing next-thing)) + (sp-get ok (insert :prefix :op)) + (sp--indent-region (point) (sp-get ok :end)) + ;; HACK: update the "enc" data structure if ok==enc + (when (sp-compare-sexps enc ok) (plist-put enc :beg (- (point) (sp-get ok :op-l)))) + (sp--run-hook-with-args + (sp-get enc :op) :post-handlers 'slurp-backward + (list :arg arg :enc enc :ok ok :next-thing next-thing))) + (setq n (1- n))) + (sp-message :cant-slurp) + (setq n -1)))))))) + (sp-forward-slurp-sexp (sp--negate-argument arg)))) + +(defun sp-add-to-previous-sexp (&optional arg) + "Add the expression around point to the first list preceding point. + +With ARG positive N add that many expressions to the preceding +list. + +If ARG is raw prefix argument \\[universal-argument] add all expressions until +the end of enclosing list to the previous list. + +If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] add the current +list into the previous list. + +Examples: + + (foo bar) |baz quux -> (foo bar |baz) quux + + (foo bar) |baz quux -> (foo bar |baz quux) ;; 2 + + (blab (foo bar) |baz quux) -> (blab (foo bar |baz quux)) ;; \\[universal-argument] + + (foo bar) (baz |quux) -> (foo bar (baz |quux)) ;; \\[universal-argument] \\[universal-argument]" + (interactive "*P") + (save-excursion + (cond + ((equal arg '(16)) + (sp-backward-up-sexp) + (sp-backward-down-sexp) + (sp-forward-slurp-sexp)) + (t + (sp-backward-down-sexp) + (sp-forward-slurp-sexp arg)))) + (indent-according-to-mode)) + +(defun sp-add-to-next-sexp (&optional arg) + "Add the expressions around point to the first list following point. + +With ARG positive N add that many expressions to the following +list. + +If ARG is raw prefix argument \\[universal-argument] add all expressions until +the beginning of enclosing list to the following list. + +If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] add the current +list into the following list. + +Examples: + + foo bar| (baz quux) -> foo (bar| baz quux) + + foo bar| (baz quux) -> (foo bar| baz quux) ;; 2 + + (foo bar |(bar quux) blab) -> ((foo bar |bar quux) blab) ;; \\[universal-argument] + + (foo |bar) (baz quux) -> ((foo |bar) baz quux) ;; \\[universal-argument] \\[universal-argument]" + (interactive "*P") + (save-excursion + (cond + ((equal arg '(16)) + (sp-up-sexp) + (sp-down-sexp) + (sp-backward-slurp-sexp)) + (t + (sp-down-sexp) + (sp-backward-slurp-sexp arg))))) + +(defun sp-forward-barf-sexp (&optional arg) + "Remove the last sexp in the current list by moving the closing delimiter. + +If ARG is positive number N, barf that many expressions. + +If ARG is negative number -N, contract the opening pair instead. + +If ARG is raw prefix \\[universal-argument], barf all expressions from the one after +point to the end of current list and place the point before the +closing delimiter of the list. + +If the current list is empty, do nothing. + +If the setting `sp-barf-move-point-with-delimiter' is non-nil, +move the point together with the closing delimiter if the point +would end up outside of the enclosing sexp. This way the barf +can be always followed by a slurp to undo the change. + +Examples: (prefix arg in comment) + + (foo bar| baz) -> (foo bar|) baz ;; nil (defaults to 1) + + (foo| [bar baz]) -> (foo|) [bar baz] ;; 1 + + (1 2 3| 4 5 6) -> (1 2 3|) 4 5 6 ;; \\[universal-argument] (or numeric prefix 3) + + (foo bar| baz) -> foo (bar| baz) ;; -1" + (interactive "*P") + (let* ((raw (sp--raw-argument-p arg)) + (old-arg arg) + (arg (prefix-numeric-value arg)) + (new-cl-position nil)) + (if (> arg 0) + (if (sp-point-in-blank-sexp) + (sp-message :blank-sexp) + (save-excursion + (let ((enc (sp-get-enclosing-sexp))) + (sp-get enc + (cond + ((and raw (= arg 4)) + (sp-get (sp-get-thing t) + (goto-char :end-suf))) + (t + (goto-char :end-in) + (sp-backward-sexp arg) + (when (<= (point) :beg) + (goto-char :beg-in)))) + ;; we know for sure there is at least one thing in the list + (let ((back (sp-get-thing t))) + (if (sp-compare-sexps back enc) + (goto-char :beg-in) + (goto-char (sp-get back :end-suf)))) + (sp--run-hook-with-args :op :pre-handlers 'barf-forward + (list :arg arg :enc enc))) + (sp-get (sp-get-enclosing-sexp) + (sp-do-move-cl (point)) + (sp--keep-indentation + (sp--indent-region :beg :end)) + (setq new-cl-position (- (point) :cl-l)) + (sp--run-hook-with-args :op :post-handlers 'barf-forward + (list :arg arg :enc enc))))) + (when (and sp-barf-move-point-with-delimiter + (< new-cl-position (point))) + (goto-char new-cl-position))) + (sp-backward-barf-sexp (sp--negate-argument old-arg))))) + +(defun sp-backward-barf-sexp (&optional arg) + "This is exactly like calling `sp-forward-barf-sexp' with minus ARG. +In other words, instead of contracting the closing pair, the +opening pair is contracted. For more information, see the +documentation of `sp-forward-barf-sexp'. + +Examples: + + (foo bar| baz) -> foo (bar| baz) + + ([foo bar] |baz) -> [foo bar] (|baz) + + (1 2 3 |4 5 6) -> 1 2 3 (|4 5 6) ;; \\[universal-argument] (or 3)" + (interactive "*P") + (let* ((raw (sp--raw-argument-p arg)) + (old-arg arg) + (arg (prefix-numeric-value arg)) + (new-cl-position nil)) + (if (> arg 0) + (if (sp-point-in-blank-sexp) + (sp-message :blank-sexp) + (save-excursion + (let ((enc (sp-get-enclosing-sexp))) + (sp-get enc + (cond + ((and raw (= arg 4)) + (sp-get (sp-get-thing) + (goto-char :beg-prf))) + (t + (goto-char :beg-in) + (sp-forward-sexp arg) + (when (>= (point) :end) + (goto-char :end-in)))) + ;; we know for sure there is at least one thing in the list + (let ((next (sp-get-thing))) + (if (sp-compare-sexps next enc) + (goto-char :end-in) + (goto-char (sp-get next :beg-prf)))) + (sp--run-hook-with-args :op :pre-handlers 'barf-backward + (list :arg arg :enc enc))) + (sp-get (sp-get-enclosing-sexp) + ;; make sure that we end up on the same place, since + ;; sp-do-move-op might move the point to the start of + ;; the previous sexp (the one barfed out) + (save-excursion (sp-do-move-op (point))) + ;; skip the opening to end up inside the sexp + (forward-char (+ :op-l :prefix-l)) + (sp--indent-region :beg :end) + (setq new-cl-position (point)) + (sp--run-hook-with-args :op :post-handlers 'barf-backward + (list :arg arg :enc enc))))) + (when (and sp-barf-move-point-with-delimiter + (> new-cl-position (point))) + (goto-char new-cl-position))) + (sp-forward-barf-sexp (sp--negate-argument old-arg))))) + +;; TODO: get rid of the macro anyway, it's stupid! +(defmacro sp--skip-to-symbol-1 (forward) + "Generate `sp-skip-forward-to-symbol' or `sp-skip-backward-to-symbol'." + (let ((inc (if forward '1+ '1-)) + (dec (if forward '1- '1+)) + (forward-fn (if forward 'forward-char 'backward-char)) + (next-char-fn (if forward 'following-char 'preceding-char)) + (looking (if forward 'sp--looking-at 'sp--looking-back)) + (prefix-fn (if forward 'sp--get-suffix 'sp--get-prefix)) + (eob-test (if forward '(eobp) '(bobp))) + (comment-bound (if forward 'cdr 'car))) + `(let ((in-comment (sp-point-in-comment)) + ;; HACK: if we run out of current context this might skip a + ;; pair that was not allowed before. However, such a call is + ;; never made in SP, so it's OK for now + (allowed-pairs (sp--get-allowed-regexp)) + ,(if forward + '(allowed-close (sp--get-closing-regexp (sp--get-allowed-pair-list))) + '(allowed-open (sp--get-opening-regexp (sp--get-allowed-pair-list)))) + (allowed-strings (sp--get-stringlike-regexp)) + (prefix nil)) + (while (and (not (or ,eob-test + (and stop-after-string + (not (sp-point-in-string)) + (sp-point-in-string (,dec (point)))) + (and stop-at-string + (not (sp-point-in-string)) + (sp-point-in-string (,inc (point)))) + (and stop-inside-string + (sp-point-in-string) + (not (sp-point-in-string (,inc (point))))) + (and (,looking allowed-pairs) + (or in-comment (not (sp-point-in-comment)))) + (and (,looking allowed-strings) + (or in-comment (not (sp-point-in-comment)))))) + (or (member (char-syntax (,next-char-fn)) '(?< ?> ?! ?| ?\ ?\\ ?\" ?' ?.)) + (/= 0 (logand (lsh 1 20) (car (syntax-after + ,(if forward + '(point) + '(1- (point))))))) + (unless in-comment (sp-point-in-comment)) + ;; This is the case where we are starting at + ;; pair (looking at it) and there is some + ;; prefix which is not recognized by syntax, + ;; i.e. defined by regexp. This should only be + ;; tested once in principle before the next + ;; time we land on a delimiter this whole loop + ;; stops based on the first branch of the `and' + ;; condition in `while' so using expensive + ;; functions here is not a bg deal. + (and (or (,(if forward 'sp--looking-back 'sp--looking-at) + ,(if forward 'allowed-close 'allowed-open)) + (,(if forward 'sp--looking-back 'sp--looking-at) allowed-strings)) + (let ((op (match-string 0))) + (setq prefix (,prefix-fn (point) op)) + (> (length prefix) 0))))) + (if (and (not in-comment) + (sp-point-in-comment)) + (progn + (goto-char (,comment-bound (sp-get-comment-bounds))) + (unless ,eob-test (,forward-fn 1))) + (unless ,eob-test + (,forward-fn (max (length prefix) 1)))) + (setq prefix nil))))) + +(defun sp-skip-forward-to-symbol (&optional stop-at-string stop-after-string stop-inside-string) + "Skip whitespace and comments moving forward. + +If STOP-AT-STRING is non-nil, stop before entering a string (if +not already in a string). + +If STOP-AFTER-STRING is non-nil, stop after exiting a string. + +If STOP-INSIDE-STRING is non-nil, stop before exiting a string. + +Examples: + + foo| bar -> foo |bar + + foo| [bar baz] -> foo |[bar baz]" + (interactive "^") + (sp--skip-to-symbol-1 t)) + +(put 'sp-skip-forward-to-symbol 'CUA 'move) + +(defun sp-skip-backward-to-symbol (&optional stop-at-string stop-after-string stop-inside-string) + "Skip whitespace and comments moving backward. +If STOP-AT-STRING is non-nil, stop before entering a string (if +not already in a string). + +If STOP-AFTER-STRING is non-nil, stop after exiting a string. + +If STOP-INSIDE-STRING is non-nil, stop before exiting a string. + +Examples: + + foo |bar -> foo| bar + + [bar baz] |foo -> [bar baz]| foo" + (interactive "^") + (sp--skip-to-symbol-1 nil)) + +(put 'sp-skip-backward-to-symbol 'CUA 'move) + +(defun sp-skip-into-string (&optional back) + "Move the point into the next string. + +With BACK non-nil, move backwards." + (if back + (while (and (not (sp-point-in-string)) (> (point) (point-min))) + (backward-char)) + (while (and (not (sp-point-in-string)) (< (point) (point-max))) + (forward-char)))) + +;; TODO: in ruby, "foo |if bar" now moves correctly, but there's a +;; noticable lag before it jumps over "if". This is probably caused +;; by :skip-match handlers. Investigate! +(defun sp-forward-symbol (&optional arg) + "Move point to the next position that is the end of a symbol. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction. + +A symbol is any sequence of characters that are in either the +word constituent or symbol constituent syntax class. Current +symbol only extend to the possible opening or closing delimiter +as defined by `sp-add-pair' even if part of this delimiter +would match \"symbol\" syntax classes. + +Examples: + + |foo bar baz -> foo| bar baz + + |foo (bar (baz)) -> foo (bar| (baz)) ;; 2 + + |foo (bar (baz) quux) -> foo (bar (baz) quux|) ;; 4" + (interactive "^p") + (setq arg (or arg 1)) + (sp--with-case-sensitive + (let* ((n (abs arg)) + (fw (> arg 0)) + (allowed (sp--get-allowed-pair-list)) + (open (sp--get-opening-regexp allowed)) + (close (sp--get-closing-regexp allowed))) + (if fw + (while (> n 0) + ;; First we need to get to the beginning of a symbol. This means + ;; skipping all whitespace and pair delimiters until we hit + ;; something in \sw or \s_ + (while (cond + ((eobp) nil) + ((not (memq (char-syntax (following-char)) '(?w ?_))) + (forward-char) + t) + ;; if allowed is empty, the regexp matches anything + ;; and we go into infinite loop, cf. Issue #400 + ((and allowed (sp--valid-initial-delimiter-p (sp--looking-at open))) + (goto-char (match-end 0))) + ((and allowed (sp--valid-initial-delimiter-p (sp--looking-at close))) + (goto-char (match-end 0))))) + (while (and (not (eobp)) + (or (not allowed) + (not (or (sp--valid-initial-delimiter-p (sp--looking-at open)) + (sp--valid-initial-delimiter-p (sp--looking-at close))))) + (or (memq (char-syntax (following-char)) '(?w ?_)) + ;; Specifically for lisp, we consider + ;; sequences of ?\ a symbol + ;; sequence + (and (eq (char-before) ??) + (eq (char-syntax (following-char)) ?\\)) + (and (eq (char-syntax (char-before)) ?\\)))) + (forward-char)) + (setq n (1- n))) + (sp-backward-symbol n))))) + +(put 'sp-forward-symbol 'CUA 'move) + +(defun sp-backward-symbol (&optional arg) + "Move point to the next position that is the beginning of a symbol. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +forward direction. + +A symbol is any sequence of characters that are in either the word +constituent or symbol constituent syntax class. Current symbol only +extend to the possible opening or closing delimiter as defined by +`sp-add-pair' even if part of this delimiter would match \"symbol\" +syntax classes. + +Examples: + + foo bar| baz -> foo |bar baz + + ((foo bar) baz)| -> ((foo |bar) baz) ;; 2 + + (quux ((foo) bar) baz)| -> (|quux ((foo) bar) baz) ;; 4" + (interactive "^p") + (setq arg (or arg 1)) + (sp--with-case-sensitive + (let ((n (abs arg)) + (fw (> arg 0)) + (open (sp--get-opening-regexp (sp--get-allowed-pair-list))) + (close (sp--get-closing-regexp (sp--get-allowed-pair-list)))) + (if fw + (while (> n 0) + (while (cond + ((bobp) nil) + ((not (memq (char-syntax (preceding-char)) '(?w ?_))) + (backward-char) + t) + ((sp--valid-initial-delimiter-p (sp--looking-back open)) + (goto-char (match-beginning 0))) + ((sp--valid-initial-delimiter-p (sp--looking-back close)) + (goto-char (match-beginning 0))))) + (while (and (not (bobp)) + (not (or (sp--valid-initial-delimiter-p (sp--looking-back open)) + (sp--valid-initial-delimiter-p (sp--looking-back close)))) + (or (memq (char-syntax (preceding-char)) '(?w ?_)) + ;; Specifically for lisp, we consider + ;; sequences of ?\ a symbol + ;; sequence + (and (eq (char-before (1- (point))) ??) + (eq (char-syntax (preceding-char)) ?\\)) + )) + (backward-char)) + ;; skip characters which are symbols with prefix flag + (while (and (not (eobp)) + (/= 0 (logand (lsh 1 20) (car (syntax-after (point)))))) + (forward-char 1)) + (setq n (1- n))) + (sp-forward-symbol n))))) + +(put 'sp-backward-symbol 'CUA 'move) + +(defun sp-rewrap-sexp (pair &optional keep-old) + "Rewrap the enclosing expression with a different pair. + +PAIR is the new enclosing pair. + +If optional argument KEEP-OLD is set, keep old delimiter and wrap +with PAIR on the outside of the current expression. + +When used interactively, the new pair is specified in minibuffer +by typing the *opening* delimiter, same way as with pair +wrapping. + +When used interactively with raw prefix argument \\[universal-argument], KEEP-OLD +is set to non-nil. + +Examples: + + (foo |bar baz) -> [foo |bar baz] ;; [ + + (foo |bar baz) -> [(foo |bar baz)] ;; \\[universal-argument] [" + (interactive (if buffer-read-only + (user-error "Buffer is read-only") + (list + (catch 'done + (let ((available-pairs (sp--get-pair-list-context 'wrap)) + ev ac (pair-prefix "")) + (while (not ac) + (setq ev (read-event (format "Rewrap with: %s" pair-prefix) t)) + (if (and (equal pair-prefix "") + (eq ev 'return)) + (throw 'done nil)) + (setq pair-prefix (concat pair-prefix (format-kbd-macro (vector ev)))) + (unless (--any? (string-prefix-p pair-prefix (car it)) available-pairs) + (user-error "Impossible pair prefix selected: %s" pair-prefix)) + (setq ac (--first (equal pair-prefix (car it)) available-pairs))) + ac)) + current-prefix-arg))) + (if (not pair) + (sp-unwrap-sexp) + (-when-let (enc (sp-get-enclosing-sexp)) + (save-excursion + (sp-get enc + (goto-char :end) + (unless keep-old + (delete-char (- :cl-l))) + (insert (cdr pair)) + (goto-char :beg) + (insert (car pair)) + (unless keep-old + (delete-char :op-l)) + (setq sp-last-wrapped-region + (sp--make-last-wraped-region + :beg (+ :end + (length (car pair)) + (length (cdr pair)) + (- :op-l) + (- :cl-l)) + (car pair) (cdr pair))))) + (sp--run-hook-with-args (car pair) :post-handlers 'rewrap-sexp + (list :parent (sp-get enc :op)))))) + +(defun sp-swap-enclosing-sexp (&optional arg) + "Swap the enclosing delimiters of this and the parent expression. + +With N > 0 numeric argument, ascend that many levels before +swapping. + +Examples: + + (foo [|bar] baz) -> [foo (|bar) baz] ;; 1 + + (foo {bar [|baz] quux} quack) -> [foo {bar (|baz) quux} quack] ;; 2" + (interactive "*p") + (let ((enc (sp-get-enclosing-sexp)) + (encp (sp-get-enclosing-sexp (1+ arg)))) + (if (and enc encp) + (save-excursion + (sp-get encp + (goto-char :end) + (delete-char (- :cl-l))) + (sp-get enc + (insert :cl) + (goto-char :end) + (delete-char (- :cl-l))) + (sp-get encp (insert :cl)) + (sp-get enc (goto-char :beg-prf)) + (sp-get encp (insert :prefix :op)) + (sp-get enc (delete-char (+ :op-l :prefix-l))) + (sp-get encp (goto-char :beg-prf)) + (sp-get enc (insert :prefix :op)) + (sp-get encp (delete-char (+ :op-l :prefix-l)))) + (sp-message :point-not-deep-enough)))) + +(defun sp--unwrap-sexp (sexp &optional no-cleanup) + "Unwrap expression defined by SEXP. + +Warning: this function remove possible empty lines and reindents +the unwrapped sexp, so the SEXP structure will no longer +represent a valid object in a buffer!" + (sp-get sexp + (delete-region :end-in :end) + (delete-region :beg-prf :beg-in)) + ;; if the delimiters were the only thing on the line, we should also + ;; get rid of the (possible) empty line that will be the result of + ;; their removal. This is especially nice in HTML mode or + ;; long-running tags like \[\] in latex. + (unless no-cleanup + (let ((new-start (sp-get sexp :beg-prf)) + (new-end (sp-get sexp (- :end-in :op-l :prefix-l))) + indent-from indent-to) + (save-excursion + (goto-char new-end) + (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) + (let ((b (bounds-of-thing-at-point 'line))) + (delete-region (car b) (cdr b)))) + (setq indent-to (point)) + (goto-char new-start) + (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) + (let ((b (bounds-of-thing-at-point 'line))) + (delete-region (car b) (cdr b)))) + (setq indent-from (point))) + (unless (or (memq major-mode sp-no-reindent-after-kill-modes) + (memq indent-line-function + sp-no-reindent-after-kill-indent-line-functions)) + (sp--keep-indentation + (sp--indent-region indent-from indent-to)))))) + +(defun sp-change-inner () + "Change the inside of the next expression. + +First, kill the inside of the next balanced expression, then move +point just after the opening delimiter. + +Examples: + + (f|oo [bar] baz) -> (foo [|] baz) + + {|\\='foo\\=': \\='bar\\='} -> {\\='|\\=': \\='bar\\='}" + (interactive "*") + (-when-let (ok (sp-get-sexp)) + (sp-get ok + (kill-region :beg-in :end-in) + (goto-char :beg-in)))) + +(defun sp-change-enclosing () + "Change the inside of the enclosing expression. + +Whitespace on both sides of the inner items is preserved if it +contains newlines. Invoking this function on a blank sexp will +wipe out remaining whitespace (see `sp-point-in-blank-sexp'). + +Move the point to the beginning of the original content. + +Examples: + + (f|oo [bar] baz) -> (|) + + {'f|oo': 'bar'} -> {'|': 'bar'}" + (interactive "*") + (-when-let (ok (sp-get-enclosing-sexp)) + (sp-get ok + (if (sp-point-in-blank-sexp) + (progn + (kill-region :beg-in :end-in) + (goto-char :beg-in)) + (let ((beg (progn + (goto-char :beg-in) + (skip-chars-forward "\t\n ") + (point))) + (end (progn + (goto-char :end-in) + (skip-chars-backward "\t\n ") + (point)))) + (kill-region beg end) + (goto-char beg)))))) + +(defun sp-unwrap-sexp (&optional arg) + "Unwrap the following expression. + +With ARG N, unwrap Nth expression as returned by +`sp-forward-sexp'. If ARG is negative -N, unwrap Nth expression +backwards as returned by `sp-backward-sexp'. + +Return the information about the just unwrapped expression. Note +that this structure does not represent a valid expression in the +buffer. + +Examples: + + |(foo bar baz) -> |foo bar baz + + (foo bar| baz) -> foo bar| baz + + |(foo) (bar) (baz) -> |(foo) bar (baz) ;; 2" + (interactive "*p") + (setq arg (or arg 1)) + (let ((sp-navigate-consider-symbols nil)) + (let ((ok (save-excursion (sp-forward-sexp arg)))) + (when ok (sp--unwrap-sexp ok)) + ok))) + +(defun sp-backward-unwrap-sexp (&optional arg) + "Unwrap the previous expression. + +With ARG N, unwrap Nth expression as returned by +`sp-backward-sexp'. If ARG is negative -N, unwrap Nth expression +forward as returned by `sp-forward-sexp'. + +Examples: + + (foo bar baz)| -> foo bar baz| + + (foo bar)| (baz) -> foo bar| (baz) + + (foo) (bar) (baz)| -> foo (bar) (baz) ;; 3" + (interactive "*p") + (sp-unwrap-sexp (- (or arg 1)))) + +(defun sp-splice-sexp (&optional arg) + "Unwrap the current list. + +With ARG N, unwrap Nth list as returned by applying `sp-up-sexp' +N times. This function expect positive arg. + +Examples: + + (foo (bar| baz) quux) -> (foo bar| baz quux) + + (foo |(bar baz) quux) -> foo |(bar baz) quux + + (foo (bar| baz) quux) -> foo (bar| baz) quux ;; 2" + (interactive "*p") + (setq arg (or arg 1)) + (-when-let (ok (sp-get-enclosing-sexp arg)) + (if (equal ";" (sp-get ok :prefix)) + (sp-get ok + (save-excursion + (goto-char :beg) + (-when-let (enc (sp-get-enclosing-sexp arg)) + (sp--unwrap-sexp enc)))) + (sp--unwrap-sexp ok)))) + +(defun sp--splice-sexp-do-killing (beg end expr &optional jump-end) + "Save the text in the region between BEG and END inside EXPR, +then delete EXPR and insert the saved text. + +If optional argument JUPM-END is equal to the symbol \\='end move +the point after the re-inserted text." + (let (str p) + (setq str (buffer-substring-no-properties beg end)) + (delete-region (sp-get expr :beg-prf) (sp-get expr :end)) + (save-excursion + (insert str) + (sp--indent-region (sp-get expr :beg-prf) (point)) + (setq p (point))) + (when (eq jump-end 'end) (goto-char p)))) + +(defun sp-splice-sexp-killing-backward (&optional arg) + "Unwrap the current list and kill all the expressions +between start of this list and the point. + +With the optional argument ARG, repeat that many times. This +argument should be positive number. + +Examples: + + (foo (let ((x 5)) |(sqrt n)) bar) -> (foo |(sqrt n) bar) + +​ (when ok| |(perform-operation-1) +​ (perform-operation-1) -> (perform-operation-2) +​ (perform-operation-2)) + +​ (save-excursion -> |(awesome-stuff-happens) ;; 2 +​ (unless (test) +​ |(awesome-stuff-happens))) + +Note that to kill only the content and not the enclosing +delimiters you can use \\[universal-argument] \\[sp-backward-kill-sexp]. +See `sp-backward-kill-sexp' for more information." + (interactive "*p") + (while (> arg 0) + (sp-splice-sexp-killing-around '(4)) + (setq arg (1- arg)))) + +;; TODO: write in terms of `sp-splice-sexp-killing-around'. +(defun sp-splice-sexp-killing-forward (&optional arg) + "Unwrap the current list and kill all the expressions between +the point and the end of this list. + +With the optional argument ARG, repeat that many times. This +argument should be positive number. + +Examples: + + (a (b c| d e) f) -> (a b c| f) + + (+ (x |y z) w) -> (+ x| w) + +Note that to kill only the content and not the enclosing +delimiters you can use \\[universal-argument] \\[sp-kill-sexp]. +See `sp-kill-sexp' for more information." + (interactive "*p") + (while (> arg 0) + (let ((ok (sp-get-enclosing-sexp 1))) + (if ok + (let ((next (sp-get-thing t))) + (if (sp-compare-sexps next ok) + (sp-kill-sexp '(16)) + (sp--splice-sexp-do-killing + (sp-get next :end) ;search backward + (sp-get ok :beg-in) + ok 'end))) + (setq arg -1))) + (setq arg (1- arg)))) + +(defun sp-splice-sexp-killing-around (&optional arg) + "Unwrap the current list and kill everything inside except next expression. + +With ARG save that many next expressions. With ARG negative -N, +save that many expressions backward. + +If ARG is raw prefix argument \\[universal-argument] this function behaves exactly +the same as `sp-splice-sexp-killing-backward'. + +If ARG is negative raw prefix argument \\[negative-argument] \\[universal-argument] this function +behaves exactly the same as `sp-splice-sexp-killing-forward'. + +Note that the behaviour with the prefix argument seems to be +reversed. This is because the backward variant is much more +common and hence deserve shorter binding. + +If ARG is raw prefix argument \\[universal-argument] \\[universal-argument] raise the expression the point +is inside of. This is the same as `sp-backward-up-sexp' followed by +`sp-splice-sexp-killing-around'. + +Examples: + + (a b |(c d) e f) -> |(c d) ;; with arg = 1 + + (a b |c d e f) -> |c d ;; with arg = 2 + + (- (car x) |a 3) -> (car x)| ;; with arg = -1 + + (foo (bar |baz) quux) -> |(bar baz) ;; with arg = \\[universal-argument] \\[universal-argument]" + (interactive "*P") + (cond + ((equal arg '(-4)) + (sp-splice-sexp-killing-forward 1)) + (t + (if (equal arg '(16)) + (progn + (sp-backward-up-sexp) + (setq arg 1))) + (let* (inside-comment-inside-sexp + (num-arg (prefix-numeric-value arg)) + (ok ;; (sp-get-enclosing-sexp 1) + (save-excursion + (sp-skip-backward-to-symbol) + ;; if the point is inside a comment, we want to + ;; operate on the sexp that contains it. however, + ;; if we are inside a sexp inside a comment, we + ;; should operate on that instead. + (if (sp-point-in-comment) + (let ((enc (sp-get-enclosing-sexp 1)) + (cb (sp-get-comment-bounds))) + (if (> (sp-get enc :beg) (car cb)) + (progn + (setq inside-comment-inside-sexp t) + enc) + (goto-char (cdr cb)) + ;; todo: replace with something more + ;; abstract + (skip-chars-forward "\t\n ") + (sp-get-enclosing-sexp 1))) + (sp-get-enclosing-sexp 1))))) + (when ok + (when (and (sp-point-in-comment) + (not inside-comment-inside-sexp)) + (let ((cb (sp-get-comment-bounds))) + (goto-char (if (> num-arg 0) (car cb) (cdr cb))))) + (sp-skip-backward-to-symbol) + (-let* ((next (sp--next-thing-selection arg)) + ((from . to) + (cond + ((and (sp-point-in-comment) + (not inside-comment-inside-sexp)) + (if (> num-arg 0) + ;; only extends to keep the comment if raising + ;; towards the end. + (cons (car (sp-get-comment-bounds)) + (sp-get next :end-suf)) + (sp-get next (cons :beg-prf :end-suf)))) + ((and (sp-point-in-comment) + inside-comment-inside-sexp) + (sp-get next (cons :beg-prf :end-suf))) + ;; If we are splicing before a comment, the + ;; comment might be connected to the sexp + ;; after it, so we better don't kill it. Only + ;; do that if the comment is on its own line + ;; though, otherwise it is connected to the + ;; sexp before it. + ((save-excursion + (skip-chars-forward "\t\n ") + (when (and (> num-arg 0) + (sp-point-in-comment) + (save-excursion + (skip-chars-backward "\t ") + (bolp))) + (cons (point) (sp-get next :end-suf))))) + ;; similarly, if there is a comment before + ;; this sexp, keep it. + ((save-excursion + (sp-backward-symbol) + (when (and (> num-arg 0) + (sp-point-in-comment) + (goto-char (car (sp-get-comment-bounds))) + (> (point) (sp-get ok :beg)) + (save-excursion + (skip-chars-backward "\t ") + (bolp))) + (cons (point) (sp-get next :end-suf))))) + (t (sp-get next (cons :beg-prf :end-suf)))))) + (sp--splice-sexp-do-killing from to + ok (if (> num-arg 0) nil 'end)))))))) + +(defalias 'sp-raise-sexp 'sp-splice-sexp-killing-around) + +(defun sp-convolute-sexp (&optional arg) + "Convolute balanced expressions. + +Save the expressions preceding point and delete them. Then +splice the resulting expression. Wrap the current enclosing list +with the delimiters of the spliced list and insert the saved +expressions. + +If point is in a symbol, move to end of symbol before convolving. + +With ARG positive N, move up N lists before wrapping. + +Examples: + +We want to move the `while' before the `let'. + +​ (let ((stuff 1) (while (we-are-good) +​ (other 2)) (let ((stuff 1) +​ (while (we-are-good) -> (other 2)) +​ |(do-thing 1) |(do-thing 1) +​ (do-thing 2) (do-thing 2) +​ (do-thing 3))) (do-thing 3))) + + (forward-char (sp-get env |:op-l)) -> (sp-get env (forward-char |:op-l))" + (interactive "*p") + (save-excursion + (when (sp-point-in-symbol) + (sp-forward-symbol)) + (when (looking-at-p " ") + (just-one-space)) + (let* ((old-buffer-size (buffer-size)) + (enc (sp-get-enclosing-sexp)) + (inner-close (sp-get enc (delete-and-extract-region + (save-excursion + (goto-char :end-in) + (sp-backward-whitespace)) + :end))) + (inner-raise (sp-get enc (delete-and-extract-region + :beg-prf + (save-excursion + (sp-forward-whitespace))))) + (whitespace (sp-get enc + ;; this happens when the entire inside sexp was removed. + (when (= old-buffer-size (+ (buffer-size) :len)) + (delete-and-extract-region + (save-excursion + (goto-char :beg-prf) + (max (line-beginning-position) (sp-backward-whitespace))) + :beg-prf)))) + (encp (sp-get-enclosing-sexp arg))) + (sp-get encp + (goto-char :end) + (insert inner-close) + (goto-char :beg-prf) + (insert inner-raise (if whitespace whitespace "")) + (sp-get (sp-get-enclosing-sexp) + (sp--indent-region :beg :end))))) + (indent-according-to-mode)) + +(defun sp-absorb-sexp (&optional arg) + "Absorb previous expression. + +Save the expressions preceding point and delete them. Then slurp +an expression backward and insert the saved expressions. + +With ARG positive N, absorb that many expressions. + +Examples: + +​ (do-stuff 1) (save-excursion +​ (save-excursion -> |(do-stuff 1) +​ |(do-stuff 2)) (do-stuff 2)) + + foo bar (concat |baz quux) -> (concat |foo bar baz quux) ;; 2" + (interactive "*p") + (sp-forward-whitespace) + (let* ((old (point)) + (raise (progn + (sp-beginning-of-sexp) + (buffer-substring (point) old)))) + (delete-region (point) old) + (sp-backward-slurp-sexp arg) + (sp-forward-whitespace) + (sp-beginning-of-sexp) + (insert raise) + (save-excursion + (sp-backward-up-sexp) + (indent-sexp))) + (sp-forward-whitespace)) + +(defun sp-emit-sexp (&optional arg) + "Move all expression preceding point except the first one out of +the current list. + +With ARG positive N, keep that many expressions from the start of +the current list. + +This is similar as `sp-backward-barf-sexp' but it also drags the +first N expressions with the delimiter. + +Examples: + +​ (save-excursion ​(do-stuff 1) +​ (do-stuff 1) (do-stuff 2) +​ (do-stuff 2) -> (save-excursion +​ |(do-stuff 3)) |(do-stuff 3)) + +​ (while not-done-yet (execute-only-once) +​ (execute-only-once) -> (while not-done-yet ;; arg = 2 +​ |(execute-in-loop)) |(execute-in-loop))" + (interactive "*p") + (let (save-text) + (save-excursion + (sp-beginning-of-sexp) + (let* ((start (point))) + (sp-forward-sexp arg) + (sp-skip-forward-to-symbol t) + (setq save-text (buffer-substring start (point))) + (delete-region start (point)))) + (save-excursion (sp-backward-barf-sexp '(4))) + (sp-down-sexp) + (insert save-text) + (save-excursion + (sp-backward-up-sexp) + (indent-sexp)))) + +(defun sp-extract-before-sexp (&optional arg) + "Move the expression after point before the enclosing balanced expression. + +The point moves with the extracted expression. + +With ARG positive N, extract N expressions after point. + +With ARG negative -N, extract N expressions before point. + +With ARG being raw prefix argument \\[universal-argument], extract all the expressions +up until the end of enclosing list. + +If the raw prefix is negative, this behaves as \\[universal-argument] `sp-backward-barf-sexp'." + (interactive "*P") + (if (equal arg '(-4)) + (sp-backward-barf-sexp '(4)) + (sp-select-next-thing arg) + (let ((enc (sp-get-enclosing-sexp)) + save-text b e nl) + (save-excursion + ;; TODO: extract this use pattern into general "get X things + ;; with or without surrounding whitespace." + (setq b (region-beginning)) + (setq e (region-end)) + (goto-char (sp-get enc :end-in)) + (if (save-excursion + (skip-chars-backward "\t ") + (bolp)) + (let ((whitespace (sp-get-whitespace))) + (sp-get whitespace (when (= :beg e) + (delete-region :beg :end)))) + (setq nl t)) + (setq save-text (delete-and-extract-region b e)) + (when nl + (let ((whitespace (sp-get-whitespace))) + (sp-get whitespace (delete-region :beg :end)))) + (goto-char (sp-get enc :beg-prf)) + (insert save-text "\n") + (sp-get enc (sp--indent-region :beg-prf :end))) + ;; if we're at an empty line, remove it + (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) + (let ((b (bounds-of-thing-at-point 'line))) + (delete-region (car b) (cdr b)))) + (goto-char (sp-get enc :beg-prf))))) + +(defun sp-extract-after-sexp (&optional arg) + "Move the expression after point after the enclosing balanced expression. + +The point moves with the extracted expression. + +With ARG positive N, extract N expressions after point. + +With ARG negative -N, extract N expressions before point. + +With ARG being raw prefix argument \\[universal-argument], extract all the +expressions up until the end of enclosing list. + +With ARG being negative raw prefix argument \\[negative-argument] \\[universal-argument], extract all the +expressions up until the start of enclosing list." + ;; this is uch uglier than the "before" version, since the + ;; calculations forward have to account for the deleted text. Figure + ;; out a way to make it smoother. + (interactive "*P") + (sp-select-next-thing arg) + (sp--with-case-sensitive + (let ((enc (sp-get-enclosing-sexp)) + (dws 0) ;length of deleted whitespace + save-text b e nl) + (save-excursion + (setq b (region-beginning)) + (setq e (region-end)) + (goto-char (sp-get enc :end-in)) + (if (save-excursion + (skip-chars-backward "\t ") + (bolp)) + (let ((whitespace (sp-get-whitespace))) + (sp-get whitespace + (when (= :beg e) + (delete-region :beg :end) + (setq dws (- :end :beg))))) + (setq nl t)) + (setq save-text (delete-and-extract-region b e)) + (when nl + (let ((whitespace (sp-get-whitespace))) + (sp-get whitespace (delete-region :beg :end)) + (sp-get whitespace (setq dws (+ dws (- :end :beg)))))) + (sp-get enc (goto-char (- :end (length save-text) dws))) + (insert "\n" save-text) + (sp-get enc (sp--indent-region :beg-prf :end)) + (setq e (point))) + ;; if we're at an empty line, remove it + (setq dws 0) ; variable reuse, ugly :/ + (when (string-match-p "^[\n\t ]+\\'" (thing-at-point 'line)) + (let ((b (bounds-of-thing-at-point 'line))) + (delete-region (car b) (cdr b)) + (setq dws (- (cdr b) (car b))))) + (when (sp--looking-back (sp--get-opening-regexp) nil t) + (let ((whitespace (sp-get-whitespace))) + (sp-get whitespace + (delete-region :beg :end) + (setq dws (- :end :beg))))) + (goto-char (- e dws))))) + +(defun sp-forward-whitespace (&optional arg) + "Skip forward past the whitespace characters. +With non-nil ARG return number of characters skipped." + (interactive "^P") + (let ((rel-move (skip-chars-forward " \t\n"))) + (if arg rel-move (point)))) + +(put 'sp-forward-whitespace 'CUA 'move) + +(defun sp-backward-whitespace (&optional arg) + "Skip backward past the whitespace characters. +With non-nil ARG return number of characters skipped." + (interactive "^P") + (let ((rel-move (skip-chars-backward " \t\n"))) + (if arg rel-move (point)))) + +(put 'sp-backward-whitespace 'CUA 'move) + +(defun sp-split-sexp (arg) + "Split the list or string the point is on into two. + +If ARG is a raw prefix \\[universal-argument] split all the sexps in current expression +in separate lists enclosed with delimiters of the current +expression. + +See also setting `sp-split-sexp-always-split-as-string' which +determines how sexps inside strings are treated and also for a +discussion of how to automatically add concatenation operators to +string splitting. + +Examples: + + (foo bar |baz quux) -> (foo bar) |(baz quux) + + \"foo bar |baz quux\" -> \"foo bar\" |\"baz quux\" + + ([foo |bar baz] quux) -> ([foo] |[bar baz] quux) + + (foo bar| baz quux) -> (foo) (bar|) (baz) (quux) ;; \\[universal-argument]" + (interactive "*P") + (cond + ((equal arg '(4)) + (-when-let ((first-item . rest-items) (sp-get-list-items)) + (sp-get first-item + (save-excursion + (goto-char :end) + (delete-char (- (length :cl))) + (--each (nreverse rest-items) + (goto-char (sp-get it :end)) + (insert :cl) + (goto-char (sp-get it :beg)) + (insert :op)) + (goto-char :beg) + (delete-char (length :op)))))) + (t + (let ((should-split-as-string + (and sp-split-sexp-always-split-as-string + (sp-point-in-string)))) + (-when-let (ok (if should-split-as-string + (save-excursion + (goto-char (car (sp-get-quoted-string-bounds))) + (sp-get-sexp)) + (sp-get-enclosing-sexp 1))) + (sp-get ok + (sp--run-hook-with-args :op :pre-handlers 'split-sexp) + (if should-split-as-string + (progn + (insert :cl) + (save-excursion (insert :op))) + (forward-char (- (prog1 (sp-backward-whitespace t) (insert :cl)))) + (save-excursion (sp-forward-whitespace) (insert :op))) + (sp--run-hook-with-args :op :post-handlers 'split-sexp))))))) + +(defun sp--join-sexp (prev next) + "Join the expressions PREV and NEXT if they are of the same type. + +The expression with smaller :beg is considered the previous one, +so the input order does not actually matter. + +Return the information about resulting expression." + (if (and (sp-compare-sexps prev next equal :op) + (sp-compare-sexps prev next equal :cl)) + ;; if there's some prefix on the second expression, remove it. + ;; We do not move it to the first expression, it is assumed + ;; there's one already + (progn + (if (sp-compare-sexps prev next >) + (let ((tmp prev)) + (setq prev next) + (setq next tmp))) + (sp-get next (delete-region :beg-prf :beg-in)) + (sp-get prev (delete-region :end-in :end)) + (list :beg (sp-get prev :beg) + :end (- (sp-get next (- :end :op-l :prefix-l)) (sp-get prev :cl-l)) + :op (sp-get prev :op) + :cl (sp-get prev :cl) + :prefix (sp-get prev :prefix))) + (sp-message :different-type))) + +(defun sp-join-sexp (&optional arg) + "Join the sexp before and after point if they are of the same type. + +If ARG is positive N, join N expressions after the point with the +one before the point. + +If ARG is negative -N, join N expressions before the point with +the one after the point. + +If ARG is a raw prefix \\[universal-argument] join all the things up until the end +of current expression. + +The joining stops at the first expression of different type. + +Examples: + + (foo bar) |(baz) -> (foo bar |baz) + + (foo) |(bar) (baz) -> (foo |bar baz) ;; 2 + + [foo] [bar] |[baz] -> [foo bar |baz] ;; -2 + + (foo bar (baz)| (quux) (blob bluq)) -> (foo bar (baz| quux blob bluq)) ;; \\[universal-argument]" + (interactive "*P") + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (n (abs arg)) + (prev (save-excursion (sp-backward-sexp (sp--signum arg)))) + next) + (save-excursion + (cond + ((and raw (= n 4)) + (setq next (sp-forward-sexp (sp--signum arg))) + (while (cond + ((> arg 0) + (sp-compare-sexps next prev > :beg :end)) + ((< arg 0) + (sp-compare-sexps next prev < :end :beg))) + (setq prev (sp--join-sexp prev next)) + (setq next (sp-forward-sexp (sp--signum arg))))) + (t (while (> n 0) + (setq next (sp-forward-sexp (sp--signum arg))) + (setq prev (sp--join-sexp prev next)) + (setq n (1- n))))) + prev))) + +(defun sp--next-thing-selection (&optional arg point) + "Return the bounds of selection over next thing. + +See `sp-select-next-thing' for the meaning of ARG. + +If POINT is non-nil, it is assumed it's a point inside the buffer +from which the selection extends, either forward or backward, +depending on the value of ARG. + +The return value has the same format as `sp-get-sexp'. This does +not necessarily represent a valid balanced expression!" + (save-excursion + (let* ((raw (sp--raw-argument-p arg)) + (arg (prefix-numeric-value arg)) + (beg point) (end point) + (op "") (cl "") + (prefix "") + (suffix "")) + (cond + ;; select up until end of list + ((and raw (= arg 4)) + (let ((enc (sp-get-enclosing-sexp))) + (if (not enc) + (error "No enclosing expression") + (save-excursion + (goto-char (sp-get enc :end-in)) + (-when-let (ok (sp-get-thing t)) + (sp-get ok + (setq end :end) + (setq cl :cl) + (setq suffix :suffix))))) + (unless point + (-when-let (ok (sp-get-thing)) + (if (sp-compare-sexps ok enc) + (progn + (setq beg end) + (setq end (sp-get enc :end-in))) + (sp-get ok + (setq beg :beg) + (setq op :op) + (setq prefix :prefix))))))) + ;; select up until beg of list + ((and raw (= arg -4)) + (let ((enc (sp-get-enclosing-sexp))) + (if (not enc) + (error "No enclosing expression") + (save-excursion + (goto-char (sp-get enc :beg-in)) + (-when-let (ok (sp-get-thing)) + (sp-get ok + (setq beg :beg) + (setq op :op) + (setq prefix :prefix)))))) + (unless point + (-when-let (ok (sp-get-thing t)) + (sp-get ok + (setq end :end) + (setq cl :cl) + (setq suffix :suffix))))) + ;; select the enclosing expression + ((and raw (= (abs arg) 16)) + (let ((enc (sp-get-enclosing-sexp))) + (if (not enc) + (error "No enclosing expression") + (sp-get enc (setq beg :beg) (setq end :end) + (setq op :op) (setq cl :cl) + (setq prefix :prefix) + (setq suffix :suffix))))) + ;; normal selection, select N expressions + ((> arg 0) + (let* ((first (sp-forward-sexp)) + (last first)) + (setq arg (1- arg)) + (setq beg (or point (sp-get first :beg))) + (while (and (> arg 0) last) + (setq last (sp-forward-sexp)) + (let ((nb (sp-get last :beg))) (when (< nb beg) + (setq first last) + (setq beg nb))) + (setq arg (1- arg))) + (unless (and point (= point beg)) + (sp-get first + (setq beg :beg) + (setq op :op) + (setq prefix :prefix))) + (sp-get last + (setq end :end) + (setq cl :cl) + (setq suffix :suffix)))) + ;; normal select, select -N expressions + ((< arg 0) + (let* ((first (sp-backward-sexp)) + (last first)) + (setq arg (1+ arg)) + (setq end (or point (sp-get first :end))) + (while (and (< arg 0) last) + (setq last (sp-backward-sexp)) + (let ((ne (sp-get last :end))) (when (> ne end) + (setq first last) + (setq end ne))) + (setq arg (1+ arg))) + (sp-get last + (setq beg :beg) + (setq op :op) + (setq prefix :prefix)) + (unless (and point (= point end)) + (sp-get first + (setq end :end) + (setq cl :cl) + (setq suffix :suffix))))) + ;; N = 0, select insides + ((= arg 0) + (let ((enc (sp-get-enclosing-sexp))) + (if (not enc) + (error "No enclosing expression") + (save-excursion + (goto-char (sp-get enc :beg-in)) + (-when-let (ok (sp-get-thing)) + (sp-get ok + (setq beg :beg) + (setq op :op) + (setq prefix :prefix)))) + (save-excursion + (goto-char (sp-get enc :end-in)) + (-when-let (ok (sp-get-thing t)) + (sp-get ok + (setq end :end) + (setq cl :cl) + (setq suffix :suffix)))))))) + (list :beg beg :end end :op op :cl cl :prefix prefix :suffix suffix)))) + +(defun sp-select-next-thing (&optional arg point) + "Set active region over next thing as recognized by `sp-get-thing'. + +If ARG is positive N, select N expressions forward. + +If ARG is negative -N, select N expressions backward. + +If ARG is a raw prefix \\[universal-argument] select all the things up until the +end of current expression. + +If ARG is a raw prefix \\[universal-argument] \\[universal-argument] select the current expression (as +if doing `sp-backward-up-sexp' followed by +`sp-select-next-thing'). + +If ARG is number 0 (zero), select all the things inside the +current expression. + +If POINT is non-nil, it is assumed it's a point inside the buffer +from which the selection extends, either forward or backward, +depending on the value of ARG. + +If the currently active region contains a balanced expression, +following invocation of `sp-select-next-thing' will select the +inside of this expression . Therefore calling this function +twice with no active region will select the inside of the next +expression. + +If the point is right in front of the expression any potential +prefix is ignored. For example, '|(foo) would only select (foo) +and not include ' in the selection. If you wish to also select +the prefix, you have to move the point backwards. + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions." + (interactive "P") + (let* ((selection (sp--next-thing-selection arg point)) + (p (point)) + (b (sp-get selection :beg)) + (e (sp-get selection :end)) + contracted) + ;; Show a helpful error if we're trying to move beyond the + ;; beginning or end of the buffer. + (when (or (null b) (null e)) + (user-error (if (bobp) "At beginning of buffer" "At end of buffer"))) + ;; if region is active and ready to use, check if this selection + ;; == old selection. If so, reselect the insides + (when (region-active-p) + (let ((rb (region-beginning)) + (re (region-end))) + (when (and (sp-get selection + (or (= rb :beg) + (= rb :beg-prf))) + (= re (sp-get selection :end))) + (sp-get selection + (setq b :beg-in) + (setq e :end-in)) + (setq contracted t)))) + ;; if we moved forward check if the old-point was in front of an + ;; expression and after a prefix. If so, remove the prefix from + ;; the selection + (unless (and (> (prefix-numeric-value arg) 0) + (not (sp--raw-argument-p arg)) + (= b p)) + (unless contracted (setq b (sp-get selection :beg-prf)))) + (push-mark b t t) + (goto-char e) + selection)) + +(defun sp-select-previous-thing (&optional arg point) + "Set active region over ARG previous things as recognized by `sp-get-thing'. + +If ARG is negative -N, select that many expressions forward. + +With `sp-navigate-consider-symbols' symbols and strings are also +considered balanced expressions." + (interactive "P") + (sp-select-next-thing (sp--negate-argument arg) point)) + +(defun sp-select-next-thing-exchange (&optional arg point) + "Just like `sp-select-next-thing' but run `exchange-point-and-mark' +afterwards." + (interactive "P") + (prog1 + (sp-select-next-thing arg point) + (exchange-point-and-mark))) + +(defun sp-select-previous-thing-exchange (&optional arg point) + "Just like `sp-select-previous-thing' but run `exchange-point-and-mark' +afterwards." + (interactive "P") + (prog1 + (sp-select-previous-thing arg point) + (exchange-point-and-mark))) + +(defun sp-mark-sexp (&optional arg allow-extend) + "Set mark ARG balanced expressions from point. +The place mark goes is the same place \\[sp-forward-sexp] would +move to with the same argument. +Interactively, if this command is repeated +or (in Transient Mark mode) if the mark is active, +it marks the next ARG sexps after the ones already marked. +This command assumes point is not in a string or comment." + (interactive "P\np") + (cond ((and allow-extend + (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active))) + (setq arg (if arg (prefix-numeric-value arg) + (if (< (mark) (point)) -1 1))) + (set-mark + (save-excursion + (let ((p (point))) + (goto-char (mark)) + (sp-forward-sexp arg) + (unless (sp-region-ok-p p (point)) + (user-error "Can not extend selection: region invalid")) + (point))))) + (t + (push-mark + (save-excursion + (sp-forward-sexp (prefix-numeric-value arg)) + (point)) + nil t)))) + +(defun sp-delete-char (&optional arg) + "Delete a character forward or move forward over a delimiter. + +If on an opening delimiter, move forward into balanced expression. + +If on a closing delimiter, refuse to delete unless the balanced +expression is empty, in which case delete the entire expression. + +If the delimiter does not form a balanced expression, it will be +deleted normally. + +With a numeric prefix argument N > 0, delete N characters forward. + +With a numeric prefix argument N < 0, delete N characters backward. + +With a numeric prefix argument N = 0, simply delete a character +forward, without regard for delimiter balancing. + +If ARG is raw prefix argument \\[universal-argument], delete +characters forward until a closing delimiter whose deletion would +break the proper pairing is hit. + +Examples: + + (quu|x \"zot\") -> (quu| \"zot\") + + (quux |\"zot\") -> (quux \"|zot\") -> (quux \"|ot\") + + (foo (|) bar) -> (foo | bar) + + |(foo bar) -> (|foo bar)" + (interactive "*P") + (sp--with-case-sensitive + (let* ((raw (sp--raw-argument-p arg)) + ;; if you edit 10 gigabyte files in Emacs, you're gonna have + ;; a bad time. + (n (if raw 100000000 + (prefix-numeric-value arg)))) + (cond + ((> n 0) + (while (> n 0) + (cond + ((let ((ok (sp-point-in-empty-sexp))) + (when ok + (backward-char (length (car ok))) + (delete-char (+ (length (car ok)) (length (cdr ok))))) + ok) + ;; make this customizable + (setq n (1- n))) + ((and (sp-point-in-string) + (save-excursion (forward-char) (not (sp-point-in-string)))) + (setq n 0)) + ((sp--looking-at (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) + (-if-let (thing (save-match-data (sp-get-thing))) + (cond + ((= (sp-get thing :end-in) (point)) + (setq n 0)) + ((= (sp-get thing :beg) (point)) + (goto-char (sp-get thing :beg-in))) + (t + (delete-char (length (match-string 0))))) + (delete-char (length (match-string 0)))) + ;; make this customizable + (setq n (1- n))) + ((and (not (sp-point-in-string)) + (save-excursion (forward-char) (sp-point-in-string))) + (forward-char) + ;; make this customizable + (setq n (1- n))) + ((sp--looking-at (sp--get-closing-regexp (sp--get-pair-list-context 'navigate))) + (if (save-match-data (sp-get-thing)) + ;; make this customizable -- maybe we want to skip and + ;; continue deleting + (setq n 0) + (delete-char (length (match-string 0))) + (setq n (1- n)))) + ((bound-and-true-p hungry-delete-mode) + (hungry-delete-forward 1) + (setq n (1- n))) + (t + (delete-char 1) + (setq n (1- n)))))) + ((= n 0) (delete-char 1)) + (t (sp-backward-delete-char (sp--negate-argument arg))))))) + +(defun sp-backward-delete-char (&optional arg) + "Delete a character backward or move backward over a delimiter. + +If on a closing delimiter, move backward into balanced expression. + +If on a opening delimiter, refuse to delete unless the balanced +expression is empty, in which case delete the entire expression. + +If the delimiter does not form a balanced expression, it will be +deleted normally. + +With a numeric prefix argument N > 0, delete N characters backward. + +With a numeric prefix argument N < 0, delete N characters forward. + +With a numeric prefix argument N = 0, simply delete a character +backward, without regard for delimiter balancing. + +If ARG is raw prefix argument \\[universal-argument], delete +characters backward until a opening delimiter whose deletion would +break the proper pairing is hit. + +Examples: + + (\"zot\" q|uux) -> (\"zot\" |uux) + + (\"zot\"| quux) -> (\"zot|\" quux) -> (\"zo|\" quux) + + (foo (|) bar) -> (foo | bar) + + (foo bar)| -> (foo bar|)" + (interactive "*P") + (if (and sp-autodelete-wrap + (eq sp-last-operation 'sp-wrap-region)) + (sp-backward-unwrap-sexp) + (sp--with-case-sensitive + (let* ((raw (sp--raw-argument-p arg)) + ;; if you edit 10 gigabyte files in Emacs, you're gonna have + ;; a bad time. + (n (if raw 100000000 + (prefix-numeric-value arg)))) + (cond + ((> n 0) + (while (> n 0) + (cond + ((let ((ok (sp-point-in-empty-sexp))) + (when ok + (backward-char (length (car ok))) + (delete-char (+ (length (car ok)) (length (cdr ok))))) + ok) + ;; make this customizable + (setq n (1- n))) + ((and (sp-point-in-string) + (save-excursion (backward-char) (not (sp-point-in-string)))) + (setq n 0)) + ((sp--looking-back (sp--get-closing-regexp (sp--get-pair-list-context 'navigate))) + (-if-let (thing (save-match-data (sp-get-thing t))) + (cond + ((= (sp-get thing :end) (point)) + (goto-char (sp-get thing :end-in))) + ((= (sp-get thing :beg-in) (point)) + (setq n 0)) + (t + (delete-char (- (length (match-string 0)))))) + (delete-char (- (length (match-string 0))))) + ;; make this customizable + (setq n (1- n))) + ((and (not (sp-point-in-string)) + (save-excursion (backward-char) (sp-point-in-string))) + (backward-char) + ;; make this customizable + (setq n (1- n))) + ((sp--looking-back (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) + (if (save-match-data (sp-get-thing t)) + ;; make this customizable -- maybe we want to skip and + ;; continue deleting + (setq n 0) + (delete-char (- (length (match-string 0)))) + (setq n (1- n)))) + ((bound-and-true-p hungry-delete-mode) + (hungry-delete-backward 1) + (setq n (1- n))) + (t + (delete-char -1) + (setq n (1- n)))))) + ((= n 0) (delete-char -1)) + (t (sp-delete-char (sp--negate-argument arg)))))))) + +(put 'sp-backward-delete-char 'delete-selection 'supersede) +(put 'sp-delete-char 'delete-selection 'supersede) + +(defun sp-point-in-empty-sexp (&optional pos) + "Return non-nil if point is in empty sexp or string. + +The return value is active cons pair of opening and closing sexp +delimiter enclosing this sexp." + (setq pos (or pos (point))) + (let (op act) + (cond + ((sp--looking-back (sp--get-opening-regexp (sp--get-pair-list-context 'navigate))) + (setq op (match-string 0)) + (setq act (--first (equal (car it) op) sp-pair-list)) + (when (sp--looking-at (regexp-quote (cdr act))) act)) + ((sp-point-in-empty-string pos))))) + +(defun sp-point-in-empty-string (&optional pos) + "Return non-nil if point is in empty string. + +The return value is actually cons pair of opening and closing +string delimiter enclosing this string." + (setq pos (or pos (point))) + (when (and (sp-point-in-string) + (save-excursion (if (= (point-max) (point)) + t + (forward-char) (not (sp-point-in-string)))) + (save-excursion (backward-char) (not (sp-point-in-string)))) + (save-excursion + (let* ((syntax (nth 3 (syntax-ppss pos))) + (c (char-to-string (if (eq syntax t) (following-char) syntax)))) + (cons c c))))) + +(defun sp--use-subword () + "Return non-nil if word killing commands should kill subwords. +This is the case if `subword-mode' is enabled and +`sp-use-subword' is non-nil." + (and sp-use-subword (bound-and-true-p subword-mode))) + +(defun sp--kill-word (&optional n) + "Kill N words or subwords." + (let ((n (or n 1))) + (if (sp--use-subword) + (subword-kill n) + (kill-word n)))) + +(defun sp--forward-word (&optional n) + "Move forward N words or subwords." + (let ((n (or n 1))) + (if (sp--use-subword) + (subword-forward n) + (forward-word n)))) + +(defun sp--backward-word (&optional n) + "Move backward N words or subwords." + (let ((n (or n 1))) + (if (sp--use-subword) + (subword-backward n) + (backward-word n)))) + +(defun sp-kill-symbol (&optional arg word) + "Kill a symbol forward, skipping over any intervening delimiters. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction. + +See `sp-forward-symbol' for what constitutes a symbol." + (interactive "*p") + (sp--with-case-sensitive + (if (> arg 0) + (while (> arg 0) + (-when-let (s (sp-get-symbol)) + (sp-get s + (let* ((beg + (if (< :beg-prf (point)) + (if word (point) :beg) + (if (= (save-excursion + (sp-skip-forward-to-symbol) + (point)) + :beg-prf) + (point) + :beg-prf))) + (end (if word + (let ((fw-end + (save-excursion + (sp--forward-word) + (point)))) + (if (sp-region-ok-p beg fw-end) + fw-end + :end-suf)) + :end-suf))) + (goto-char beg) + (kill-region beg end)))) + (sp--cleanup-after-kill) + (setq arg (1- arg))) + (sp-backward-kill-symbol (sp--negate-argument arg) word)))) + +(defun sp-kill-word (&optional arg) + "Kill a word forward, skipping over intervening delimiters. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction." + (interactive "*p") + (sp-kill-symbol arg t)) + +(defun sp-delete-symbol (&optional arg word) + "Delete a symbol forward, skipping over any intervening delimiters. + +Deleted symbol does not go to the clipboard or kill ring. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction. + +See `sp-forward-symbol' for what constitutes a symbol." + (interactive "*p") + (let* ((kill-ring kill-ring) + (select-enable-clipboard nil)) + (sp-kill-symbol arg word))) + +(defun sp-delete-word (&optional arg) + "Delete a word forward, skipping over intervening delimiters. + +Deleted word does not go to the clipboard or kill ring. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction." + (interactive "*p") + (sp-delete-symbol arg t)) + +(defun sp-backward-kill-symbol (&optional arg word) + "Kill a symbol backward, skipping over any intervening delimiters. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +forward direction. + +See `sp-backward-symbol' for what constitutes a symbol." + (interactive "*p") + (sp--with-case-sensitive + (if (> arg 0) + (while (> arg 0) + (-when-let (s (sp-get-symbol t)) + (sp-get s + (let* ((end + (if (< (point) :end-suf) + (if word (point) :end-suf) + (if (= (save-excursion + (sp-skip-backward-to-symbol) + (point)) + :end-suf) + (point) + :end-suf))) + (beg (if word + (let ((bw-start + (save-excursion + (sp--backward-word) + (point)))) + (if (sp-region-ok-p bw-start end) + bw-start + :beg-prf)) + :beg-prf))) + (goto-char end) + (kill-region end beg)))) + (sp--cleanup-after-kill) + (setq arg (1- arg))) + (sp-kill-symbol (sp--negate-argument arg) word)))) + +(defun sp-backward-kill-word (&optional arg) + "Kill a word backward, skipping over intervening delimiters. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction." + (interactive "*p") + (sp-backward-kill-symbol arg t)) + +(defun sp-backward-delete-symbol (&optional arg word) + "Delete a symbol backward, skipping over any intervening delimiters. + +Deleted symbol does not go to the clipboard or kill ring. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +forward direction. + +See `sp-backward-symbol' for what constitutes a symbol." + (interactive "*p") + (let* ((kill-ring kill-ring) + (select-enable-clipboard nil)) + (sp-backward-kill-symbol arg word))) + +(defun sp-backward-delete-word (&optional arg) + "Delete a word backward, skipping over intervening delimiters. + +Deleted word does not go to the clipboard or kill ring. + +With ARG being positive number N, repeat that many times. + +With ARG being Negative number -N, repeat that many times in +backward direction." + (interactive "*p") + (sp-backward-delete-symbol arg t)) + +(defun sp-delete-region (beg end) + "Delete the text between point and mark, like `delete-region'. + +BEG and END are the bounds of region to be deleted. + +If that text is unbalanced, signal an error instead. +With a prefix argument, skip the balance check." + (interactive "*r") + (when (or current-prefix-arg + (sp-region-ok-p beg end) + (user-error (sp-message :unbalanced-region :return))) + (setq this-command 'delete-region) + (delete-region beg end))) + +(defun sp-kill-region (beg end) + "Kill the text between point and mark, like `kill-region'. + +BEG and END are the bounds of region to be killed. + +If that text is unbalanced, signal an error instead. +With a prefix argument, skip the balance check." + (interactive "*r") + (when (or current-prefix-arg + (sp-region-ok-p beg end) + (user-error (sp-message :unbalanced-region :return))) + (setq this-command 'kill-region) + (kill-region beg end))) + +(defun sp-indent-defun (&optional arg) + "Reindent the current defun. + +If point is inside a string or comment, fill the current +paragraph instead, and with ARG, justify as well. + +Otherwise, reindent the current defun, and adjust the position +of the point." + (interactive "*P") + (if (sp-point-in-string-or-comment) + (fill-paragraph arg) + (let ((column (current-column)) + (indentation (sp--current-indentation))) + (save-excursion + (end-of-defun) + (beginning-of-defun) + (indent-sexp)) + (sp--back-to-indentation column indentation)))) + +(cl-defun sp-region-ok-p (start end) + "Test if region between START and END is balanced. + +A balanced region is one where all opening delimiters are matched +by closing delimiters. + +This function does *not* check that the delimiters are correctly +ordered, that is [(]) is correct even though it is not logically +properly balanced." + (interactive "r") + (save-excursion + (save-restriction + (when (eq (sp-point-in-string start) (sp-point-in-string end)) + (narrow-to-region start end) + (let ((regex (sp--get-allowed-regexp (-difference sp-pair-list (sp--get-allowed-pair-list))))) + (goto-char (point-min)) + (while (or (prog1 (sp-forward-sexp) + (sp-skip-forward-to-symbol)) + ;; skip impossible delimiters + (when (looking-at-p regex) + (goto-char (match-end 0))))) + (looking-at-p "[[:blank:]\n]*\\'")))))) + +(defun sp-newline () + "Insert a newline and indent it. + +This is like `newline-and-indent', but it not only indents the +line that the point is on but also the S-expression following the +point, if there is one. + +If in a string, just insert a literal newline. + +If in a comment and if followed by invalid structure, call +`indent-new-comment-line' to keep the invalid structure in a +comment." + (interactive "*") + (cond + ((sp-point-in-string) + (newline)) + ((sp-point-in-comment) + (if (sp-region-ok-p (point) (point-at-eol)) + (progn (newline-and-indent) (ignore-errors (indent-sexp))) + (indent-new-comment-line))) + (t + (newline-and-indent) + (ignore-errors (indent-sexp))))) + +(defun sp-comment () + "Insert the comment character and adjust hanging sexps such + that it doesn't break structure." + (interactive "*") + (if (sp-point-in-string-or-comment) + (if (= 1 (length (single-key-description last-command-event))) ;; pretty hacky + (insert (single-key-description last-command-event)) + (insert comment-start)) + (sp--with-case-sensitive + (let ((old-point (point)) + (column (current-column)) + (indentation (sp--current-indentation)) + (old-line (line-number-at-pos)) + (hsexp (sp-get-hybrid-sexp)) + (newline-inserted 0)) + (goto-char (sp-get hsexp :end)) + (if (and (sp--looking-at-p (concat "\\s-*" (sp--get-closing-regexp))) + (= old-line (line-number-at-pos))) + (progn + (setq old-point (point)) + (newline) + (setq newline-inserted (1+ (- (line-end-position) (point))))) + (when (/= old-line (line-number-at-pos)) + (sp-backward-sexp) + (setq old-point (+ old-point (skip-syntax-backward " "))) + (newline) + (setq newline-inserted (- (line-end-position) (point))))) + ;; @{ indenting madness + (goto-char old-point) + (sp-get hsexp (sp--indent-region :beg (+ :end newline-inserted))) + (sp--back-to-indentation column indentation) + ;; @} + (let ((comment-delim (or (cdr (--first (memq major-mode (car it)) sp-comment-string)) + comment-start))) + (when (and (/= 0 (current-column)) + (not (sp--looking-back-p "\\s-"))) + (insert " ")) + (insert comment-delim) + (when (/= newline-inserted 0) + (save-excursion + (forward-line 1) + (indent-according-to-mode)))))))) + +(defun sp-wrap-round () + "Wrap following sexp in round parentheses." + (interactive "*") + (sp-wrap-with-pair "(")) + +(defun sp-wrap-square () + "Wrap following sexp in square brackets." + (interactive "*") + (sp-wrap-with-pair "[")) + +(defun sp-wrap-curly () + "Wrap following sexp in curly braces." + (interactive "*") + (sp-wrap-with-pair "{")) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; show-smartparens-mode + +(defgroup show-smartparens nil + "Show smartparens minor mode." + :group 'smartparens) + +(defcustom sp-show-pair-delay 0.125 + "Time in seconds to delay before showing a matching pair." + :type '(number :tag "seconds") + :group 'show-smartparens) + +(defcustom sp-show-enclosing-pair-commands '( + sp-show-enclosing-pair + sp-forward-slurp-sexp + sp-backward-slurp-sexp + sp-forward-barf-sexp + sp-backward-barf-sexp + ) + "List of commands after which the enclosing pair is highlighted. + +After the next command the pair will automatically disappear." + :type '(repeat symbol) + :group 'show-smartparens) + +(defcustom sp-show-pair-from-inside nil + "If non-nil, highlight the enclosing pair if immediately after +the opening delimiter or before the closing delimiter." + :type 'boolean + :group 'show-smartparens) + +(defcustom sp-show-pair-match-priority 1000 + "Priority of matching pair highlighting overlays." + :type 'integer + :group 'show-smartparens) + +(defface sp-show-pair-match-face + '((t (:inherit show-paren-match))) + "`show-smartparens-mode' face used for a matching pair." + :group 'show-smartparens) + +(defface sp-show-pair-mismatch-face + '((t (:inherit show-paren-mismatch))) + "`show-smartparens-mode' face used for a mismatching pair." + :group 'show-smartparens) + +(defface sp-show-pair-enclosing + '((t (:inherit highlight))) + "The face used to highlight pair overlays." + :group 'show-smartparens) + +(defface sp-show-pair-match-content-face + '() + "`show-smartparens-mode' face used for a matching pair's content." + :group 'show-smartparens) + +(defvar sp-show-pair-idle-timer nil) + +(defvar sp-show-pair-overlays nil) + +(defvar sp-show-pair-previous-match-positions nil) + +(defvar sp-show-pair-previous-point nil) + +(defvar sp-show-pair-enc-overlays nil) + +;;;###autoload +(define-minor-mode show-smartparens-mode + "Toggle visualization of matching pairs. When enabled, any +matching pair is highlighted after `sp-show-pair-delay' seconds +of Emacs idle time if the point is immediately in front or after +a pair. This mode works similarly to `show-paren-mode', but +support custom pairs." + :init-value nil + :group 'show-smartparens + (if show-smartparens-mode + (unless sp-show-pair-idle-timer + (setq sp-show-pair-idle-timer + (run-with-idle-timer sp-show-pair-delay t + 'sp-show--pair-function))) + (when sp-show-pair-overlays + (sp-show--pair-delete-overlays)))) + +;;;###autoload +(define-globalized-minor-mode show-smartparens-global-mode + show-smartparens-mode + turn-on-show-smartparens-mode) + +;;;###autoload +(defun turn-on-show-smartparens-mode () + "Turn on `show-smartparens-mode'." + (interactive) + (unless (or (member major-mode sp-ignore-modes-list) + (and (not (derived-mode-p 'comint-mode)) + (eq (get major-mode 'mode-class) 'special))) + (show-smartparens-mode t))) + +;;;###autoload +(defun turn-off-show-smartparens-mode () + "Turn off `show-smartparens-mode'." + (interactive) + (show-smartparens-mode -1)) + +(defun sp-show-enclosing-pair () + "Highlight the enclosing pair around point." + (interactive)) + +(defun sp-highlight-current-sexp (_arg) + "Highlight the expression returned by the next command, preserving +point position." + (interactive "P") + (let* ((cmd (read-key-sequence "" t)) + (com (key-binding cmd))) + (if (commandp com) + (save-excursion + (let ((ok (call-interactively com))) + (sp-show--pair-enc-function ok))) + (execute-kbd-macro cmd)))) + +(eval-when-compile + (defalias 'sp--while-no-input 'while-no-input) + (when (version< emacs-version "27") + ;; Ripped from Emacs 27.0 subr.el. + ;; See Github Issue#946 and Emacs bug#31692. + (defmacro sp--while-no-input (&rest body) + "Execute BODY only as long as there's no pending input. +If input arrives, that ends the execution of BODY, +and `while-no-input' returns t. Quitting makes it return nil. +If BODY finishes, `while-no-input' returns whatever value BODY produced." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input"))) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym) + val) + (setq val (or (input-pending-p) + (progn ,@body))) + (cond + ;; When input arrives while throw-on-input is non-nil, + ;; kbd_buffer_store_buffered_event sets quit-flag to the + ;; value of throw-on-input. If, when BODY finishes, + ;; quit-flag still has the same value as throw-on-input, it + ;; means BODY never tested quit-flag, and therefore ran to + ;; completion even though input did arrive before it + ;; finished. In that case, we must manually simulate what + ;; 'throw' in process_quit_flag would do, and we must + ;; reset quit-flag, because leaving it set will cause us + ;; quit to top-level, which has undesirable consequences, + ;; such as discarding input etc. We return t in that case + ;; because input did arrive during execution of BODY. + ((eq quit-flag throw-on-input) + (setq quit-flag nil) + t) + ;; This is for when the user actually QUITs during + ;; execution of BODY. + (quit-flag + nil) + (t val))))))))) + +(defun sp-show--pair-function () + "Display the show pair overlays and print the line of the +matching paren in the echo area if not visible on screen." + (when show-smartparens-mode + (sp--with-case-sensitive + (save-match-data + (sp--while-no-input + (cl-labels ((scan-and-place-overlays + (match &optional back) + ;; we can use `sp-get-thing' here because we *are* at some + ;; pair opening, and so only the tag or the sexp can trigger. + (-if-let (ok (sp-get-thing back)) + (sp-get ok + (when (or (and back + (or (= :end (point)) + (= :beg-in (point)))) + (and (not back) + (or (= :beg (point)) + (= :end-in (point))))) + (sp-show--pair-create-overlays :beg :end :op-l :cl-l) + (when (and sp-echo-match-when-invisible + (not (or (active-minibuffer-window) cursor-in-echo-area))) + (sp-show--pair-echo-match :beg :end :op-l :cl-l)))) + (if back + (sp-show--pair-create-mismatch-overlay (- (point) (length match)) + (length match)) + (sp-show--pair-create-mismatch-overlay (point) (length match))) + (setq sp-show-pair-previous-match-positions nil) + (setq sp-show-pair-previous-point nil)))) + (let* ((pair-list (sp--get-allowed-pair-list)) + (opening (sp--get-opening-regexp pair-list)) + (closing (sp--get-closing-regexp pair-list)) + (allowed (and sp-show-pair-from-inside (sp--get-allowed-regexp)))) + (cond + ;; if we are in a situation "()|", we should highlight the + ;; regular pair and not the string pair "from inside" + ((and (not (sp--evil-normal-state-p)) + (not (sp--evil-motion-state-p)) + (not (sp--evil-visual-state-p)) + (sp--looking-back (if sp-show-pair-from-inside allowed closing))) + (scan-and-place-overlays (match-string 0) :back)) + ((or (and (or (sp--evil-normal-state-p) + (sp--evil-motion-state-p) + (sp--evil-visual-state-p)) + (sp--looking-at (sp--get-allowed-regexp))) + (sp--looking-at (if sp-show-pair-from-inside allowed opening)) + (looking-at (sp--get-stringlike-regexp)) + (and (memq major-mode sp-navigate-consider-sgml-tags) + (looking-at "<"))) + (scan-and-place-overlays (match-string 0))) + ((or (sp--looking-back (if sp-show-pair-from-inside allowed closing)) + (sp--looking-back (sp--get-stringlike-regexp)) + (and (memq major-mode sp-navigate-consider-sgml-tags) + (sp--looking-back ">"))) + (scan-and-place-overlays (match-string 0) :back)) + (sp-show-pair-overlays + (sp-show--pair-delete-overlays) + (setq sp-show-pair-previous-match-positions nil) + (setq sp-show-pair-previous-point nil)))))))))) + +(defun sp-show--pair-enc-function (&optional thing) + "Display the show pair overlays for enclosing expression." + (when show-smartparens-mode + (-when-let (enc (or thing (sp-get-enclosing-sexp))) + (sp-get enc (sp-show--pair-create-enc-overlays :beg :end :op-l :cl-l))))) + +(defun sp-show--pair-create-overlays (start end olen clen) + "Create the show pair overlays." + (when sp-show-pair-overlays + (sp-show--pair-delete-overlays)) + (let* ((oleft (make-overlay start (+ start olen) nil t nil)) + (omiddle (make-overlay (+ start olen) (- end clen) nil t nil)) + (oright (make-overlay (- end clen) end nil t nil))) + (setq sp-show-pair-overlays (list oleft omiddle oright)) + (overlay-put oleft 'face 'sp-show-pair-match-face) + (unless (use-region-p) + (overlay-put omiddle 'face 'sp-show-pair-match-content-face)) + (overlay-put oright 'face 'sp-show-pair-match-face) + (overlay-put oleft 'priority sp-show-pair-match-priority) + (overlay-put omiddle 'priority 1000) + (overlay-put oright 'priority sp-show-pair-match-priority) + (overlay-put oleft 'type 'show-pair))) + +(defun sp-show--pair-echo-match (start end olen clen) + "Print the line of the matching paren in the echo area if not +visible on screen. Needs to be called after the show-pair overlay +has been created." + (let ((match-positions (list start end olen clen))) + (when (not (and (equal sp-show-pair-previous-match-positions match-positions) + (equal sp-show-pair-previous-point (point)))) + (setq sp-show-pair-previous-match-positions match-positions) + (setq sp-show-pair-previous-point (point)) + (let* ((visible-start (pos-visible-in-window-p start)) + (visible-end (pos-visible-in-window-p end)) + (where (cond + ((not visible-start) start) + ((not visible-end) end)))) + (when where + (save-excursion + (let* ((from (progn (goto-char where) (beginning-of-line) (point))) + (to (progn (end-of-line) (point))) + (line (buffer-substring from to)) + (message-log-max)) ;; don't log in messages + ;; Add smartparens overlay for opening parens + (let* ((i1 (- start from)) + (i2 (+ i1 olen))) + (when (and (< i1 (length line)) (>= i2 0)) + (add-face-text-property (max i1 0) (min i2 (length line)) + 'sp-show-pair-match-face nil line))) + ;; Add smartparens overlay for closing parens + (let* ((i1 (- end from 1)) + (i2 (+ i1 clen))) + (when (and (< i1 (length line)) (>= i2 0)) + (add-face-text-property (max i1 0) (min i2 (length line)) + 'sp-show-pair-match-face nil line))) + ;; echo line of match + (message "Matches: %s" (string-trim line))))))))) + +(defun sp-show--pair-create-enc-overlays (start end olen clen) + "Create the show pair enclosing overlays" + (when sp-show-pair-enc-overlays + (sp-show--pair-delete-enc-overlays)) + (let* ((oleft (make-overlay start (+ start olen) nil t nil)) + (oright (make-overlay (- end clen) end nil t nil))) + (setq sp-show-pair-enc-overlays (cons oleft oright)) + (overlay-put oleft 'face 'sp-show-pair-enclosing) + (overlay-put oright 'face 'sp-show-pair-enclosing) + (overlay-put oleft 'priority 1000) + (overlay-put oright 'priority 1000) + (overlay-put oleft 'type 'show-pair-enc))) + +(defun sp-show--pair-create-mismatch-overlay (start len) + "Create the mismatch pair overlay." + (when sp-show-pair-overlays + (sp-show--pair-delete-overlays)) + (let ((o (make-overlay start (+ start len) nil t nil))) + (setq sp-show-pair-overlays (list o)) + (overlay-put o 'face 'sp-show-pair-mismatch-face) + (overlay-put o 'priority 1000) + (overlay-put o 'type 'show-pair))) + +(defun sp-show--pair-delete-overlays () + "Remove both show pair overlays." + (when sp-show-pair-overlays + (dolist (overlay sp-show-pair-overlays) + (delete-overlay overlay)) + (setq sp-show-pair-overlays nil))) + +(defun sp-show--pair-delete-enc-overlays () + "Remove both show pair enclosing overlays." + (when sp-show-pair-enc-overlays + (when (car sp-show-pair-enc-overlays) + (delete-overlay (car sp-show-pair-enc-overlays))) + (when (cdr sp-show-pair-enc-overlays) + (delete-overlay (cdr sp-show-pair-enc-overlays))) + (setq sp-show-pair-enc-overlays nil))) + + +;; global initialization +(defadvice delete-backward-char (before sp-delete-pair-advice activate) + (save-match-data + (sp-delete-pair (ad-get-arg 0)))) +(defadvice haskell-indentation-delete-backward-char (before sp-delete-pair-advice activate) + (save-match-data + (sp-delete-pair (ad-get-arg 0)))) +(sp--set-base-key-bindings) +(sp--update-override-key-bindings) + +(defadvice company--insert-candidate (after sp-company--insert-candidate activate) + "If `smartparens-mode' is active, we check if the completed string +has a pair definition. If so, we insert the closing pair." + (when smartparens-mode + (sp-insert-pair)) + ad-return-value) + +(defadvice hippie-expand (after sp-auto-complete-advice activate) + (when smartparens-mode + (sp-insert-pair))) + +(defvar sp--mc/cursor-specific-vars + '( + sp-wrap-point + sp-wrap-mark + sp-last-wrapped-region + sp-pair-overlay-list + sp-wrap-overlays + sp-wrap-tag-overlays + sp-last-operation + sp-previous-point + ) + "A list of vars that need to be tracked on a per-cursor basis.") + +(defvar mc/cursor-specific-vars) +(eval-after-load 'multiple-cursors + '(dolist (it sp--mc/cursor-specific-vars) + (add-to-list 'mc/cursor-specific-vars it))) + +(provide 'smartparens) + +;; Local Variables: +;; coding: utf-8 +;; eval: (font-lock-add-keywords nil `((,(concat "(" (regexp-opt '("sp-do-move-op" "sp-do-move-cl" "sp-do-put-op" "sp-do-put-cl" "sp-do-del-op" "sp-do-del-cl") t) "\\_>") 1 'font-lock-variable-name-face))) +;; End: + +;;; smartparens.el ends here diff --git a/elpa/smartparens-20230529.1017/sp-sublimetext-like.el b/elpa/smartparens-20230529.1017/sp-sublimetext-like.el new file mode 100644 index 00000000..1cae7f43 --- /dev/null +++ b/elpa/smartparens-20230529.1017/sp-sublimetext-like.el @@ -0,0 +1,57 @@ +;;; sp-sublimetext-like.el --- Behavior for inserting parentheses similar to SublimeText editor. -*- lexical-binding: t; -*- +;; +;; Author: Konstantin Kharlamov +;; Maintainer: Matus Goljer +;; Created: 16 December 2020 +;; Keywords: convenience editing +;; URL: https://github.com/Fuco1/smartparens +;; +;; This file is not part of GNU Emacs. +;; +;;; License: +;; +;; This file is part of Smartparens. +;; +;; Smartparens 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. +;; +;; Smartparens 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 Smartparens. If not, see . +;; +;;; Commentary: +;; +;; This file configuation to make smartparens insertion behavae similarly to +;; SublimeText editor. To use it, simply add: +;; +;; (require 'sp-sublimetext-like) +;; +;; into your configuration. You can use this in conjunction with the +;; default config or your own configuration. +;; +;;; Code: + +(require 'smartparens) + +(defun sp-point-not-before-word (_ action __) + "In insert and autoskip actions returns t when next symbol is +not a word constituent." + (if (memq action '(insert autoskip)) + (looking-at "\\(\\Sw\\|$\\)") + t)) + +(let ((when '(sp-point-not-before-word)) + (actions '(insert wrap autoskip navigate))) + (sp-pair "{" "}" :when when :actions actions) + (sp-pair "[" "]" :when when :actions actions) + (sp-pair "(" ")" :when when :actions actions)) + +(provide 'sp-sublimetext-like) + +;;; sp-sublimetext-like.el ends here