From: Andreas Gerler Date: Wed, 6 Jan 2021 15:20:48 +0000 (+0100) Subject: update smartparens and dash X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=9aff9cffd990a1d1ba4e243be14c86c44b710886;p=emacsconfig.git update smartparens and dash --- diff --git a/bba.org b/bba.org index 5efbe17a..baf6f79a 100644 --- a/bba.org +++ b/bba.org @@ -404,8 +404,8 @@ Some key bindings taken from [[https://ebzzry.github.io/emacs-pairs.html][emacs- #+BEGIN_SRC emacs-lisp :tangle yes (if (>= emacs-major-version 24) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/smartparens-20200105.1259") - (add-to-list 'load-path "~/.emacs.d/elpa/dash-20210101.1712") + (add-to-list 'load-path "~/.emacs.d/elpa/smartparens-20201229.1937") + (add-to-list 'load-path "~/.emacs.d/elpa/dash-20210105.414") (require 'smartparens) (smartparens-global-mode 1) (defmacro def-pairs (pairs) diff --git a/elpa/dash-20210101.1712/dash-autoloads.el b/elpa/dash-20210101.1712/dash-autoloads.el deleted file mode 100644 index 0b16ab1c..00000000 --- a/elpa/dash-20210101.1712/dash-autoloads.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; dash-autoloads.el --- automatically extracted autoloads -;; -;;; 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. - -If called interactively, enable Dash-Fontify mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. - -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, enable the mode if -ARG is omitted or nil. - -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) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-keep" "-l" "-m" "-non" "-only-some" "-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-20210101.1712/dash-pkg.el b/elpa/dash-20210101.1712/dash-pkg.el deleted file mode 100644 index cc822c6c..00000000 --- a/elpa/dash-20210101.1712/dash-pkg.el +++ /dev/null @@ -1,9 +0,0 @@ -(define-package "dash" "20210101.1712" "A modern list library for Emacs" 'nil :commit "e8ed3d640797a8b816d1d5e2710a960765ab034b" :authors - (("Magnar Sveen" . "magnars@gmail.com")) - :maintainer - ("Magnar Sveen" . "magnars@gmail.com") - :keywords - ("extensions" "lisp")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/dash-20210101.1712/dash.el b/elpa/dash-20210101.1712/dash.el deleted file mode 100644 index 3c07f3b1..00000000 --- a/elpa/dash-20210101.1712/dash.el +++ /dev/null @@ -1,2928 +0,0 @@ -;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. - -;; Author: Magnar Sveen -;; Version: 2.17.0 -;; Keywords: extensions, lisp - -;; 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 documentation on https://github.com/magnars/dash.el#functions -;; -;; **Please note** The lexical binding in this file is not utilised at the -;; moment. We will take full advantage of lexical binding in an upcoming 3.0 -;; release of Dash. In the meantime, we've added the pragma to avoid a bug that -;; you can read more about in https://github.com/magnars/dash.el/issues/130. -;; - -;;; Code: - -;; TODO: `gv' was introduced in Emacs 24.3, so remove this and all -;; calls to `defsetf' when support for earlier versions is dropped. -(eval-when-compile - (unless (fboundp 'gv-define-setter) - (require 'cl))) - -(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." - `(setq ,cdr (cons ,car ,cdr))) - -(defmacro !cdr (list) - "Destructive: Set LIST to the cdr of LIST." - `(setq ,list (cdr ,list))) - -(defmacro --each (list &rest body) - "Anaphoric form of `-each'." - (declare (debug (form body)) - (indent 1)) - (let ((l (make-symbol "list"))) - `(let ((,l ,list) - (it-index 0)) - (while ,l - (let ((it (car ,l))) - ,@body) - (setq it-index (1+ it-index)) - (!cdr ,l))))) - -(defmacro -doto (eval-initial-value &rest forms) - "Eval a form, then insert that form as the 2nd argument to other forms. -The EVAL-INITIAL-VALUE form is evaluated once. Its result is -passed to FORMS, which are then evaluated sequentially. Returns -the target form." - (declare (indent 1)) - (let ((retval (make-symbol "value"))) - `(let ((,retval ,eval-initial-value)) - ,@(mapcar (lambda (form) - (if (sequencep form) - `(,(-first-item form) ,retval ,@(cdr form)) - `(funcall form ,retval))) - forms) - ,retval))) - -(defmacro --doto (eval-initial-value &rest forms) - "Anaphoric form of `-doto'. -Note: `it' is not required in each form." - (declare (indent 1)) - `(let ((it ,eval-initial-value)) - ,@forms - it)) - -(defun -each (list fn) - "Call FN with every item in LIST. Return nil, used for side-effects only." - (declare (indent 1)) - (--each list (funcall fn it))) - -(defalias '--each-indexed '--each) - -(defun -each-indexed (list fn) - "Call (FN index item) for each item in LIST. - -In the anaphoric form `--each-indexed', the index is exposed as symbol `it-index'. - -See also: `-map-indexed'." - (declare (indent 1)) - (--each list (funcall fn it-index it))) - -(defmacro --each-while (list pred &rest body) - "Anaphoric form of `-each-while'." - (declare (debug (form form body)) - (indent 2)) - (let ((l (make-symbol "list"))) - `(let ((,l ,list) - (it-index 0) - it) - (ignore it) - (while (when ,l - (setq it (pop ,l)) - ,pred) - ,@body - (setq it-index (1+ it-index)))))) - -(defun -each-while (list pred fn) - "Call FN with every item in LIST while (PRED item) is non-nil. -Return nil, used for side-effects only." - (declare (indent 2)) - (--each-while list (funcall pred it) (funcall fn it))) - -(defmacro --each-r (list &rest body) - "Anaphoric form of `-each-r'." - (declare (debug (form body)) - (indent 1)) - (let ((v (make-symbol "vector"))) - ;; Implementation note: building 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 modification was reversed before we return. - `(let* ((,v (vconcat ,list)) - (it-index (length ,v)) - it) - (while (> it-index 0) - (setq it-index (1- it-index)) - (setq it (aref ,v it-index)) - ,@body)))) - -(defun -each-r (list fn) - "Call FN with every item in LIST in reversed order. - Return nil, used for side-effects only." - (--each-r list (funcall fn it))) - -(defmacro --each-r-while (list pred &rest body) - "Anaphoric form of `-each-r-while'." - (declare (debug (form form body)) - (indent 2)) - (let ((v (make-symbol "vector"))) - `(let* ((,v (vconcat ,list)) - (it-index (length ,v)) - it) - (while (> it-index 0) - (setq it-index (1- it-index)) - (setq it (aref ,v it-index)) - (if (not ,pred) - (setq it-index -1) - ,@body))))) - -(defun -each-r-while (list pred fn) - "Call FN with every item in reversed LIST while (PRED item) is non-nil. -Return nil, used for side-effects only." - (--each-r-while list (funcall pred it) (funcall fn it))) - -(defmacro --dotimes (num &rest body) - "Repeatedly executes BODY (presumably for side-effects) with symbol `it' bound to integers from 0 through NUM-1." - (declare (debug (form body)) - (indent 1)) - (let ((n (make-symbol "num"))) - `(let ((,n ,num) - (it 0)) - (while (< it ,n) - ,@body - (setq it (1+ it)))))) - -(defun -dotimes (num fn) - "Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1." - (declare (indent 1)) - (--dotimes num (funcall fn it))) - -(defun -map (fn list) - "Return a new list consisting of the result of applying FN to the items in LIST." - (mapcar fn list)) - -(defmacro --map (form list) - "Anaphoric form of `-map'." - (declare (debug (form form))) - `(mapcar (lambda (it) ,form) ,list)) - -(defmacro --reduce-from (form initial-value list) - "Anaphoric form of `-reduce-from'." - (declare (debug (form form form))) - `(let ((acc ,initial-value)) - (--each ,list (setq acc ,form)) - acc)) - -(defun -reduce-from (fn initial-value list) - "Return the result of applying FN to INITIAL-VALUE and the -first item in LIST, then applying FN to that result and the 2nd -item, etc. If LIST contains no items, return INITIAL-VALUE and -do not call FN. - -In the anaphoric form `--reduce-from', the accumulated value is -exposed as symbol `acc'. - -See also: `-reduce', `-reduce-r'" - (--reduce-from (funcall fn acc it) initial-value list)) - -(defmacro --reduce (form list) - "Anaphoric form of `-reduce'." - (declare (debug (form form))) - (let ((lv (make-symbol "list-value"))) - `(let ((,lv ,list)) - (if ,lv - (--reduce-from ,form (car ,lv) (cdr ,lv)) - (let (acc it) ,form))))) - -(defun -reduce (fn list) - "Return the result of applying FN to the first 2 items in LIST, -then applying FN to that result and the 3rd item, etc. If LIST -contains no items, return the result of calling FN with no -arguments. If LIST contains a single item, return that item -and do not call FN. - -In the anaphoric form `--reduce', the accumulated value is -exposed as symbol `acc'. - -See also: `-reduce-from', `-reduce-r'" - (if list - (-reduce-from fn (car list) (cdr list)) - (funcall fn))) - -(defmacro --reduce-r-from (form initial-value list) - "Anaphoric version of `-reduce-r-from'." - (declare (debug (form form form))) - `(--reduce-from ,form ,initial-value (reverse ,list))) - -(defun -reduce-r-from (fn initial-value list) - "Replace conses with FN, nil with INITIAL-VALUE and evaluate -the resulting expression. If LIST is empty, INITIAL-VALUE is -returned and FN is not called. - -Note: this function works the same as `-reduce-from' but the -operation associates from right instead of from left. - -See also: `-reduce-r', `-reduce'" - (--reduce-r-from (funcall fn it acc) initial-value list)) - -(defmacro --reduce-r (form list) - "Anaphoric version of `-reduce-r'." - (declare (debug (form form))) - `(--reduce ,form (reverse ,list))) - -(defun -reduce-r (fn list) - "Replace conses with FN and evaluate the resulting expression. -The final nil is ignored. If LIST contains no items, return the -result of calling FN with no arguments. If LIST contains a single -item, return that item and do not call FN. - -The first argument of FN is the new item, the second is the -accumulated value. - -Note: this function works the same as `-reduce' but the operation -associates from right instead of from left. - -See also: `-reduce-r-from', `-reduce'" - (if list - (--reduce-r (funcall fn it acc) list) - (funcall fn))) - -(defun -reductions-from (fn init list) - "Return a list of the intermediate values of the reduction. - -See `-reduce-from' for explanation of the arguments. - -See also: `-reductions', `-reductions-r', `-reduce-r'" - (nreverse (--reduce-from (cons (funcall fn (car acc) it) acc) (list init) list))) - -(defun -reductions (fn list) - "Return a list of the intermediate values of the reduction. - -See `-reduce' for explanation of the arguments. - -See also: `-reductions-from', `-reductions-r', `-reduce-r'" - (and list (-reductions-from fn (car list) (cdr list)))) - -(defun -reductions-r-from (fn init list) - "Return a list of the intermediate values of the reduction. - -See `-reduce-r-from' for explanation of the arguments. - -See also: `-reductions-r', `-reductions', `-reduce'" - (--reduce-r-from (cons (funcall fn it (car acc)) acc) (list init) list)) - -(defun -reductions-r (fn list) - "Return a list of the intermediate values of the reduction. - -See `-reduce-r' for explanation of the arguments. - -See also: `-reductions-r-from', `-reductions', `-reduce'" - (when list - (let ((rev (reverse list))) - (--reduce-from (cons (funcall fn it (car acc)) acc) - (list (car rev)) - (cdr rev))))) - -(defmacro --filter (form list) - "Anaphoric form of `-filter'. - -See also: `--remove'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list (when ,form (!cons it ,r))) - (nreverse ,r)))) - -(defun -filter (pred list) - "Return a new list of the items in LIST for which PRED returns a non-nil value. - -Alias: `-select' - -See also: `-keep', `-remove'." - (--filter (funcall pred it) list)) - -(defalias '-select '-filter) -(defalias '--select '--filter) - -(defmacro --remove (form list) - "Anaphoric form of `-remove'. - -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' - -See also: `-filter'." - (--remove (funcall pred it) list)) - -(defalias '-reject '-remove) -(defalias '--reject '--remove) - -(defun -remove-first (pred list) - "Return a new list with the first item matching PRED removed. - -Alias: `-reject-first' - -See also: `-remove', `-map-first'" - (let (front) - (while (and list (not (funcall pred (car list)))) - (push (car list) front) - (!cdr list)) - (if list - (-concat (nreverse front) (cdr list)) - (nreverse front)))) - -(defmacro --remove-first (form list) - "Anaphoric form of `-remove-first'." - (declare (debug (form form))) - `(-remove-first (lambda (it) ,form) ,list)) - -(defalias '-reject-first '-remove-first) -(defalias '--reject-first '--remove-first) - -(defun -remove-last (pred list) - "Return a new list with the last item matching PRED removed. - -Alias: `-reject-last' - -See also: `-remove', `-map-last'" - (nreverse (-remove-first pred (reverse list)))) - -(defmacro --remove-last (form list) - "Anaphoric form of `-remove-last'." - (declare (debug (form form))) - `(-remove-last (lambda (it) ,form) ,list)) - -(defalias '-reject-last '-remove-last) -(defalias '--reject-last '--remove-last) - -(defun -remove-item (item list) - "Remove all occurrences of ITEM from LIST. - -Comparison is done with `equal'." - (declare (pure t) (side-effect-free t)) - (--remove (equal it item) list)) - -(defmacro --keep (form list) - "Anaphoric form of `-keep'." - (declare (debug (form form))) - (let ((r (make-symbol "result")) - (m (make-symbol "mapped"))) - `(let (,r) - (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r)))) - (nreverse ,r)))) - -(defun -keep (fn list) - "Return a new list of the non-nil results of applying FN to the items in LIST. - -If you want to select the original items satisfying a predicate use `-filter'." - (--keep (funcall fn it) list)) - -(defun -non-nil (list) - "Return all non-nil elements of LIST." - (declare (pure t) (side-effect-free t)) - (-remove 'null list)) - -(defmacro --map-indexed (form list) - "Anaphoric form of `-map-indexed'." - (declare (debug (form form))) - (let ((r (make-symbol "result"))) - `(let (,r) - (--each ,list - (!cons ,form ,r)) - (nreverse ,r)))) - -(defun -map-indexed (fn list) - "Return a new list consisting of the result of (FN index item) for each item in LIST. - -In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'. - -See also: `-each-indexed'." - (--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) - "Return a new list where the elements in LIST that do not match the PRED function -are unchanged, and where the elements in LIST that do match the PRED function are mapped -through the REP function. - -Alias: `-replace-where' - -See also: `-update-at'" - (--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) - "Replace first item in LIST satisfying PRED with result of REP called on this item. - -See also: `-map-when', `-replace-first'" - (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'." - `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list)) - -(defun -map-last (pred rep list) - "Replace last item in LIST satisfying PRED with result of REP called on this item. - -See also: `-map-when', `-replace-last'" - (nreverse (-map-first pred rep (reverse list)))) - -(defmacro --map-last (pred rep list) - "Anaphoric form of `-map-last'." - `(-map-last (lambda (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." - (--mapcat (funcall fn it) list)) - -(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))) - -(defmacro --iterate (form init n) - "Anaphoric version of `-iterate'." - (declare (debug (form form form))) - `(-iterate (lambda (it) ,form) ,init ,n)) - -(defun -flatten-n (num list) - "Flatten NUM levels of a nested LIST. - -See also: `-flatten'" - (declare (pure t) (side-effect-free t)) - (-last-item (--iterate (--mapcat (-list it) it) list (1+ num)))) - -(defun -concat (&rest lists) - "Return a new list with the concatenation of the elements in the supplied LISTS." - (declare (pure t) (side-effect-free t)) - (apply 'append lists)) - -(defalias '-copy 'copy-sequence - "Create a shallow copy of LIST. - -\(fn LIST)") - -(defun -splice (pred fun list) - "Splice lists generated by FUN in place of elements matching PRED in LIST. - -FUN takes the element matching PRED as input. - -This function can be used as replacement for `,@' in case you -need to splice several lists at marked positions (for example -with keywords). - -See also: `-splice-list', `-insert-at'" - (let (r) - (--each list - (if (funcall pred it) - (let ((new (funcall fun it))) - (--each new (!cons it r))) - (!cons it r))) - (nreverse r))) - -(defmacro --splice (pred form list) - "Anaphoric form of `-splice'." - `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list)) - -(defun -splice-list (pred new-list list) - "Splice NEW-LIST in place of elements matching PRED in LIST. - -See also: `-splice', `-insert-at'" - (-splice pred (lambda (_) new-list) list)) - -(defmacro --splice-list (pred new-list list) - "Anaphoric form of `-splice-list'." - `(-splice-list (lambda (it) ,pred) ,new-list ,list)) - -(defun -cons* (&rest args) - "Make a new list from the elements of ARGS. - -The last 2 members of ARGS are used as the final cons of the -result so if the final member of ARGS is not a list the result is -a dotted list." - (declare (pure t) (side-effect-free t)) - (-reduce-r 'cons 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 ELEMENTS is non nil, append these to the list as well." - (-concat list (list elem) elements)) - -(defmacro --first (form list) - "Anaphoric form of `-first'." - (declare (debug (form form))) - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each-while ,list (not ,n) - (when ,form (setq ,n it))) - ,n))) - -(defun -first (pred list) - "Return the first x in LIST where (PRED x) is non-nil, else nil. - -To get the first item in the list no questions asked, use `car'. - -Alias: `-find'" - (--first (funcall pred it) list)) - -(defalias '-find '-first) -(defalias '--find '--first) - -(defmacro --some (form list) - "Anaphoric form of `-some'." - (declare (debug (form form))) - (let ((n (make-symbol "needle"))) - `(let (,n) - (--each-while ,list (not ,n) - (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'" - (--some (funcall pred it) list)) - -(defalias '-any '-some) -(defalias '--any '--some) - -(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." - (--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'. - -\(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) - -(defalias '-second-item 'cadr - "Return the second item of LIST, or nil if LIST is too short. - -See also: `-third-item'. - -\(fn LIST)") - -(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: `-fourth-item'. - -\(fn LIST)") - -(defun -fourth-item (list) - "Return the fourth item of LIST, or nil if LIST is too short. - -See also: `-fifth-item'." - (declare (pure t) (side-effect-free t)) - (car (cdr (cdr (cdr list))))) - -(defun -fifth-item (list) - "Return the fifth item of LIST, or nil if LIST is too short. - -See also: `-last-item'." - (declare (pure t) (side-effect-free t)) - (car (cdr (cdr (cdr (cdr list)))))) - -(defun -last-item (list) - "Return the last item of LIST, or nil on an empty list." - (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." - (--count (funcall pred it) list)) - -(defun ---truthy? (val) - (declare (pure t) (side-effect-free t)) - (not (null val))) - -(defmacro --any? (form list) - "Anaphoric form of `-any?'." - (declare (debug (form form))) - `(---truthy? (--some ,form ,list))) - -(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'" - (--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) - "Anaphoric form of `-all?'." - (declare (debug (form form))) - (let ((a (make-symbol "all"))) - `(let ((,a t)) - (--each-while ,list ,a (setq ,a ,form)) - (---truthy? ,a)))) - -(defun -all? (pred list) - "Return t if (PRED x) is non-nil for all x in LIST, else nil. - -Alias: `-all-p', `-every?', `-every-p'" - (--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'" - (--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 at least one item of LIST matches PRED and at least one item of LIST does not match PRED. -Return `nil` both if all items match the predicate or if none of the items match the predicate. - -Alias: `-only-some-p'" - (--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) - "Anaphoric form of `-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. - -See also: `-drop-while'" - (--take-while (funcall pred it) list)) - -(defmacro --drop-while (form list) - "Anaphoric form of `-drop-while'." - (declare (debug (form form))) - (let ((l (make-symbol "list"))) - `(let ((,l ,list)) - (--each-while ,l ,form (pop ,l)) - (copy-sequence ,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 a copy of the tail of -LIST starting from its first element for which PRED returns nil. - -See also: `-take-while'" - (--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))) - -(defun -drop (n list) - "Return a copy of the tail of LIST without the first 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-last'" - (copy-sequence (nthcdr 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) - "Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list." - (declare (pure t) (side-effect-free t)) - (let (result) - (--dotimes n - (when list - (!cons (car list) result) - (!cdr list))) - (list (nreverse result) list))) - -(defun -rotate (n list) - "Rotate LIST N places to the right. With N negative, rotate to the left. -The time complexity is O(n)." - (declare (pure t) (side-effect-free t)) - (when list - (let* ((len (length list)) - (n-mod-len (mod n len)) - (new-tail-len (- len n-mod-len))) - (append (-drop 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) - "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`. - -See also: `-map-when'" - (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 form form))) - `(-update-at ,n (lambda (it) ,form) ,list)) - -(defun -remove-at (n list) - "Return a list with element at Nth position in LIST removed. - -See also: `-remove-at-indices', `-remove'" - (declare (pure t) (side-effect-free t)) - (-remove-at-indices (list n) list)) - -(defun -remove-at-indices (indices list) - "Return a list whose elements are elements from LIST without -elements selected as `(nth i list)` for all i -from INDICES. - -See also: `-remove-at', `-remove'" - (declare (pure t) (side-effect-free t)) - (let* ((indices (-sort '< indices)) - (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices)))) - r) - (--each diffs - (let ((split (-split-at it list))) - (!cons (car split) r) - (setq list (cdr (cadr split))))) - (!cons list r) - (apply '-concat (nreverse r)))) - -(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) - "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list." - (--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 (form form))) - `(-split-when (lambda (it) (equal it ,item)) ,list)) - -(defmacro --split-when (form list) - "Anaphoric version of `-split-when'." - (declare (debug (form form))) - `(-split-when (lambda (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'." - (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) - "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list." - (--separate (funcall pred it) list)) - -(defun ---partition-all-in-steps-reversed (n step list) - "Private: Used by -partition-all-in-steps and -partition-in-steps." - (when (< step 1) - (error "Step must be a positive number, or you're looking at some juicy infinite loops.")) - (let ((result nil)) - (while list - (!cons (-take n list) result) - (setq list (-drop step list))) - result)) - -(defun -partition-all-in-steps (n step list) - "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -The last groups may contain less than N items." - (declare (pure t) (side-effect-free t)) - (nreverse (---partition-all-in-steps-reversed n step list))) - -(defun -partition-in-steps (n step list) - "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -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 (---partition-all-in-steps-reversed n step list))) - (while (and result (< (length (car result)) n)) - (!cdr 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." - (--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)." - (--partition-by-header (funcall fn it) list)) - -(defun -partition-after-pred (pred list) - "Partition directly after each time PRED is true on an element of LIST." - (when list - (let ((rest (-partition-after-pred pred - (cdr list)))) - (if (funcall pred (car list)) - ;;split after (car list) - (cons (list (car list)) - rest) - - ;;don't split after (car list) - (cons (cons (car list) - (car rest)) - (cdr rest)))))) - -(defun -partition-before-pred (pred list) - "Partition directly before each time PRED is true on an element of LIST." - (nreverse (-map #'reverse - (-partition-after-pred pred (reverse list))))) - -(defun -partition-after-item (item list) - "Partition directly after each time ITEM appears in LIST." - (-partition-after-pred (lambda (ele) (equal ele item)) - list)) - -(defun -partition-before-item (item list) - "Partition directly before each time ITEM appears in LIST." - (-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'." - (--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) - "Anaphoric form of `-zip-with'. - -The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'." - (declare (debug (form form form))) - (let ((r (make-symbol "result")) - (l1 (make-symbol "list1")) - (l2 (make-symbol "list2"))) - `(let ((,r nil) - (,l1 ,list1) - (,l2 ,list2)) - (while (and ,l1 ,l2) - (let ((it (car ,l1)) - (other (car ,l2))) - (!cons ,form ,r) - (!cdr ,l1) - (!cdr ,l2))) - (nreverse ,r)))) - -(defun -zip-with (fn list1 list2) - "Zip the two lists LIST1 and LIST2 using a function FN. This -function is applied pairwise taking as first argument element of -LIST1 and as second argument element of LIST2 at corresponding -position. - -The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it', -and the elements from LIST2 as symbol `other'." - (--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 elements of each list, and so on. The lengths of the returned -groupings are equal to the length of the shortest input list. - -The return value is always list of lists, which is a difference -from `-zip-pair' which returns a cons-cell in case two input -lists are provided. - -See also: `-zip'" - (declare (pure t) (side-effect-free t)) - (when lists - (let (results) - (while (-none? 'null lists) - (setq results (cons (mapcar 'car lists) results)) - (setq lists (mapcar 'cdr lists))) - (nreverse results)))) - -(defun -zip (&rest lists) - "Zip LISTS together. Group the head of each list, followed by the -second elements of each list, and so on. The lengths of the returned -groupings are equal to the length of the shortest input list. - -If two lists are provided as arguments, return the groupings as a list -of cons cells. Otherwise, return the groupings as a list of lists. - -Use `-zip-lists' if you need the return value to always be a list -of lists. - -Alias: `-zip-pair' - -See also: `-zip-lists'" - (declare (pure t) (side-effect-free t)) - (when lists - (let (results) - (while (-none? 'null lists) - (setq results (cons (mapcar 'car lists) results)) - (setq lists (mapcar 'cdr lists))) - (setq results (nreverse results)) - (if (= (length lists) 2) - ;; to support backward compatibility, return - ;; a cons cell if two lists were provided - (--map (cons (car it) (cadr it)) results) - results)))) - -(defalias '-zip-pair '-zip) - -(defun -zip-fill (fill-value &rest lists) - "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The -lengths of the returned groupings are equal to the length of the -longest input list." - (declare (pure t) (side-effect-free t)) - (apply '-zip (apply '-pad (cons fill-value lists)))) - -(defun -unzip (lists) - "Unzip LISTS. - -This works just like `-zip' 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 the same length). - -Note in particular that calling this on a list of two lists will -return a list of cons-cells such that the above identity works. - -See also: `-zip'" - (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) - "Appends FILL-VALUE to the end of each list in LISTS such that they -will all have the same length." - (let* ((annotations (-annotate 'length lists)) - (n (-max (-map 'car annotations)))) - (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations))) - -(defun -annotate (fn list) - "Return a list of cons cells where each cell is FN applied to each -element of LIST paired with the unmodified element of LIST." - (-zip (-map fn list) list)) - -(defmacro --annotate (form list) - "Anaphoric version of `-annotate'." - (declare (debug (form form))) - `(-annotate (lambda (it) ,form) ,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'" - (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'" - (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))) - -(defun -partial (fn &rest args) - "Take a function FN and fewer than the normal arguments to FN, -and return a fn that takes a variable number of additional ARGS. -When called, the returned function calls FN with ARGS first and -then additional args." - (apply 'apply-partially fn args)) - -(defun -elem-index (elem list) - "Return the index of the first element in the given LIST which -is equal to the query element ELEM, or nil if there is no -such element." - (declare (pure t) (side-effect-free t)) - (car (-elem-indices elem list))) - -(defun -elem-indices (elem list) - "Return the indices of all elements in LIST equal to the query -element ELEM, in ascending order." - (declare (pure t) (side-effect-free t)) - (-find-indices (-partial 'equal elem) list)) - -(defun -find-indices (pred list) - "Return the indices of all elements in LIST satisfying the -predicate PRED, in ascending order." - (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list))) - -(defmacro --find-indices (form list) - "Anaphoric version of `-find-indices'." - (declare (debug (form form))) - `(-find-indices (lambda (it) ,form) ,list)) - -(defun -find-index (pred list) - "Take a predicate PRED and a LIST and return the index of the -first element in the list satisfying the predicate, or nil if -there is no such element. - -See also `-first'." - (car (-find-indices pred list))) - -(defmacro --find-index (form list) - "Anaphoric version of `-find-index'." - (declare (debug (form form))) - `(-find-index (lambda (it) ,form) ,list)) - -(defun -find-last-index (pred list) - "Take a predicate PRED and a LIST and return the index of the -last element in the list satisfying the predicate, or nil if -there is no such element. - -See also `-last'." - (-last-item (-find-indices pred list))) - -(defmacro --find-last-index (form list) - "Anaphoric version of `-find-last-index'." - `(-find-last-index (lambda (it) ,form) ,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--> (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)))) - -(defun -grade-up (comparator list) - "Grade elements of LIST using COMPARATOR relation, yielding a -permutation vector such that applying this permutation to LIST -sorts it in ascending order." - ;; ugly hack to "fix" lack of lexical scope - (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other))))) - (->> (--map-indexed (cons it it-index) list) - (-sort comp) - (-map 'cdr)))) - -(defun -grade-down (comparator list) - "Grade elements of LIST using COMPARATOR relation, yielding a -permutation vector such that applying this permutation to LIST -sorts it in descending order." - ;; ugly hack to "fix" lack of lexical scope - (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it))))) - (->> (--map-indexed (cons it it-index) list) - (-sort comp) - (-map '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--vector-tail (seq start) - "Return the tail of SEQ starting at START." - (cond - ((vectorp seq) - (let* ((re-length (- (length seq) start)) - (re (make-vector re-length 0))) - (--dotimes re-length (aset re it (aref seq (+ it start)))) - re)) - ((stringp seq) - (substring seq start)))) - -(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)) - `(dash--vector-tail ,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 (apply '-zip (-pad 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 - ((symbolp 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 (dash--vector-tail 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 (--map (list (caar it) (cadr it)) (-zip 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 the description of destructuring mechanism." - (declare (doc-string 2) (indent defun) - (debug (&define sexp - [&optional stringp] - [&optional ("interactive" interactive)] - def-body))) - (cond - ((not (consp match-form)) - (signal 'wrong-type-argument "match-form must be a list")) - ;; no destructuring, so just return regular lambda to make things faster - ((-all? 'symbolp match-form) - `(lambda ,match-form ,@body)) - (t - (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 to create the extra bindings to ensure that. - ;; We should find a way to optimize that. Not critical however. - `(lambda ,(--map (cadr it) 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) - (error "Odd number of arguments")) - (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))) - -(defvar -compare-fn nil - "Tests for equality use this function or `equal' if this is nil. -It should only be set using dynamic scope with a let, like: - - (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)") - -(defun -distinct (list) - "Return a new list with all duplicates removed. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil. - -Alias: `-uniq'" - ;; Implementation note: The speedup gained from hash table lookup - ;; starts to outweigh its overhead for lists of length greater than - ;; 32. See discussion in PR #305. - (let* ((len (length list)) - (lut (and (> len 32) - ;; Check that `-compare-fn' is a valid hash-table - ;; lookup function or `nil'. - (memq -compare-fn '(nil equal eq eql)) - (make-hash-table :test (or -compare-fn #'equal) - :size len)))) - (if lut - (--filter (unless (gethash it lut) - (puthash it t lut)) - list) - (--each list (unless (-contains? lut it) (!cons it lut))) - (nreverse lut)))) - -(defalias '-uniq '-distinct) - -(defun -union (list list2) - "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - ;; We fall back to iteration implementation if the comparison - ;; function isn't one of `eq', `eql' or `equal'. - (let* ((result (reverse list)) - ;; TODO: get rid of this dynamic variable, pass it as an - ;; argument instead. - (-compare-fn (if (bound-and-true-p -compare-fn) - -compare-fn - 'equal))) - (if (memq -compare-fn '(eq eql equal)) - (let ((ht (make-hash-table :test -compare-fn))) - (--each list (puthash it t ht)) - (--each list2 (unless (gethash it ht) (!cons it result)))) - (--each list2 (unless (-contains? result it) (!cons it result)))) - (nreverse result))) - -(defun -intersection (list list2) - "Return a new list containing only the elements that are members of both LIST and LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (-contains? list2 it) list)) - -(defun -difference (list list2) - "Return a new list with only the members of LIST that are not in LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (not (-contains? list2 it)) list)) - -(defun -powerset (list) - "Return the power set of LIST." - (if (null list) '(()) - (let ((last (-powerset (cdr list)))) - (append (mapcar (lambda (x) (cons (car list) x)) last) - last)))) - -(defun -permutations (list) - "Return the permutations of LIST." - (if (null list) '(()) - (apply #'append - (mapcar (lambda (x) - (mapcar (lambda (perm) (cons x perm)) - (-permutations (remove x list)))) - list)))) - -(defun -inits (list) - "Return all prefixes of LIST." - (let ((res (list list))) - (setq list (reverse list)) - (while list - (push (reverse (!cdr list)) res)) - res)) - -(defun -tails (list) - "Return all suffixes of LIST" - (-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." - (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's non-nil. - -Alias: `-contains-p'" - (not - (null - (cond - ((null -compare-fn) (member element list)) - ((eq -compare-fn 'eq) (memq element list)) - ((eq -compare-fn 'eql) (memql element list)) - (t - (let ((lst list)) - (while (and lst - (not (funcall -compare-fn element (car lst)))) - (setq lst (cdr lst))) - lst)))))) - -(defalias '-contains-p '-contains?) - -(defun -same-items? (list list2) - "Return true if LIST and LIST2 has the same items. - -The order of the elements in the lists does not matter. - -Alias: `-same-items-p'" - (let ((length-a (length list)) - (length-b (length list2))) - (and - (= length-a length-b) - (= length-a (length (-intersection list list2)))))) - -(defalias '-same-items-p '-same-items?) - -(defun -is-prefix? (prefix list) - "Return non-nil if PREFIX is prefix of LIST. - -Alias: `-is-prefix-p'" - (declare (pure t) (side-effect-free t)) - (--each-while list (equal (car prefix) it) - (!cdr prefix)) - (not prefix)) - -(defun -is-suffix? (suffix list) - "Return non-nil if SUFFIX is suffix of LIST. - -Alias: `-is-suffix-p'" - (declare (pure t) (side-effect-free t)) - (-is-prefix? (reverse suffix) (reverse list))) - -(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." - (sort (copy-sequence list) comparator)) - -(defmacro --sort (form list) - "Anaphoric form of `-sort'." - (declare (debug (form form))) - `(-sort (lambda (it other) ,form) ,list)) - -(defun -list (&rest args) - "Return a list with ARGS. - -If first item of ARGS is already a list, simply return ARGS. If -not, return a list with ARGS as elements." - (declare (pure t) (side-effect-free t)) - (let ((arg (car args))) - (if (listp arg) arg args))) - -(defun -repeat (n x) - "Return a list with X repeated N times. -Return nil if N is less than 1." - (declare (pure t) (side-effect-free t)) - (let (ret) - (--dotimes n (!cons x ret)) - ret)) - -(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)) - (unless (consp list) - (error "LIST must be non-empty")) - (-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)) - (unless (consp list) - (error "LIST must be non-empty")) - (-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." - (--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." - (--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 (form form))) - `(-max-by (lambda (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 (form form))) - `(-min-by (lambda (it other) ,form) ,list)) - -(defun -iterate (fun init n) - "Return a list of iterated applications of FUN to INIT. - -This means a list of form: - - (init (fun init) (fun (fun init)) ...) - -N is the length of the returned list." - (if (= n 0) nil - (let ((r (list init))) - (--dotimes (1- n) - (push (funcall fun (car r)) r)) - (nreverse r)))) - -(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'." - (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'." - `(-fix (lambda (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." - (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 (form form))) - `(-unfold (lambda (it) ,form) ,seed)) - -(defun -cons-pair? (con) - "Return non-nil if CON is true cons pair. -That is (A . B) where B is not a list. - -Alias: `-cons-pair-p'" - (declare (pure t) (side-effect-free t)) - (and (listp con) - (not (listp (cdr con))))) - -(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)) - (cond - ((-cons-pair? val) (-cons-to-list val)) - (t (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." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) - (t (funcall fn tree)))) - -(defmacro --tree-mapreduce-from (form folder init-value tree) - "Anaphoric form of `-tree-mapreduce-from'." - (declare (debug (form form form form))) - `(-tree-mapreduce-from (lambda (it) ,form) (lambda (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." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) - (t (funcall fn tree)))) - -(defmacro --tree-mapreduce (form folder tree) - "Anaphoric form of `-tree-mapreduce'." - (declare (debug (form form form))) - `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree)) - -(defun -tree-map (fn tree) - "Apply FN to each element of TREE while preserving the tree structure." - (cond - ((not tree) nil) - ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (mapcar (lambda (x) (-tree-map fn x)) tree)) - (t (funcall fn tree)))) - -(defmacro --tree-map (form tree) - "Anaphoric form of `-tree-map'." - (declare (debug (form form))) - `(-tree-map (lambda (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." - (cond - ((not tree) nil) - ((-cons-pair? tree) tree) - ((listp tree) - (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) - (t tree))) - -(defmacro --tree-reduce-from (form init-value tree) - "Anaphoric form of `-tree-reduce-from'." - (declare (debug (form form form))) - `(-tree-reduce-from (lambda (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." - (cond - ((not tree) nil) - ((-cons-pair? tree) tree) - ((listp tree) - (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) - (t tree))) - -(defmacro --tree-reduce (form tree) - "Anaphoric form of `-tree-reduce'." - (declare (debug (form form))) - `(-tree-reduce (lambda (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." - (if (funcall pred tree) - (funcall fun tree) - (if (and (listp tree) - (not (-cons-pair? 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'." - `(-tree-map-nodes (lambda (it) ,pred) (lambda (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." - (cons tree - (when (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'." - `(-tree-seq (lambda (it) ,branch) (lambda (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)) - -;;; Font lock - -(defvar dash--keywords - `(;; TODO: Do not fontify the following automatic variables - ;; globally; detect and limit to their local anaphoric scope. - (,(concat "\\_<" (regexp-opt '("acc" "it" "it-index" "other")) "\\_>") - 0 font-lock-variable-name-face) - ;; Elisp macro fontification was static prior to Emacs 25. - ,@(when (< emacs-major-version 25) - (let ((macs '("!cdr" - "!cons" - "-->" - "--all?" - "--annotate" - "--any?" - "--count" - "--dotimes" - "--doto" - "--drop-while" - "--each" - "--each-r" - "--each-r-while" - "--each-while" - "--filter" - "--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?" - "--only-some?" - "--partition-by" - "--partition-by-header" - "--reduce" - "--reduce-from" - "--reduce-r" - "--reduce-r-from" - "--remove" - "--remove-first" - "--remove-last" - "--separate" - "--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->" - "-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") - :group 'dash - :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'." - :group 'dash :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 - :group 'dash) - -(defcustom dash-enable-fontlock nil - "If non-nil, fontify Dash macro calls and special variables." - :group 'dash - :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") - -(provide 'dash) -;;; dash.el ends here diff --git a/elpa/dash-20210101.1712/dash.info b/elpa/dash-20210101.1712/dash.info deleted file mode 100644 index ab669ce9..00000000 --- a/elpa/dash-20210101.1712/dash.info +++ /dev/null @@ -1,3436 +0,0 @@ -This is dash.info, produced by makeinfo version 6.5 from dash.texi. - -This manual is for ‘dash.el’ version 2.12.1. - - Copyright © 2012-2015 Magnar Sveen - - 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 - . -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.el’ version 2.12.1. - - Copyright © 2012-2015 Magnar Sveen - - 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 - . - -* Menu: - -* Installation:: -* Functions:: -* Development:: -* Index:: - -— The Detailed Node Listing — - -Installation - -* Using in a package:: -* Fontification of special variables:: - -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 -* Changes:: List of significant changes by version -* Contributors:: List of contributors - - -File: dash.info, Node: Installation, Next: Functions, Prev: Top, Up: Top - -1 Installation -************** - -It’s available on GNU ELPA (https://elpa.gnu.org/) and MELPA -(https://melpa.org/); use ‘M-x package-install’: - -‘M-x package-install dash’ - Install the dash library. - -‘M-x package-install dash-functional’ - Optional, if you want the function combinators. - - Alternatively, you can just dump dash.el or dash-functional.el in -your load path somewhere. - -* Menu: - -* Using in a package:: -* Fontification of special variables:: - - -File: dash.info, Node: Using in a package, Next: Fontification of special variables, Up: Installation - -1.1 Using in a package -====================== - -Add this to the big comment block at the top: - - ;; Package-Requires: ((dash "2.12.1")) - -To get function combinators: - - ;; Package-Requires: ((dash "2.12.1") (dash-functional "1.2.0") (emacs "24")) - - -File: dash.info, Node: Fontification of special variables, Prev: Using in a package, Up: Installation - -1.2 Fontification of special variables -====================================== - -Font lock of special Dash variables (‘it’, ‘acc’, etc.) in Emacs Lisp -buffers can optionally be enabled with the autoloaded minor mode -‘dash-fontify-mode’. In older Emacs versions which do not dynamically -detect macros, the minor mode also fontifies Dash macro calls. - - 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: Functions, Next: Development, Prev: Installation, Up: Top - -2 Functions -*********** - -This chapter contains reference documentation for the dash application -programming interface (API). All functions and constructs in the library -are prefixed with a dash (-). - - There are also anaphoric versions of functions where that makes -sense, prefixed with two dashes instead of one. - - For instance, while ‘-map’ takes a function to map over the list, one -can also use the anaphoric form with double dashes - which will then be -executed with ‘it’ exposed as the list item. Here’s an example: - - (-map (lambda (n) (* n n)) '(1 2 3 4)) ;; normal version - - (--map (* it it) '(1 2 3 4)) ;; anaphoric version - -Of course, the original can also be written like - - (defun square (n) (* n n)) - - (-map 'square '(1 2 3 4)) - -which demonstrates the usefulness of both versions. - -* 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 new list. - - -- Function: -map (fn list) - Return a new list consisting of the result of applying FN to the - items in LIST. - - (-map (lambda (num) (* num num)) '(1 2 3 4)) - ⇒ '(1 4 9 16) - (-map 'square '(1 2 3 4)) - ⇒ '(1 4 9 16) - (--map (* it it) '(1 2 3 4)) - ⇒ '(1 4 9 16) - - -- Function: -map-when (pred rep list) - Return a new list where the elements in LIST that do not match the - PRED function are unchanged, and where the elements in LIST that do - match the PRED function 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) - Replace first item in LIST satisfying PRED with result of REP - called on this 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) - Replace last item in LIST satisfying PRED with result of REP called - on this 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) - Return a new list consisting of the result of (FN index item) for - each item in LIST. - - In the anaphoric form ‘--map-indexed’, the index is exposed as - symbol ‘it-index’. - - 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) - - -- Function: -annotate (fn list) - Return a list of cons cells where each cell is FN applied to each - element of LIST paired with the unmodified element of LIST. - - (-annotate '1+ '(1 2 3)) - ⇒ '((2 . 1) (3 . 2) (4 . 3)) - (-annotate 'length '(("h" "e" "l" "l" "o") ("hello" "world"))) - ⇒ '((5 "h" "e" "l" "l" "o") (2 "hello" "world")) - (--annotate (< 1 it) '(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 elements matching PRED in - LIST. - - FUN takes the element matching PRED as input. - - This function can be used as replacement for ‘,@’ in case you need - to splice several lists at marked positions (for example with - keywords). - - See also: ‘-splice-list’ (*note -splice-list::), ‘-insert-at’ - (*note -insert-at::) - - (-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) - ⇒ '(1 2 2 3 4 4) - (--splice 't (list it it) '(1 2 3 4)) - ⇒ '(1 1 2 2 3 3 4 4) - (--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar) :magic (baz))) - ⇒ '((foo) (bar) (list of) (magical) (code) (baz)) - - -- 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 (arg) - Create a shallow copy of LIST. - - (fn 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 a - non-nil value. - - Alias: ‘-select’ - - See also: ‘-keep’ (*note -keep::), ‘-remove’ (*note -remove::). - - (-filter (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) - ⇒ '(2 4) - (-filter 'even? '(1 2 3 4)) - ⇒ '(2 4) - (--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’ - - See also: ‘-filter’ (*note -filter::). - - (-remove (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) - ⇒ '(1 3) - (-remove 'even? '(1 2 3 4)) - ⇒ '(1 3) - (--remove (= 0 (% it 2)) '(1 2 3 4)) - ⇒ '(1 3) - - -- Function: -remove-first (pred list) - Return a new list with the first item matching PRED removed. - - Alias: ‘-reject-first’ - - See also: ‘-remove’ (*note -remove::), ‘-map-first’ (*note - -map-first::) - - (-remove-first 'even? '(1 3 5 4 7 8 10)) - ⇒ '(1 3 5 7 8 10) - (-remove-first 'stringp '(1 2 "first" "second" "third")) - ⇒ '(1 2 "second" "third") - (--remove-first (> it 3) '(1 2 3 4 5 6 7 8 9 10)) - ⇒ '(1 2 3 5 6 7 8 9 10) - - -- Function: -remove-last (pred list) - Return a new list with the last item matching PRED removed. - - Alias: ‘-reject-last’ - - See also: ‘-remove’ (*note -remove::), ‘-map-last’ (*note - -map-last::) - - (-remove-last 'even? '(1 3 5 4 7 8 10 11)) - ⇒ '(1 3 5 4 7 8 11) - (-remove-last 'stringp '(1 2 "last" "second" "third")) - ⇒ '(1 2 "last" "second") - (--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) - Remove all occurrences of ITEM from LIST. - - 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" "dave")) - ⇒ '("alice" "eve" "dave") - - -- Function: -non-nil (list) - Return all non-nil elements of LIST. - - (-non-nil '(1 nil 2 nil nil 3 4 nil 5 nil)) - ⇒ '(1 2 3 4 5) - - -- 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)) - ⇒ nil - - -- 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 a copy of the tail of LIST without the first 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-last’ (*note -drop-last::) - - (-drop 3 '(1 2 3 4 5)) - ⇒ '(4 5) - (-drop 17 '(1 2 3 4 5)) - ⇒ nil - (-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)) - ⇒ nil - (-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. - - See also: ‘-drop-while’ (*note -drop-while::) - - (-take-while 'even? '(1 2 3 4)) - ⇒ nil - (-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 a copy of the tail of - LIST starting from its first element for which PRED returns nil. - - 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 the - items in LIST. - - If you want to select the original items satisfying a predicate use - ‘-filter’ (*note -filter::). - - (-keep 'cdr '((1 2 3) (4 5) (6))) - ⇒ '((2 3) (5)) - (-keep (lambda (num) (when (> num 3) (* 10 num))) '(1 2 3 4 5 6)) - ⇒ '(40 50 60) - (--keep (when (> it 3) (* 10 it)) '(1 2 3 4 5 6)) - ⇒ '(40 50 60) - - -- Function: -concat (&rest lists) - Return a new list with the concatenation of the elements in the - supplied LISTS. - - (-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) - Return a list with element at Nth position in LIST replaced with - ‘(func (nth n list))‘. - - 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 a list with element at Nth position in LIST removed. - - See also: ‘-remove-at-indices’ (*note -remove-at-indices::), - ‘-remove’ (*note -remove::) - - (-remove-at 0 '("0" "1" "2" "3" "4" "5")) - ⇒ '("1" "2" "3" "4" "5") - (-remove-at 1 '("0" "1" "2" "3" "4" "5")) - ⇒ '("0" "2" "3" "4" "5") - (-remove-at 2 '("0" "1" "2" "3" "4" "5")) - ⇒ '("0" "1" "3" "4" "5") - - -- Function: -remove-at-indices (indices list) - Return a list whose elements are elements from LIST without - elements selected as ‘(nth i list)‘ for all i from INDICES. - - See also: ‘-remove-at’ (*note -remove-at::), ‘-remove’ (*note - -remove::) - - (-remove-at-indices '(0) '("0" "1" "2" "3" "4" "5")) - ⇒ '("1" "2" "3" "4" "5") - (-remove-at-indices '(0 2 4) '("0" "1" "2" "3" "4" "5")) - ⇒ '("1" "3" "5") - (-remove-at-indices '(0 5) '("0" "1" "2" "3" "4" "5")) - ⇒ '("1" "2" "3" "4") - - -File: dash.info, Node: Reductions, Next: Unfolding, Prev: List to list, Up: Functions - -2.4 Reductions -============== - -Functions reducing lists into single value. - - -- Function: -reduce-from (fn initial-value list) - Return the result of applying FN to INITIAL-VALUE and the first - item in LIST, then applying FN to that result and the 2nd item, - etc. If LIST contains no items, return INITIAL-VALUE and do not - call FN. - - In the anaphoric form ‘--reduce-from’, the accumulated value is - exposed as symbol ‘acc’. - - See also: ‘-reduce’ (*note -reduce::), ‘-reduce-r’ (*note - -reduce-r::) - - (-reduce-from '- 10 '(1 2 3)) - ⇒ 4 - (-reduce-from (lambda (memo item) (format "(%s - %d)" memo item)) "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 initial-value list) - Replace conses with FN, nil with INITIAL-VALUE and evaluate the - resulting expression. If LIST is empty, INITIAL-VALUE is returned - and FN is not called. - - Note: this function works the same as ‘-reduce-from’ (*note - -reduce-from::) but the operation associates from right instead of - from left. - - See also: ‘-reduce-r’ (*note -reduce-r::), ‘-reduce’ (*note - -reduce::) - - (-reduce-r-from '- 10 '(1 2 3)) - ⇒ -8 - (-reduce-r-from (lambda (item memo) (format "(%d - %s)" item memo)) "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) - Return the result of applying FN to the first 2 items in LIST, then - applying FN to that result and the 3rd item, etc. If LIST contains - no items, return the result of calling FN with no arguments. If - LIST contains a single item, return that item and do not call FN. - - In the anaphoric form ‘--reduce’, the accumulated value is exposed - as symbol ‘acc’. - - See also: ‘-reduce-from’ (*note -reduce-from::), ‘-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) - Replace conses with FN and evaluate the resulting expression. The - final nil is ignored. If LIST contains no items, return the result - of calling FN with no arguments. If LIST contains a single item, - return that item and do not call FN. - - The first argument of FN is the new item, the second is the - accumulated value. - - Note: this function works the same as ‘-reduce’ (*note -reduce::) - but the operation associates from right instead of from left. - - See also: ‘-reduce-r-from’ (*note -reduce-r-from::), ‘-reduce’ - (*note -reduce::) - - (-reduce-r '- '(1 2 3 4)) - ⇒ -2 - (-reduce-r (lambda (item memo) (format "%s-%d" memo item)) '(1 2 3)) - ⇒ "3-2-1" - (--reduce-r (format "%s-%d" acc it) '(1 2 3)) - ⇒ "3-2-1" - - -- Function: -reductions-from (fn init list) - Return a list of the intermediate values of the reduction. - - See ‘-reduce-from’ (*note -reduce-from::) for explanation of the - arguments. - - See also: ‘-reductions’ (*note -reductions::), ‘-reductions-r’ - (*note -reductions-r::), ‘-reduce-r’ (*note -reduce-r::) - - (-reductions-from (lambda (a i) (format "(%s FN %d)" a i)) "INIT" '(1 2 3 4)) - ⇒ '("INIT" "(INIT FN 1)" "((INIT FN 1) FN 2)" "(((INIT FN 1) FN 2) FN 3)" "((((INIT FN 1) FN 2) FN 3) FN 4)") - (-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) - - -- Function: -reductions-r-from (fn init list) - Return a list of the intermediate values of the reduction. - - See ‘-reduce-r-from’ (*note -reduce-r-from::) for explanation of - the arguments. - - See also: ‘-reductions-r’ (*note -reductions-r::), ‘-reductions’ - (*note -reductions::), ‘-reduce’ (*note -reduce::) - - (-reductions-r-from (lambda (i a) (format "(%d FN %s)" i a)) "INIT" '(1 2 3 4)) - ⇒ '("(1 FN (2 FN (3 FN (4 FN INIT))))" "(2 FN (3 FN (4 FN INIT)))" "(3 FN (4 FN INIT))" "(4 FN INIT)" "INIT") - (-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) - - -- Function: -reductions (fn list) - Return a list of the intermediate values of the reduction. - - See ‘-reduce’ (*note -reduce::) for explanation of the arguments. - - See also: ‘-reductions-from’ (*note -reductions-from::), - ‘-reductions-r’ (*note -reductions-r::), ‘-reduce-r’ (*note - -reduce-r::) - - (-reductions (lambda (a i) (format "(%s FN %d)" a i)) '(1 2 3 4)) - ⇒ '(1 "(1 FN 2)" "((1 FN 2) FN 3)" "(((1 FN 2) FN 3) FN 4)") - (-reductions '+ '(1 2 3 4)) - ⇒ '(1 3 6 10) - (-reductions '* '(1 2 3 4)) - ⇒ '(1 2 6 24) - - -- Function: -reductions-r (fn list) - Return a list of the intermediate values of the reduction. - - See ‘-reduce-r’ (*note -reduce-r::) for explanation of the - arguments. - - See also: ‘-reductions-r-from’ (*note -reductions-r-from::), - ‘-reductions’ (*note -reductions::), ‘-reduce’ (*note -reduce::) - - (-reductions-r (lambda (i a) (format "(%d FN %s)" i a)) '(1 2 3 4)) - ⇒ '("(1 FN (2 FN (3 FN 4)))" "(2 FN (3 FN 4))" "(3 FN 4)" 4) - (-reductions-r '+ '(1 2 3 4)) - ⇒ '(10 9 7 4) - (-reductions-r '* '(1 2 3 4)) - ⇒ '(24 24 12 4) - - -- 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 - - -- 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 - - -- 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)) - ⇒ nil - (-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)) - ⇒ nil - (-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) - - -File: dash.info, Node: Unfolding, Next: Predicates, Prev: Reductions, Up: Functions - -2.5 Unfolding -============= - -Operations dual to reductions, building lists from 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 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)) - - -File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Functions - -2.6 Predicates -============== - - -- 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? 'even? '(1 2 3)) - ⇒ t - (-any? 'even? '(1 3 5)) - ⇒ 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. - - Alias: ‘-all-p’, ‘-every?’, ‘-every-p’ - - (-all? 'even? '(1 2 3)) - ⇒ nil - (-all? 'even? '(2 4 6)) - ⇒ t - (--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 at least one item of LIST matches PRED and at least - one item of LIST does not match PRED. Return ‘nil‘ both if all - items match the predicate or if none of the items match the - predicate. - - 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’s non-nil. - - Alias: ‘-contains-p’ - - (-contains? '(1 2 3) 1) - ⇒ t - (-contains? '(1 2 3) 2) - ⇒ t - (-contains? '(1 2 3) 4) - ⇒ nil - - -- Function: -same-items? (list list2) - Return true if LIST and LIST2 has the same items. - - The order of the elements in the lists does not matter. - - Alias: ‘-same-items-p’ - - (-same-items? '(1 2 3) '(1 2 3)) - ⇒ t - (-same-items? '(1 2 3) '(3 2 1)) - ⇒ t - (-same-items? '(1 2 3) '(1 2 3 4)) - ⇒ nil - - -- Function: -is-prefix? (prefix list) - Return non-nil if PREFIX is 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 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 - - -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) - Return a list of ((-take N LIST) (-drop N LIST)), in no more than - one pass through the list. - - (-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) - - -- Function: -split-with (pred list) - Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), - in no more than one pass through the 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) - Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one - pass through the 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) - Return a new list with the items in LIST grouped into N-sized - sublists at offsets STEP apart. 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) - Return a new list with the items in LIST grouped into N-sized - sublists at offsets STEP apart. The last 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 directly after each time PRED is true on an element of - LIST. - - (-partition-after-pred #'odd? '()) - ⇒ '() - (-partition-after-pred #'odd? '(1)) - ⇒ '((1)) - (-partition-after-pred #'odd? '(0 1)) - ⇒ '((0 1)) - - -- Function: -partition-before-pred (pred list) - Partition directly before each time PRED is true on an element of - LIST. - - (-partition-before-pred #'odd? '()) - ⇒ '() - (-partition-before-pred #'odd? '(1)) - ⇒ '((1)) - (-partition-before-pred #'odd? '(0 1)) - ⇒ '((0) (1)) - - -- 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 -============ - -Return indices of elements based on predicates, sort elements by indices -etc. - - -- Function: -elem-index (elem list) - Return the index of the first element in the given LIST which is - equal to the query element ELEM, or nil if there is no such - element. - - (-elem-index 2 '(6 7 8 2 3 4)) - ⇒ 3 - (-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 indices of all elements in LIST equal to the query - element ELEM, in ascending order. - - (-elem-indices 2 '(6 7 8 2 3 4 2 1)) - ⇒ '(3 6) - (-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) - Take a predicate PRED and a LIST and return the index of the first - element in the list satisfying the predicate, or nil if there is no - such element. - - See also ‘-first’ (*note -first::). - - (-find-index 'even? '(2 4 1 6 3 3 5 8)) - ⇒ 0 - (--find-index (< 5 it) '(2 4 1 6 3 3 5 8)) - ⇒ 3 - (-find-index (-partial 'string-lessp "baz") '("bar" "foo" "baz")) - ⇒ 1 - - -- Function: -find-last-index (pred list) - Take a predicate PRED and a LIST and return the index of the last - element in the list satisfying the predicate, or nil if there is no - such element. - - See also ‘-last’ (*note -last::). - - (-find-last-index 'even? '(2 4 1 6 3 3 5 8)) - ⇒ 7 - (--find-last-index (< 5 it) '(2 7 1 6 3 8 5 2)) - ⇒ 5 - (-find-last-index (-partial 'string-lessp "baz") '("q" "foo" "baz")) - ⇒ 1 - - -- Function: -find-indices (pred list) - Return the indices of all elements in LIST satisfying the predicate - PRED, in ascending order. - - (-find-indices 'even? '(2 4 1 6 3 3 5 8)) - ⇒ '(0 1 3 7) - (--find-indices (< 5 it) '(2 4 1 6 3 3 5 8)) - ⇒ '(3 7) - (-find-indices (-partial 'string-lessp "baz") '("bar" "foo" "baz")) - ⇒ '(1) - - -- Function: -grade-up (comparator list) - Grade elements of LIST using COMPARATOR relation, yielding 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, yielding 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 (list list2) - Return a new list containing the elements of LIST and elements of - LIST2 that are not in LIST. The test for equality is done with - ‘equal’, or with ‘-compare-fn’ if that’s non-nil. - - (-union '(1 2 3) '(3 4 5)) - ⇒ '(1 2 3 4 5) - (-union '(1 2 3 4) '()) - ⇒ '(1 2 3 4) - (-union '(1 1 2 2) '(3 2 1)) - ⇒ '(1 1 2 2 3) - - -- Function: -difference (list list2) - Return a new list with only the members of LIST that are not in - LIST2. The test for equality is done with ‘equal’, or with - ‘-compare-fn’ if that’s 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 (list list2) - Return a new list containing only the elements that are members of - both LIST and LIST2. The test for equality is done with ‘equal’, - or with ‘-compare-fn’ if that’s non-nil. - - (-intersection '() '()) - ⇒ '() - (-intersection '(1 2 3) '(4 5 6)) - ⇒ '() - (-intersection '(1 2 3 4) '(3 4 5 6)) - ⇒ '(3 4) - - -- Function: -powerset (list) - Return the power set of LIST. - - (-powerset '()) - ⇒ '(nil) - (-powerset '(x y z)) - ⇒ '((x y z) (x y) (x z) (x) (y z) (y) (z) nil) - - -- Function: -permutations (list) - Return the permutations of LIST. - - (-permutations '()) - ⇒ '(nil) - (-permutations '(1 2)) - ⇒ '((1 2) (2 1)) - (-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 new list with all duplicates removed. The test for - equality is done with ‘equal’, or with ‘-compare-fn’ if that’s - non-nil. - - Alias: ‘-uniq’ - - (-distinct '()) - ⇒ '() - (-distinct '(1 2 2 4)) - ⇒ '(1 2 4) - (-distinct '(t t t)) - ⇒ '(t) - - -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. With N negative, rotate to the - left. 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: -repeat (n x) - Return a list with X repeated N times. Return nil if N is less - than 1. - - (-repeat 3 :a) - ⇒ '(:a :a :a) - (-repeat 1 :a) - ⇒ '(:a) - (-repeat 0 :a) - ⇒ nil - - -- Function: -cons* (&rest args) - Make a new list from the elements of ARGS. - - The last 2 members of ARGS are used as the final cons of the result - so if the final member of ARGS is not a list the result is a dotted - list. - - (-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 ELEMENTS is non nil, append these 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: -zip-with (fn list1 list2) - Zip the two lists LIST1 and LIST2 using a function FN. This - function is applied pairwise taking as first argument element of - LIST1 and as second argument element of LIST2 at corresponding - position. - - The anaphoric form ‘--zip-with’ binds the elements from LIST1 as - symbol ‘it’, and the elements from LIST2 as symbol ‘other’. - - (-zip-with '+ '(1 2 3) '(4 5 6)) - ⇒ '(5 7 9) - (-zip-with 'cons '(1 2 3) '(4 5 6)) - ⇒ '((1 . 4) (2 . 5) (3 . 6)) - (--zip-with (concat it " and " other) '("Batman" "Jekyll") '("Robin" "Hyde")) - ⇒ '("Batman and Robin" "Jekyll and Hyde") - - -- Function: -zip (&rest lists) - Zip LISTS together. Group the head of each list, followed by the - second elements of each list, and so on. The lengths of the - returned groupings are equal to the length of the shortest input - list. - - If two lists are provided as arguments, return the groupings as a - list of cons cells. Otherwise, return the groupings as a list of - lists. - - Use ‘-zip-lists’ (*note -zip-lists::) if you need the return value - to always be a list of lists. - - Alias: ‘-zip-pair’ - - See also: ‘-zip-lists’ (*note -zip-lists::) - - (-zip '(1 2 3) '(4 5 6)) - ⇒ '((1 . 4) (2 . 5) (3 . 6)) - (-zip '(1 2 3) '(4 5 6 7)) - ⇒ '((1 . 4) (2 . 5) (3 . 6)) - (-zip '(1 2) '(3 4 5) '(6)) - ⇒ '((1 3 6)) - - -- Function: -zip-lists (&rest lists) - Zip LISTS together. Group the head of each list, followed by the - second elements of each list, and so on. The lengths of the - returned groupings are equal to the length of the shortest input - list. - - The return value is always list of lists, which is a difference - from ‘-zip-pair’ which returns a cons-cell in case two input lists - are provided. - - See also: ‘-zip’ (*note -zip::) - - (-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-fill (fill-value &rest lists) - Zip LISTS, with FILL-VALUE padded onto the shorter lists. The - lengths of the returned groupings are equal to the length of the - longest input list. - - (-zip-fill 0 '(1 2 3 4 5) '(6 7 8 9)) - ⇒ '((1 . 6) (2 . 7) (3 . 8) (4 . 9) (5 . 0)) - - -- Function: -unzip (lists) - Unzip LISTS. - - This works just like ‘-zip’ (*note -zip::) 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 the same length). - - Note in particular that calling this on a list of two lists will - return a list of cons-cells such that the above identity works. - - See also: ‘-zip’ (*note -zip::) - - (-unzip (-zip '(1 2 3) '(a b c) '("e" "f" "g"))) - ⇒ '((1 2 3) (a b c) ("e" "f" "g")) - (-unzip '((1 2) (3 4) (5 6) (7 8) (9 10))) - ⇒ '((1 3 5 7 9) (2 4 6 8 10)) - (-unzip '((1 2) (3 4))) - ⇒ '((1 . 3) (2 . 4)) - - -- 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 (-cycle '(1 2 3)) '(1 2)) - ⇒ '((1 . 1) (2 . 2)) - - -- Function: -pad (fill-value &rest lists) - Appends FILL-VALUE to the end of each list in LISTS such that they - will all have the same length. - - (-pad 0 '()) - ⇒ '(nil) - (-pad 0 '(1)) - ⇒ '((1)) - (-pad 0 '(1 2 3) '(4 5)) - ⇒ '((1 2 3) (4 5 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 x in LIST where (PRED x) is non-nil, else nil. - - To get the first item in the list no questions asked, use ‘car’. - - Alias: ‘-find’ - - (-first 'even? '(1 2 3)) - ⇒ 2 - (-first 'even? '(1 3 5)) - ⇒ nil - (-first 'null '(1 3 5)) - ⇒ nil - - -- Function: -some (pred list) - Return (PRED x) for the first LIST item where (PRED x) is non-nil, - else nil. - - Alias: ‘-any’ - - (-some 'even? '(1 2 3)) - ⇒ t - (-some 'null '(1 2 3)) - ⇒ nil - (-some 'null '(1 2 nil)) - ⇒ t - - -- 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::). - - (fn LIST) - - (-first-item '(1 2 3)) - ⇒ 1 - (-first-item nil) - ⇒ nil - (let ((list (list 1 2 3))) (setf (-first-item list) 5) list) - ⇒ '(5 2 3) - - -- Function: -second-item (arg1) - Return the second item of LIST, or nil if LIST is too short. - - See also: ‘-third-item’ (*note -third-item::). - - (fn LIST) - - (-second-item '(1 2 3)) - ⇒ 2 - (-second-item nil) - ⇒ nil - - -- Function: -third-item (arg1) - Return the third item of LIST, or nil if LIST is too short. - - See also: ‘-fourth-item’ (*note -fourth-item::). - - (fn LIST) - - (-third-item '(1 2 3)) - ⇒ 3 - (-third-item nil) - ⇒ nil - - -- Function: -fourth-item (list) - Return the fourth item of LIST, or nil if LIST is too short. - - See also: ‘-fifth-item’ (*note -fifth-item::). - - (-fourth-item '(1 2 3 4)) - ⇒ 4 - (-fourth-item nil) - ⇒ nil - - -- Function: -fifth-item (list) - Return the fifth item of LIST, or nil if LIST is too short. - - See also: ‘-last-item’ (*note -last-item::). - - (-fifth-item '(1 2 3 4 5)) - ⇒ 5 - (-fifth-item nil) - ⇒ nil - - -- Function: -last-item (list) - Return the last item of LIST, or nil on an empty list. - - (-last-item '(1 2 3)) - ⇒ 3 - (-last-item nil) - ⇒ nil - (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 (&rest args) - Return a list with ARGS. - - If first item of ARGS is already a list, simply return ARGS. If - not, return a list with ARGS as elements. - - (-list 1) - ⇒ '(1) - (-list 1 2 3) - ⇒ '(1 2 3) - (-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 4 5 6))) - ⇒ '((1) (2) (3) (4) (5) (6)) - (let ((data '(("starwars" "scifi") ("jedi" "starwars" "warrior")))) (--fix (-uniq (--mapcat (cons it (cdr (assoc it data))) 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) "}" '((elips-mode (foo (bar . booze)) (baz . qux)) (c-mode (foo . bla) (bum . bam))))) - ⇒ "{elips-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 '(1 2 3)) (b (-clone a))) (nreverse a) b) - ⇒ '(1 2 3) - - -File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions - -2.12 Threading macros -===================== - - -- 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--> (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--> "def" (concat "abc" it "ghi")) - ⇒ "abcdefghi" - (-some--> nil (concat "abc" it "ghi")) - ⇒ nil - (-some--> '(1 3 5) (-filter 'even? it) (append it it) (-map 'square it)) - ⇒ nil - - -File: dash.info, Node: Binding, Next: Side-effects, Prev: Threading macros, Up: Functions - -2.13 Binding -============ - -Convenient versions of ‘let‘ and ‘let*‘ constructs combined with 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::). - - (fn (VAR VAL) &rest BODY) - - (-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::). - - (fn (VAR VAL) THEN &rest ELSE) - - (-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 the description of 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 (&rest forms) - 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. - - (fn [MATCH-FORM VAL]...) - - (progn (-setq a 1) a) - ⇒ 1 - (progn (-setq (a b) (list 1 2)) (list a b)) - ⇒ '(1 2) - (progn (-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 with every item in LIST. Return nil, used for side-effects - only. - - (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item s))))) - ⇒ nil - (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item s)))) s) - ⇒ '(3 2 1) - (let (s) (--each '(1 2 3) (setq s (cons it s))) s) - ⇒ '(3 2 1) - - -- Function: -each-while (list pred fn) - Call FN with every item in LIST while (PRED item) is non-nil. - Return nil, used for side-effects only. - - (let (s) (-each-while '(2 4 5 6) 'even? (lambda (item) (push item s))) s) - ⇒ '(4 2) - (let (s) (--each-while '(1 2 3 4) (< it 3) (push it s)) s) - ⇒ '(2 1) - (let ((s 0)) (--each-while '(1 3 4 5) (odd? it) (setq s (+ s it))) s) - ⇒ 4 - - -- Function: -each-indexed (list fn) - Call (FN index item) for each item in LIST. - - In the anaphoric form ‘--each-indexed’, the index is exposed as - symbol ‘it-index’. - - See also: ‘-map-indexed’ (*note -map-indexed::). - - (let (s) (-each-indexed '(a b c) (lambda (index item) (setq s (cons (list item index) s)))) s) - ⇒ '((c 2) (b 1) (a 0)) - (let (s) (--each-indexed '(a b c) (setq s (cons (list it it-index) s))) s) - ⇒ '((c 2) (b 1) (a 0)) - - -- Function: -each-r (list fn) - Call FN with every item in LIST in reversed order. Return nil, - used for side-effects only. - - (let (s) (-each-r '(1 2 3) (lambda (item) (setq s (cons item s))))) - ⇒ nil - (let (s) (-each-r '(1 2 3) (lambda (item) (setq s (cons item s)))) s) - ⇒ '(1 2 3) - (let (s) (--each-r '(1 2 3) (setq s (cons it s))) s) - ⇒ '(1 2 3) - - -- Function: -each-r-while (list pred fn) - Call FN with every item in reversed LIST while (PRED item) is - non-nil. Return nil, used for side-effects only. - - (let (s) (-each-r-while '(2 4 5 6) 'even? (lambda (item) (!cons item s))) s) - ⇒ '(6) - (let (s) (--each-r-while '(1 2 3 4) (>= it 3) (!cons it s)) s) - ⇒ '(3 4) - - -- Function: -dotimes (num fn) - Repeatedly calls FN (presumably for side-effects) passing in - integers from 0 through NUM-1. - - (let (s) (-dotimes 3 (lambda (n) (!cons n s))) s) - ⇒ '(2 1 0) - (let (s) (--dotimes 5 (!cons it s)) s) - ⇒ '(4 3 2 1 0) - - -- Macro: -doto (eval-initial-value &rest forms) - Eval a form, then insert that form as the 2nd argument to other - forms. The EVAL-INITIAL-VALUE form is evaluated once. Its result - is passed to FORMS, which are then evaluated sequentially. Returns - the target form. - - (-doto '(1 2 3) (!cdr) (!cdr)) - ⇒ '(3) - (-doto '(1 . 2) (setcar 3) (setcdr 4)) - ⇒ '(3 . 4) - - -- Macro: --doto (eval-initial-value &rest forms) - Anaphoric form of ‘-doto’ (*note -doto::). Note: ‘it’ is not - required in each form. - - (gethash "key" (--doto (make-hash-table :test 'equal) (puthash "key" "value" it))) - ⇒ "value" - - -File: dash.info, Node: Destructive operations, Next: Function combinators, Prev: Side-effects, Up: Functions - -2.15 Destructive operations -=========================== - - -- 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 -========================= - -These combinators require Emacs 24 for its lexical scope. So they are -offered in a separate package: ‘dash-functional‘. - - -- Function: -partial (fn &rest args) - Take a function FN and fewer than the normal arguments to FN, and - return a fn that takes a variable number of additional ARGS. When - called, the returned function calls FN with ARGS first and then - additional args. - - (funcall (-partial '- 5) 3) - ⇒ 2 - (funcall (-partial '+ 5 2) 3) - ⇒ 10 - - -- Function: -rpartial (fn &rest args) - Takes a function FN and fewer than the normal arguments to FN, and - returns a fn that takes a variable number of additional ARGS. When - called, the returned function calls FN with the additional args - first and then ARGS. - - (funcall (-rpartial '- 5) 8) - ⇒ 3 - (funcall (-rpartial '- 5 2) 10) - ⇒ 3 - - -- Function: -juxt (&rest fns) - Takes a list of functions and returns a fn that is the - juxtaposition of those fns. The returned fn takes a variable - number of args, and returns a list containing the result of - applying each fn to the args (left-to-right). - - (funcall (-juxt '+ '-) 3 5) - ⇒ '(8 -2) - (-map (-juxt 'identity 'square) '(1 2 3)) - ⇒ '((1 1) (2 4) (3 9)) - - -- Function: -compose (&rest fns) - Takes a list of functions and returns a fn that is the composition - of those fns. The returned fn takes a variable number of - arguments, and returns the result of applying each fn to the result - of applying the previous fn to the arguments (right-to-left). - - (funcall (-compose 'square '+) 2 3) - ⇒ (square (+ 2 3)) - (funcall (-compose 'identity 'square) 3) - ⇒ (square 3) - (funcall (-compose 'square 'identity) 3) - ⇒ (square 3) - - -- Function: -applify (fn) - Changes an n-arity function FN to a 1-arity function that expects a - list with n items as arguments - - (-map (-applify '+) '((1 1 1) (1 2 3) (5 5 5))) - ⇒ '(3 6 15) - (-map (-applify (lambda (a b c) `(,a (,b (,c))))) '((1 1 1) (1 2 3) (5 5 5))) - ⇒ '((1 (1 (1))) (1 (2 (3))) (5 (5 (5)))) - (funcall (-applify '<) '(3 6)) - ⇒ t - - -- Function: -on (operator transformer) - Return a function of two arguments that first applies TRANSFORMER - to each of them and then applies OPERATOR on the results (in the - same order). - - In types: (b -> b -> c) -> (a -> b) -> a -> a -> c - - (-sort (-on '< 'length) '((1 2 3) (1) (1 2))) - ⇒ '((1) (1 2) (1 2 3)) - (-min-by (-on '> 'length) '((1 2 3) (4) (1 2))) - ⇒ '(4) - (-min-by (-on 'string-lessp 'number-to-string) '(2 100 22)) - ⇒ 22 - - -- Function: -flip (func) - Swap the order of arguments for binary function FUNC. - - In types: (a -> b -> c) -> b -> a -> c - - (funcall (-flip '<) 2 1) - ⇒ t - (funcall (-flip '-) 3 8) - ⇒ 5 - (-sort (-flip '<) '(4 3 6 1)) - ⇒ '(6 4 3 1) - - -- 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 - (-map (-const 1) '("a" "b" "c" "d")) - ⇒ '(1 1 1 1) - (-sum (-map (-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 'list 'vector 'string)) - ⇒ '((1 2 3) [1 2 3] "") - - -- Function: -not (pred) - Take a unary predicate PRED and return a unary predicate that - returns t if PRED returns nil and nil if PRED returns non-nil. - - (funcall (-not 'even?) 5) - ⇒ t - (-filter (-not (-partial '< 4)) '(1 2 3 4 5 6 7 8)) - ⇒ '(1 2 3 4) - - -- Function: -orfn (&rest preds) - Take list of unary predicates PREDS and return a unary predicate - with argument x that returns non-nil if at least one of the PREDS - returns non-nil on x. - - In types: [a -> Bool] -> a -> Bool - - (-filter (-orfn 'even? (-partial (-flip '<) 5)) '(1 2 3 4 5 6 7 8 9 10)) - ⇒ '(1 2 3 4 6 8 10) - (funcall (-orfn 'stringp 'even?) "foo") - ⇒ t - - -- Function: -andfn (&rest preds) - Take list of unary predicates PREDS and return a unary predicate - with argument x that returns non-nil if all of the PREDS returns - non-nil on x. - - In types: [a -> Bool] -> a -> Bool - - (funcall (-andfn (-cut < <> 10) 'even?) 6) - ⇒ t - (funcall (-andfn (-cut < <> 10) 'even?) 12) - ⇒ nil - (-filter (-andfn (-not 'even?) (-cut >= 5 <>)) '(1 2 3 4 5 6 7 8 9 10)) - ⇒ '(1 3 5) - - -- 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-equal) 0.7) - ⇒ 0.7390851332151607 - (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) - ⇒ 1.8555845286409378 - (funcall (-fixfn 'sin 'approx-equal) 0.1) - ⇒ '(halted . t) - - -- Function: -prodfn (&rest fns) - Take a list of n functions and return a function that takes a list - of length n, applying i-th function to i-th 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) (7 8))) - ⇒ '((2 1) (4 3) (6 5) (8 7)) - (apply '+ (funcall (-prodfn 'length 'string-to-number) '((1 2 3) "15"))) - ⇒ 18 - - -File: dash.info, Node: Development, Next: Index, Prev: Functions, Up: Top - -3 Development -************* - -The dash repository is hosted on GitHub: - - -* Menu: - -* Contribute:: How to contribute -* Changes:: List of significant changes by version -* Contributors:: List of contributors - - -File: dash.info, Node: Contribute, Next: Changes, Up: Development - -3.1 Contribute -============== - -Yes, please do. Pure functions in the list manipulation realm only, -please. There’s a suite of tests in dev/examples.el, so remember to add -tests for your function, or it might get broken later. - - Run the tests with ‘./run-tests.sh’. Create the docs with -‘./create-docs.sh’. I highly recommend that you install these as a -pre-commit hook, so that the tests are always running and the docs are -always in sync: - -cp pre-commit.sh .git/hooks/pre-commit - - Oh, and don’t edit ‘README.md’ directly, it is auto-generated. -Change ‘readme-template.md’ or ‘examples-to-docs.el’ instead. The same -goes for the info manual. - - -File: dash.info, Node: Changes, Next: Contributors, Prev: Contribute, Up: Development - -3.2 Changes -=========== - -Changes in 2.10: - - • Add ‘-let’ destructuring to ‘-if-let’ and ‘-when-let’ (Fredrik - Bergroth) - -Changes in 2.9: - - • Add ‘-let’, ‘-let*’ and ‘-lambda’ with destructuring - • Add ‘-tree-seq’ and ‘-tree-map-nodes’ - • Add ‘-non-nil’ - • Add ‘-fix’ - • Add ‘-fixfn’ (dash-functional 1.2) - • Add ‘-copy’ (Wilfred Hughes) - -Changes in 2.8: - - • Add ‘-butlast’ - -Changes in 2.7: - - • ‘-zip’ now supports more than two lists (Steve Lamb) - • Add ‘-cycle’, ‘-pad’, ‘-annotate’, ‘-zip-fill’ (Steve Lamb) - • Add ‘-table’, ‘-table-flat’ (finite cartesian product) - • Add ‘-flatten-n’ - • ‘-slice’ now supports "step" argument - • Add functional combinators ‘-iteratefn’, ‘-prodfn’ - • Add ‘-replace’, ‘-splice’, ‘-splice-list’ which generalize - ‘-replace-at’ and ‘-insert-at’ - • Add ‘-compose’, ‘-iteratefn’ and ‘-prodfn’ (dash-functional 1.1) - -Changes in 2.6: - - • Add ‘-is-prefix-p’, ‘-is-suffix-p’, ‘-is-infix-p’ (Matus Goljer) - • Add ‘-iterate’, ‘-unfold’ (Matus Goljer) - • Add ‘-split-on’, ‘-split-when’ (Matus Goljer) - • Add ‘-find-last-index’ (Matus Goljer) - • Add ‘-list’ (Johan Andersson) - -Changes in 2.5: - - • Add ‘-same-items?’ (Johan Andersson) - • A few bugfixes - -Changes in 2.4: - - • Add ‘-snoc’ (Matus Goljer) - • Add ‘-replace-at’, ‘-update-at’, ‘-remove-at’, and - ‘-remove-at-indices’ (Matus Goljer) - -Changes in 2.3: - - • Add tree operations (Matus Goljer) - • Make font-lock optional - -Changes in 2.2: - - • Add ‘-compose’ (Christina Whyte) - -Changes in 2.1: - - • Add indexing operations (Matus Goljer) - -Changes in 2.0: - - • Split out ‘dash-functional.el’ (Matus Goljer) - • Add ‘-andfn’, ‘-orfn’, ‘-not’, ‘-cut’, ‘-const’, ‘-flip’ and ‘-on’. - (Matus Goljer) - • Fix ‘-min’, ‘-max’, ‘-min-by’ and ‘-max-by’ (Matus Goljer) - -Changes in 1.8: - - • Add ‘-first-item’ and ‘-last-item’ (Wilfred Hughes) - -Changes in 1.7: - - • Add ‘-rotate’ (Matus Goljer) - -Changes in 1.6: - - • Add ‘-min’, ‘-max’, ‘-min-by’ and ‘-max-by’ (Johan Andersson) - -Changes in 1.5: - - • Add ‘-sum’ and ‘-product’ (Johan Andersson) - -Changes in 1.4: - - • Add ‘-sort’ - • Add ‘-reduce-r’ (Matus Goljer) - • Add ‘-reduce-r-from’ (Matus Goljer) - -Changes in 1.3: - - • Add ‘-partition-in-steps’ - • Add ‘-partition-all-in-steps’ - -Changes in 1.2: - - • Add ‘-last’ (Matus Goljer) - • Add ‘-insert-at’ (Emanuel Evans) - • Add ‘-when-let’ and ‘-if-let’ (Emanuel Evans) - • Add ‘-when-let*’ and ‘-if-let*’ (Emanuel Evans) - • Some bugfixes - - -File: dash.info, Node: Contributors, Prev: Changes, Up: Development - -3.3 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 an n-ary version of ‘-zip’. - • Fredrik Bergroth (https://github.com/fbergroth) made the ‘-if-let’ - family use ‘-let’ destructuring and improved script for generating - documentation. - • Mark Oteiza (https://github.com/holomorph) contributed 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. - - Thanks! - - -File: dash.info, Node: Index, Prev: Development, Up: Top - -Index -***** - -[index] -* Menu: - -* !cdr: Destructive operations. - (line 14) -* !cons: Destructive operations. - (line 6) -* -->: Threading macros. (line 32) -* --doto: Side-effects. (line 83) -* ->: Threading macros. (line 6) -* ->>: Threading macros. (line 19) -* -all?: Predicates. (line 18) -* -andfn: Function combinators. - (line 138) -* -annotate: Maps. (line 79) -* -any?: Predicates. (line 6) -* -applify: Function combinators. - (line 55) -* -as->: Threading macros. (line 46) -* -butlast: Other list operations. - (line 340) -* -clone: Tree operations. (line 122) -* -common-prefix: Reductions. (line 223) -* -common-suffix: Reductions. (line 233) -* -compose: Function combinators. - (line 42) -* -concat: List to list. (line 22) -* -cons*: Other list operations. - (line 30) -* -const: Function combinators. - (line 92) -* -contains?: Predicates. (line 57) -* -copy: Maps. (line 134) -* -count: Reductions. (line 151) -* -cut: Function combinators. - (line 104) -* -cycle: Other list operations. - (line 168) -* -difference: Set operations. (line 20) -* -distinct: Set operations. (line 62) -* -dotimes: Side-effects. (line 63) -* -doto: Side-effects. (line 72) -* -drop: Sublist selection. (line 128) -* -drop-last: Sublist selection. (line 142) -* -drop-while: Sublist selection. (line 171) -* -each: Side-effects. (line 8) -* -each-indexed: Side-effects. (line 30) -* -each-r: Side-effects. (line 43) -* -each-r-while: Side-effects. (line 54) -* -each-while: Side-effects. (line 19) -* -elem-index: Indexing. (line 9) -* -elem-indices: Indexing. (line 21) -* -fifth-item: Other list operations. - (line 320) -* -filter: Sublist selection. (line 8) -* -find-index: Indexing. (line 32) -* -find-indices: Indexing. (line 60) -* -find-last-index: Indexing. (line 46) -* -first: Other list operations. - (line 234) -* -first-item: Other list operations. - (line 271) -* -fix: Other list operations. - (line 376) -* -fixfn: Function combinators. - (line 175) -* -flatten: List to list. (line 33) -* -flatten-n: List to list. (line 55) -* -flip: Function combinators. - (line 80) -* -fourth-item: Other list operations. - (line 310) -* -grade-down: Indexing. (line 81) -* -grade-up: Indexing. (line 71) -* -group-by: Partitioning. (line 187) -* -if-let: Binding. (line 36) -* -if-let*: Binding. (line 49) -* -inits: Reductions. (line 203) -* -insert-at: List to list. (line 109) -* -interleave: Other list operations. - (line 68) -* -interpose: Other list operations. - (line 58) -* -intersection: Set operations. (line 32) -* -is-infix?: Predicates. (line 110) -* -is-prefix?: Predicates. (line 86) -* -is-suffix?: Predicates. (line 98) -* -iterate: Unfolding. (line 9) -* -iteratefn: Function combinators. - (line 152) -* -juxt: Function combinators. - (line 31) -* -keep: List to list. (line 8) -* -lambda: Binding. (line 252) -* -last: Other list operations. - (line 261) -* -last-item: Other list operations. - (line 330) -* -let: Binding. (line 65) -* -let*: Binding. (line 232) -* -list: Other list operations. - (line 363) -* -map: Maps. (line 10) -* -map-first: Maps. (line 37) -* -map-indexed: Maps. (line 65) -* -map-last: Maps. (line 51) -* -map-when: Maps. (line 21) -* -mapcat: Maps. (line 123) -* -max: Reductions. (line 267) -* -max-by: Reductions. (line 277) -* -min: Reductions. (line 243) -* -min-by: Reductions. (line 253) -* -non-nil: Sublist selection. (line 79) -* -none?: Predicates. (line 30) -* -not: Function combinators. - (line 117) -* -on: Function combinators. - (line 66) -* -only-some?: Predicates. (line 42) -* -orfn: Function combinators. - (line 126) -* -pad: Other list operations. - (line 179) -* -partial: Function combinators. - (line 9) -* -partition: Partitioning. (line 74) -* -partition-after-item: Partitioning. (line 177) -* -partition-after-pred: Partitioning. (line 145) -* -partition-all: Partitioning. (line 86) -* -partition-all-in-steps: Partitioning. (line 109) -* -partition-before-item: Partitioning. (line 167) -* -partition-before-pred: Partitioning. (line 156) -* -partition-by: Partitioning. (line 121) -* -partition-by-header: Partitioning. (line 132) -* -partition-in-steps: Partitioning. (line 97) -* -permutations: Set operations. (line 52) -* -powerset: Set operations. (line 44) -* -prodfn: Function combinators. - (line 209) -* -product: Reductions. (line 181) -* -reduce: Reductions. (line 46) -* -reduce-from: Reductions. (line 8) -* -reduce-r: Reductions. (line 65) -* -reduce-r-from: Reductions. (line 27) -* -reductions: Reductions. (line 119) -* -reductions-from: Reductions. (line 87) -* -reductions-r: Reductions. (line 135) -* -reductions-r-from: Reductions. (line 103) -* -remove: Sublist selection. (line 23) -* -remove-at: List to list. (line 145) -* -remove-at-indices: List to list. (line 158) -* -remove-first: Sublist selection. (line 37) -* -remove-item: Sublist selection. (line 67) -* -remove-last: Sublist selection. (line 52) -* -repeat: Other list operations. - (line 19) -* -replace: List to list. (line 67) -* -replace-at: List to list. (line 120) -* -replace-first: List to list. (line 81) -* -replace-last: List to list. (line 95) -* -rotate: Other list operations. - (line 8) -* -rpartial: Function combinators. - (line 20) -* -running-product: Reductions. (line 191) -* -running-sum: Reductions. (line 169) -* -same-items?: Predicates. (line 72) -* -second-item: Other list operations. - (line 286) -* -select-by-indices: Sublist selection. (line 185) -* -select-column: Sublist selection. (line 215) -* -select-columns: Sublist selection. (line 196) -* -separate: Partitioning. (line 63) -* -setq: Binding. (line 274) -* -slice: Sublist selection. (line 85) -* -snoc: Other list operations. - (line 44) -* -some: Other list operations. - (line 248) -* -some-->: Threading macros. (line 83) -* -some->: Threading macros. (line 59) -* -some->>: Threading macros. (line 71) -* -sort: Other list operations. - (line 350) -* -splice: Maps. (line 90) -* -splice-list: Maps. (line 110) -* -split-at: Partitioning. (line 8) -* -split-on: Partitioning. (line 28) -* -split-when: Partitioning. (line 46) -* -split-with: Partitioning. (line 17) -* -sum: Reductions. (line 159) -* -table: Other list operations. - (line 190) -* -table-flat: Other list operations. - (line 209) -* -tails: Reductions. (line 213) -* -take: Sublist selection. (line 101) -* -take-last: Sublist selection. (line 114) -* -take-while: Sublist selection. (line 156) -* -third-item: Other list operations. - (line 298) -* -tree-map: Tree operations. (line 28) -* -tree-map-nodes: Tree operations. (line 39) -* -tree-mapreduce: Tree operations. (line 84) -* -tree-mapreduce-from: Tree operations. (line 103) -* -tree-reduce: Tree operations. (line 52) -* -tree-reduce-from: Tree operations. (line 69) -* -tree-seq: Tree operations. (line 8) -* -unfold: Unfolding. (line 25) -* -union: Set operations. (line 8) -* -unzip: Other list operations. - (line 146) -* -update-at: List to list. (line 132) -* -when-let: Binding. (line 9) -* -when-let*: Binding. (line 23) -* -zip: Other list operations. - (line 95) -* -zip-fill: Other list operations. - (line 138) -* -zip-lists: Other list operations. - (line 119) -* -zip-with: Other list operations. - (line 79) - - - -Tag Table: -Node: Top947 -Node: Installation2424 -Node: Using in a package2991 -Node: Fontification of special variables3352 -Node: Functions4056 -Node: Maps5267 -Ref: -map5562 -Ref: -map-when5903 -Ref: -map-first6481 -Ref: -map-last6959 -Ref: -map-indexed7432 -Ref: -annotate7912 -Ref: -splice8402 -Ref: -splice-list9183 -Ref: -mapcat9645 -Ref: -copy10021 -Node: Sublist selection10225 -Ref: -filter10418 -Ref: -remove10870 -Ref: -remove-first11276 -Ref: -remove-last11803 -Ref: -remove-item12324 -Ref: -non-nil12719 -Ref: -slice12878 -Ref: -take13410 -Ref: -take-last13819 -Ref: -drop14252 -Ref: -drop-last14682 -Ref: -take-while15110 -Ref: -drop-while15636 -Ref: -select-by-indices16160 -Ref: -select-columns16674 -Ref: -select-column17380 -Node: List to list17844 -Ref: -keep18036 -Ref: -concat18539 -Ref: -flatten18836 -Ref: -flatten-n19595 -Ref: -replace19982 -Ref: -replace-first20445 -Ref: -replace-last20942 -Ref: -insert-at21432 -Ref: -replace-at21759 -Ref: -update-at22149 -Ref: -remove-at22640 -Ref: -remove-at-indices23128 -Node: Reductions23710 -Ref: -reduce-from23879 -Ref: -reduce-r-from24645 -Ref: -reduce25412 -Ref: -reduce-r26141 -Ref: -reductions-from27012 -Ref: -reductions-r-from27727 -Ref: -reductions28452 -Ref: -reductions-r29077 -Ref: -count29712 -Ref: -sum29936 -Ref: -running-sum30125 -Ref: -product30418 -Ref: -running-product30627 -Ref: -inits30940 -Ref: -tails31188 -Ref: -common-prefix31435 -Ref: -common-suffix31732 -Ref: -min32029 -Ref: -min-by32255 -Ref: -max32778 -Ref: -max-by33003 -Node: Unfolding33531 -Ref: -iterate33770 -Ref: -unfold34215 -Node: Predicates35023 -Ref: -any?35147 -Ref: -all?35467 -Ref: -none?35797 -Ref: -only-some?36099 -Ref: -contains?36584 -Ref: -same-items?36973 -Ref: -is-prefix?37358 -Ref: -is-suffix?37681 -Ref: -is-infix?38004 -Node: Partitioning38358 -Ref: -split-at38546 -Ref: -split-with38831 -Ref: -split-on39234 -Ref: -split-when39910 -Ref: -separate40550 -Ref: -partition40992 -Ref: -partition-all41444 -Ref: -partition-in-steps41872 -Ref: -partition-all-in-steps42369 -Ref: -partition-by42854 -Ref: -partition-by-header43236 -Ref: -partition-after-pred43840 -Ref: -partition-before-pred44184 -Ref: -partition-before-item44535 -Ref: -partition-after-item44846 -Ref: -group-by45152 -Node: Indexing45589 -Ref: -elem-index45791 -Ref: -elem-indices46186 -Ref: -find-index46569 -Ref: -find-last-index47058 -Ref: -find-indices47562 -Ref: -grade-up47970 -Ref: -grade-down48373 -Node: Set operations48783 -Ref: -union48966 -Ref: -difference49408 -Ref: -intersection49825 -Ref: -powerset50262 -Ref: -permutations50475 -Ref: -distinct50775 -Node: Other list operations51153 -Ref: -rotate51378 -Ref: -repeat51748 -Ref: -cons*52011 -Ref: -snoc52398 -Ref: -interpose52811 -Ref: -interleave53109 -Ref: -zip-with53478 -Ref: -zip54195 -Ref: -zip-lists55027 -Ref: -zip-fill55728 -Ref: -unzip56051 -Ref: -cycle56796 -Ref: -pad57198 -Ref: -table57521 -Ref: -table-flat58310 -Ref: -first59318 -Ref: -some59690 -Ref: -last59999 -Ref: -first-item60333 -Ref: -second-item60749 -Ref: -third-item61029 -Ref: -fourth-item61307 -Ref: -fifth-item61573 -Ref: -last-item61835 -Ref: -butlast62127 -Ref: -sort62374 -Ref: -list62863 -Ref: -fix63194 -Node: Tree operations63734 -Ref: -tree-seq63930 -Ref: -tree-map64788 -Ref: -tree-map-nodes65231 -Ref: -tree-reduce66081 -Ref: -tree-reduce-from66963 -Ref: -tree-mapreduce67564 -Ref: -tree-mapreduce-from68424 -Ref: -clone69710 -Node: Threading macros70038 -Ref: ->70183 -Ref: ->>70674 -Ref: -->71179 -Ref: -as->71735 -Ref: -some->72190 -Ref: -some->>72564 -Ref: -some-->73000 -Node: Binding73471 -Ref: -when-let73683 -Ref: -when-let*74168 -Ref: -if-let74691 -Ref: -if-let*75086 -Ref: -let75703 -Ref: -let*81793 -Ref: -lambda82733 -Ref: -setq83530 -Node: Side-effects84346 -Ref: -each84540 -Ref: -each-while84947 -Ref: -each-indexed85405 -Ref: -each-r85923 -Ref: -each-r-while86356 -Ref: -dotimes86731 -Ref: -doto87034 -Ref: --doto87462 -Node: Destructive operations87737 -Ref: !cons87910 -Ref: !cdr88116 -Node: Function combinators88311 -Ref: -partial88585 -Ref: -rpartial88979 -Ref: -juxt89382 -Ref: -compose89814 -Ref: -applify90367 -Ref: -on90798 -Ref: -flip91324 -Ref: -const91636 -Ref: -cut91975 -Ref: -not92461 -Ref: -orfn92771 -Ref: -andfn93205 -Ref: -iteratefn93700 -Ref: -fixfn94403 -Ref: -prodfn95966 -Node: Development97034 -Node: Contribute97383 -Node: Changes98131 -Node: Contributors101129 -Node: Index102748 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/dash-20210101.1712/dir b/elpa/dash-20210101.1712/dir deleted file mode 100644 index 49b1700d..00000000 --- a/elpa/dash-20210101.1712/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-20210105.414/dash-autoloads.el b/elpa/dash-20210105.414/dash-autoloads.el new file mode 100644 index 00000000..0b16ab1c --- /dev/null +++ b/elpa/dash-20210105.414/dash-autoloads.el @@ -0,0 +1,70 @@ +;;; dash-autoloads.el --- automatically extracted autoloads +;; +;;; 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. + +If called interactively, enable Dash-Fontify mode if ARG is +positive, and disable it if ARG is zero or negative. If called +from Lisp, also enable the mode if ARG is omitted or nil, and +toggle it if ARG is `toggle'; disable the mode otherwise. + +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, enable the mode if +ARG is omitted or nil. + +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) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-keep" "-l" "-m" "-non" "-only-some" "-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-20210105.414/dash-pkg.el b/elpa/dash-20210105.414/dash-pkg.el new file mode 100644 index 00000000..230a6df8 --- /dev/null +++ b/elpa/dash-20210105.414/dash-pkg.el @@ -0,0 +1,12 @@ +(define-package "dash" "20210105.414" "A modern list library for Emacs" + '((emacs "24")) + :commit "8879c41d30211ae2e72298e354fdffef627a3836" :authors + '(("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-20210105.414/dash.el b/elpa/dash-20210105.414/dash.el new file mode 100644 index 00000000..6548f8d4 --- /dev/null +++ b/elpa/dash-20210105.414/dash.el @@ -0,0 +1,2921 @@ +;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. + +;; Author: Magnar Sveen +;; Version: 2.17.0 +;; 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: + +;; TODO: `gv' was introduced in Emacs 24.3, so remove this and all +;; calls to `defsetf' when support for earlier versions is dropped. +(eval-when-compile + (unless (fboundp 'gv-define-setter) + (require 'cl))) + +(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." + `(setq ,cdr (cons ,car ,cdr))) + +(defmacro !cdr (list) + "Destructive: Set LIST to the cdr of LIST." + `(setq ,list (cdr ,list))) + +(defmacro --each (list &rest body) + "Anaphoric form of `-each'." + (declare (debug (form body)) + (indent 1)) + (let ((l (make-symbol "list"))) + `(let ((,l ,list) + (it-index 0)) + (while ,l + (let ((it (car ,l))) + ,@body) + (setq it-index (1+ it-index)) + (!cdr ,l))))) + +(defmacro -doto (init &rest forms) + "Evaluate INIT and thread the result as the 2nd argument to other FORMS. +INIT is evaluated once. Its result is passed to FORMS, which are +then evaluated sequentially. Returns the target form." + (declare (indent 1)) + (let ((retval (make-symbol "value"))) + `(let ((,retval ,init)) + ,@(mapcar (lambda (form) + (if (listp form) + `(,(car form) ,retval ,@(cdr form)) + `(funcall form ,retval))) + forms) + ,retval))) + +(defmacro --doto (eval-initial-value &rest forms) + "Anaphoric form of `-doto'. +Note: `it' need not be used in each form." + (declare (indent 1)) + `(let ((it ,eval-initial-value)) + ,@forms + it)) + +(defun -each (list fn) + "Call FN with every item in LIST. Return nil, used for side-effects only." + (declare (indent 1)) + (--each list (funcall fn it))) + +(defalias '--each-indexed '--each) + +(defun -each-indexed (list fn) + "Call (FN index item) for each item in LIST. + +In the anaphoric form `--each-indexed', the index is exposed as symbol `it-index'. + +See also: `-map-indexed'." + (declare (indent 1)) + (--each list (funcall fn it-index it))) + +(defmacro --each-while (list pred &rest body) + "Anaphoric form of `-each-while'." + (declare (debug (form form body)) + (indent 2)) + (let ((l (make-symbol "list"))) + `(let ((,l ,list) + (it-index 0) + it) + (ignore it) + (while (when ,l + (setq it (pop ,l)) + ,pred) + ,@body + (setq it-index (1+ it-index)))))) + +(defun -each-while (list pred fn) + "Call FN with every item in LIST while (PRED item) is non-nil. +Return nil, used for side-effects only." + (declare (indent 2)) + (--each-while list (funcall pred it) (funcall fn it))) + +(defmacro --each-r (list &rest body) + "Anaphoric form of `-each-r'." + (declare (debug (form body)) + (indent 1)) + (let ((v (make-symbol "vector"))) + ;; Implementation note: building 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 modification was reversed before we return. + `(let* ((,v (vconcat ,list)) + (it-index (length ,v)) + it) + (while (> it-index 0) + (setq it-index (1- it-index)) + (setq it (aref ,v it-index)) + ,@body)))) + +(defun -each-r (list fn) + "Call FN with every item in LIST in reversed order. + Return nil, used for side-effects only." + (--each-r list (funcall fn it))) + +(defmacro --each-r-while (list pred &rest body) + "Anaphoric form of `-each-r-while'." + (declare (debug (form form body)) + (indent 2)) + (let ((v (make-symbol "vector"))) + `(let* ((,v (vconcat ,list)) + (it-index (length ,v)) + it) + (while (> it-index 0) + (setq it-index (1- it-index)) + (setq it (aref ,v it-index)) + (if (not ,pred) + (setq it-index -1) + ,@body))))) + +(defun -each-r-while (list pred fn) + "Call FN with every item in reversed LIST while (PRED item) is non-nil. +Return nil, used for side-effects only." + (--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 version of `-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." + (declare (indent 1)) + (--dotimes num (funcall fn it))) + +(defun -map (fn list) + "Return a new list consisting of the result of applying FN to the items in LIST." + (mapcar fn list)) + +(defmacro --map (form list) + "Anaphoric form of `-map'." + (declare (debug (form form))) + `(mapcar (lambda (it) ,form) ,list)) + +(defmacro --reduce-from (form initial-value list) + "Anaphoric form of `-reduce-from'." + (declare (debug (form form form))) + `(let ((acc ,initial-value)) + (--each ,list (setq acc ,form)) + acc)) + +(defun -reduce-from (fn initial-value list) + "Return the result of applying FN to INITIAL-VALUE and the +first item in LIST, then applying FN to that result and the 2nd +item, etc. If LIST contains no items, return INITIAL-VALUE and +do not call FN. + +In the anaphoric form `--reduce-from', the accumulated value is +exposed as symbol `acc'. + +See also: `-reduce', `-reduce-r'" + (--reduce-from (funcall fn acc it) initial-value list)) + +(defmacro --reduce (form list) + "Anaphoric form of `-reduce'." + (declare (debug (form form))) + (let ((lv (make-symbol "list-value"))) + `(let ((,lv ,list)) + (if ,lv + (--reduce-from ,form (car ,lv) (cdr ,lv)) + (let (acc it) ,form))))) + +(defun -reduce (fn list) + "Return the result of applying FN to the first 2 items in LIST, +then applying FN to that result and the 3rd item, etc. If LIST +contains no items, return the result of calling FN with no +arguments. If LIST contains a single item, return that item +and do not call FN. + +In the anaphoric form `--reduce', the accumulated value is +exposed as symbol `acc'. + +See also: `-reduce-from', `-reduce-r'" + (if list + (-reduce-from fn (car list) (cdr list)) + (funcall fn))) + +(defmacro --reduce-r-from (form initial-value list) + "Anaphoric version of `-reduce-r-from'." + (declare (debug (form form form))) + `(--reduce-from ,form ,initial-value (reverse ,list))) + +(defun -reduce-r-from (fn initial-value list) + "Replace conses with FN, nil with INITIAL-VALUE and evaluate +the resulting expression. If LIST is empty, INITIAL-VALUE is +returned and FN is not called. + +Note: this function works the same as `-reduce-from' but the +operation associates from right instead of from left. + +See also: `-reduce-r', `-reduce'" + (--reduce-r-from (funcall fn it acc) initial-value list)) + +(defmacro --reduce-r (form list) + "Anaphoric version of `-reduce-r'." + (declare (debug (form form))) + `(--reduce ,form (reverse ,list))) + +(defun -reduce-r (fn list) + "Replace conses with FN and evaluate the resulting expression. +The final nil is ignored. If LIST contains no items, return the +result of calling FN with no arguments. If LIST contains a single +item, return that item and do not call FN. + +The first argument of FN is the new item, the second is the +accumulated value. + +Note: this function works the same as `-reduce' but the operation +associates from right instead of from left. + +See also: `-reduce-r-from', `-reduce'" + (if list + (--reduce-r (funcall fn it acc) list) + (funcall fn))) + +(defun -reductions-from (fn init list) + "Return a list of the intermediate values of the reduction. + +See `-reduce-from' for explanation of the arguments. + +See also: `-reductions', `-reductions-r', `-reduce-r'" + (nreverse (--reduce-from (cons (funcall fn (car acc) it) acc) (list init) list))) + +(defun -reductions (fn list) + "Return a list of the intermediate values of the reduction. + +See `-reduce' for explanation of the arguments. + +See also: `-reductions-from', `-reductions-r', `-reduce-r'" + (and list (-reductions-from fn (car list) (cdr list)))) + +(defun -reductions-r-from (fn init list) + "Return a list of the intermediate values of the reduction. + +See `-reduce-r-from' for explanation of the arguments. + +See also: `-reductions-r', `-reductions', `-reduce'" + (--reduce-r-from (cons (funcall fn it (car acc)) acc) (list init) list)) + +(defun -reductions-r (fn list) + "Return a list of the intermediate values of the reduction. + +See `-reduce-r' for explanation of the arguments. + +See also: `-reductions-r-from', `-reductions', `-reduce'" + (when list + (let ((rev (reverse list))) + (--reduce-from (cons (funcall fn it (car acc)) acc) + (list (car rev)) + (cdr rev))))) + +(defmacro --filter (form list) + "Anaphoric form of `-filter'. + +See also: `--remove'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list (when ,form (!cons it ,r))) + (nreverse ,r)))) + +(defun -filter (pred list) + "Return a new list of the items in LIST for which PRED returns a non-nil value. + +Alias: `-select' + +See also: `-keep', `-remove'." + (--filter (funcall pred it) list)) + +(defalias '-select '-filter) +(defalias '--select '--filter) + +(defmacro --remove (form list) + "Anaphoric form of `-remove'. + +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' + +See also: `-filter'." + (--remove (funcall pred it) list)) + +(defalias '-reject '-remove) +(defalias '--reject '--remove) + +(defun -remove-first (pred list) + "Return a new list with the first item matching PRED removed. + +Alias: `-reject-first' + +See also: `-remove', `-map-first'" + (let (front) + (while (and list (not (funcall pred (car list)))) + (push (car list) front) + (!cdr list)) + (if list + (-concat (nreverse front) (cdr list)) + (nreverse front)))) + +(defmacro --remove-first (form list) + "Anaphoric form of `-remove-first'." + (declare (debug (form form))) + `(-remove-first (lambda (it) ,form) ,list)) + +(defalias '-reject-first '-remove-first) +(defalias '--reject-first '--remove-first) + +(defun -remove-last (pred list) + "Return a new list with the last item matching PRED removed. + +Alias: `-reject-last' + +See also: `-remove', `-map-last'" + (nreverse (-remove-first pred (reverse list)))) + +(defmacro --remove-last (form list) + "Anaphoric form of `-remove-last'." + (declare (debug (form form))) + `(-remove-last (lambda (it) ,form) ,list)) + +(defalias '-reject-last '-remove-last) +(defalias '--reject-last '--remove-last) + +(defun -remove-item (item list) + "Remove all occurrences of ITEM from LIST. + +Comparison is done with `equal'." + (declare (pure t) (side-effect-free t)) + (--remove (equal it item) list)) + +(defmacro --keep (form list) + "Anaphoric form of `-keep'." + (declare (debug (form form))) + (let ((r (make-symbol "result")) + (m (make-symbol "mapped"))) + `(let (,r) + (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r)))) + (nreverse ,r)))) + +(defun -keep (fn list) + "Return a new list of the non-nil results of applying FN to the items in LIST. + +If you want to select the original items satisfying a predicate use `-filter'." + (--keep (funcall fn it) list)) + +(defun -non-nil (list) + "Return all non-nil elements of LIST." + (declare (pure t) (side-effect-free t)) + (-remove 'null list)) + +(defmacro --map-indexed (form list) + "Anaphoric form of `-map-indexed'." + (declare (debug (form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list + (!cons ,form ,r)) + (nreverse ,r)))) + +(defun -map-indexed (fn list) + "Return a new list consisting of the result of (FN index item) for each item in LIST. + +In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'. + +See also: `-each-indexed'." + (--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) + "Return a new list where the elements in LIST that do not match the PRED function +are unchanged, and where the elements in LIST that do match the PRED function are mapped +through the REP function. + +Alias: `-replace-where' + +See also: `-update-at'" + (--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) + "Replace first item in LIST satisfying PRED with result of REP called on this item. + +See also: `-map-when', `-replace-first'" + (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'." + `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list)) + +(defun -map-last (pred rep list) + "Replace last item in LIST satisfying PRED with result of REP called on this item. + +See also: `-map-when', `-replace-last'" + (nreverse (-map-first pred rep (reverse list)))) + +(defmacro --map-last (pred rep list) + "Anaphoric form of `-map-last'." + `(-map-last (lambda (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." + (--mapcat (funcall fn it) list)) + +(defmacro --iterate (form init n) + "Anaphoric version of `-iterate'." + (declare (debug (form form form))) + (let ((res (make-symbol "result"))) + `(let ((it ,init) ,res) + (dotimes (_ ,n) + (push it ,res) + (setq it ,form)) + (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." + (--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)) + (-last-item (--iterate (--mapcat (-list it) it) list (1+ num)))) + +(defun -concat (&rest lists) + "Return a new list with the concatenation of the elements in the supplied LISTS." + (declare (pure t) (side-effect-free t)) + (apply 'append lists)) + +(defalias '-copy 'copy-sequence + "Create a shallow copy of LIST. + +\(fn LIST)") + +(defun -splice (pred fun list) + "Splice lists generated by FUN in place of elements matching PRED in LIST. + +FUN takes the element matching PRED as input. + +This function can be used as replacement for `,@' in case you +need to splice several lists at marked positions (for example +with keywords). + +See also: `-splice-list', `-insert-at'" + (let (r) + (--each list + (if (funcall pred it) + (let ((new (funcall fun it))) + (--each new (!cons it r))) + (!cons it r))) + (nreverse r))) + +(defmacro --splice (pred form list) + "Anaphoric form of `-splice'." + `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list)) + +(defun -splice-list (pred new-list list) + "Splice NEW-LIST in place of elements matching PRED in LIST. + +See also: `-splice', `-insert-at'" + (-splice pred (lambda (_) new-list) list)) + +(defmacro --splice-list (pred new-list list) + "Anaphoric form of `-splice-list'." + `(-splice-list (lambda (it) ,pred) ,new-list ,list)) + +(defun -cons* (&rest args) + "Make a new list from the elements of ARGS. + +The last 2 members of ARGS are used as the final cons of the +result so if the final member of ARGS is not a list the result is +a dotted list." + (declare (pure t) (side-effect-free t)) + (-reduce-r 'cons 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 ELEMENTS is non nil, append these to the list as well." + (-concat list (list elem) elements)) + +(defmacro --first (form list) + "Anaphoric form of `-first'." + (declare (debug (form form))) + (let ((n (make-symbol "needle"))) + `(let (,n) + (--each-while ,list (not ,n) + (when ,form (setq ,n it))) + ,n))) + +(defun -first (pred list) + "Return the first x in LIST where (PRED x) is non-nil, else nil. + +To get the first item in the list no questions asked, use `car'. + +Alias: `-find'" + (--first (funcall pred it) list)) + +(defalias '-find '-first) +(defalias '--find '--first) + +(defmacro --some (form list) + "Anaphoric form of `-some'." + (declare (debug (form form))) + (let ((n (make-symbol "needle"))) + `(let (,n) + (--each-while ,list (not ,n) + (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'" + (--some (funcall pred it) list)) + +(defalias '-any '-some) +(defalias '--any '--some) + +(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." + (--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'. + +\(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) + +(defalias '-second-item 'cadr + "Return the second item of LIST, or nil if LIST is too short. + +See also: `-third-item'. + +\(fn LIST)") + +(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: `-fourth-item'. + +\(fn LIST)") + +(defun -fourth-item (list) + "Return the fourth item of LIST, or nil if LIST is too short. + +See also: `-fifth-item'." + (declare (pure t) (side-effect-free t)) + (car (cdr (cdr (cdr list))))) + +(defun -fifth-item (list) + "Return the fifth item of LIST, or nil if LIST is too short. + +See also: `-last-item'." + (declare (pure t) (side-effect-free t)) + (car (cdr (cdr (cdr (cdr list)))))) + +(defun -last-item (list) + "Return the last item of LIST, or nil on an empty list." + (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." + (--count (funcall pred it) list)) + +(defun ---truthy? (val) + (declare (pure t) (side-effect-free t)) + (not (null val))) + +(defmacro --any? (form list) + "Anaphoric form of `-any?'." + (declare (debug (form form))) + `(---truthy? (--some ,form ,list))) + +(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'" + (--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) + "Anaphoric form of `-all?'." + (declare (debug (form form))) + (let ((a (make-symbol "all"))) + `(let ((,a t)) + (--each-while ,list ,a (setq ,a ,form)) + (---truthy? ,a)))) + +(defun -all? (pred list) + "Return t if (PRED x) is non-nil for all x in LIST, else nil. + +Alias: `-all-p', `-every?', `-every-p'" + (--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'" + (--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 at least one item of LIST matches PRED and at least one item of LIST does not match PRED. +Return `nil` both if all items match the predicate or if none of the items match the predicate. + +Alias: `-only-some-p'" + (--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) + "Anaphoric form of `-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. + +See also: `-drop-while'" + (--take-while (funcall pred it) list)) + +(defmacro --drop-while (form list) + "Anaphoric form of `-drop-while'." + (declare (debug (form form))) + (let ((l (make-symbol "list"))) + `(let ((,l ,list)) + (--each-while ,l ,form (pop ,l)) + (copy-sequence ,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 a copy of the tail of +LIST starting from its first element for which PRED returns nil. + +See also: `-take-while'" + (--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))) + +(defun -drop (n list) + "Return a copy of the tail of LIST without the first 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-last'" + (copy-sequence (nthcdr 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) + "Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list." + (declare (pure t) (side-effect-free t)) + (let (result) + (--dotimes n + (when list + (!cons (car list) result) + (!cdr list))) + (list (nreverse result) list))) + +(defun -rotate (n list) + "Rotate LIST N places to the right. With N negative, rotate to the left. +The time complexity is O(n)." + (declare (pure t) (side-effect-free t)) + (when list + (let* ((len (length list)) + (n-mod-len (mod n len)) + (new-tail-len (- len n-mod-len))) + (append (-drop 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) + "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`. + +See also: `-map-when'" + (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 form form))) + `(-update-at ,n (lambda (it) ,form) ,list)) + +(defun -remove-at (n list) + "Return a list with element at Nth position in LIST removed. + +See also: `-remove-at-indices', `-remove'" + (declare (pure t) (side-effect-free t)) + (-remove-at-indices (list n) list)) + +(defun -remove-at-indices (indices list) + "Return a list whose elements are elements from LIST without +elements selected as `(nth i list)` for all i +from INDICES. + +See also: `-remove-at', `-remove'" + (declare (pure t) (side-effect-free t)) + (let* ((indices (-sort '< indices)) + (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices)))) + r) + (--each diffs + (let ((split (-split-at it list))) + (!cons (car split) r) + (setq list (cdr (cadr split))))) + (!cons list r) + (apply '-concat (nreverse r)))) + +(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) + "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list." + (--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 (form form))) + `(-split-when (lambda (it) (equal it ,item)) ,list)) + +(defmacro --split-when (form list) + "Anaphoric version of `-split-when'." + (declare (debug (form form))) + `(-split-when (lambda (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'." + (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) + "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list." + (--separate (funcall pred it) list)) + +(defun ---partition-all-in-steps-reversed (n step list) + "Private: Used by -partition-all-in-steps and -partition-in-steps." + (when (< step 1) + (error "Step must be a positive number, or you're looking at some juicy infinite loops.")) + (let ((result nil)) + (while list + (!cons (-take n list) result) + (setq list (-drop step list))) + result)) + +(defun -partition-all-in-steps (n step list) + "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. +The last groups may contain less than N items." + (declare (pure t) (side-effect-free t)) + (nreverse (---partition-all-in-steps-reversed n step list))) + +(defun -partition-in-steps (n step list) + "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. +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 (---partition-all-in-steps-reversed n step list))) + (while (and result (< (length (car result)) n)) + (!cdr 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." + (--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)." + (--partition-by-header (funcall fn it) list)) + +(defun -partition-after-pred (pred list) + "Partition directly after each time PRED is true on an element of LIST." + (when list + (let ((rest (-partition-after-pred pred + (cdr list)))) + (if (funcall pred (car list)) + ;;split after (car list) + (cons (list (car list)) + rest) + + ;;don't split after (car list) + (cons (cons (car list) + (car rest)) + (cdr rest)))))) + +(defun -partition-before-pred (pred list) + "Partition directly before each time PRED is true on an element of LIST." + (nreverse (-map #'reverse + (-partition-after-pred pred (reverse list))))) + +(defun -partition-after-item (item list) + "Partition directly after each time ITEM appears in LIST." + (-partition-after-pred (lambda (ele) (equal ele item)) + list)) + +(defun -partition-before-item (item list) + "Partition directly before each time ITEM appears in LIST." + (-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'." + (--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) + "Anaphoric form of `-zip-with'. + +The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'." + (declare (debug (form form form))) + (let ((r (make-symbol "result")) + (l1 (make-symbol "list1")) + (l2 (make-symbol "list2"))) + `(let ((,r nil) + (,l1 ,list1) + (,l2 ,list2)) + (while (and ,l1 ,l2) + (let ((it (car ,l1)) + (other (car ,l2))) + (!cons ,form ,r) + (!cdr ,l1) + (!cdr ,l2))) + (nreverse ,r)))) + +(defun -zip-with (fn list1 list2) + "Zip the two lists LIST1 and LIST2 using a function FN. This +function is applied pairwise taking as first argument element of +LIST1 and as second argument element of LIST2 at corresponding +position. + +The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it', +and the elements from LIST2 as symbol `other'." + (--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 elements of each list, and so on. The lengths of the returned +groupings are equal to the length of the shortest input list. + +The return value is always list of lists, which is a difference +from `-zip-pair' which returns a cons-cell in case two input +lists are provided. + +See also: `-zip'" + (declare (pure t) (side-effect-free t)) + (when lists + (let (results) + (while (-none? 'null lists) + (setq results (cons (mapcar 'car lists) results)) + (setq lists (mapcar 'cdr lists))) + (nreverse results)))) + +(defun -zip (&rest lists) + "Zip LISTS together. Group the head of each list, followed by the +second elements of each list, and so on. The lengths of the returned +groupings are equal to the length of the shortest input list. + +If two lists are provided as arguments, return the groupings as a list +of cons cells. Otherwise, return the groupings as a list of lists. + +Use `-zip-lists' if you need the return value to always be a list +of lists. + +Alias: `-zip-pair' + +See also: `-zip-lists'" + (declare (pure t) (side-effect-free t)) + (when lists + (let (results) + (while (-none? 'null lists) + (setq results (cons (mapcar 'car lists) results)) + (setq lists (mapcar 'cdr lists))) + (setq results (nreverse results)) + (if (= (length lists) 2) + ;; to support backward compatibility, return + ;; a cons cell if two lists were provided + (--map (cons (car it) (cadr it)) results) + results)))) + +(defalias '-zip-pair '-zip) + +(defun -zip-fill (fill-value &rest lists) + "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The +lengths of the returned groupings are equal to the length of the +longest input list." + (declare (pure t) (side-effect-free t)) + (apply '-zip (apply '-pad (cons fill-value lists)))) + +(defun -unzip (lists) + "Unzip LISTS. + +This works just like `-zip' 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 the same length). + +Note in particular that calling this on a list of two lists will +return a list of cons-cells such that the above identity works. + +See also: `-zip'" + (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) + "Appends FILL-VALUE to the end of each list in LISTS such that they +will all have the same length." + (let* ((annotations (-annotate 'length lists)) + (n (-max (-map 'car annotations)))) + (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations))) + +(defun -annotate (fn list) + "Return a list of cons cells where each cell is FN applied to each +element of LIST paired with the unmodified element of LIST." + (-zip (-map fn list) list)) + +(defmacro --annotate (form list) + "Anaphoric version of `-annotate'." + (declare (debug (form form))) + `(-annotate (lambda (it) ,form) ,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'" + (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'" + (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))) + +(defun -partial (fn &rest args) + "Take a function FN and fewer than the normal arguments to FN, +and return a fn that takes a variable number of additional ARGS. +When called, the returned function calls FN with ARGS first and +then additional args." + (apply 'apply-partially fn args)) + +(defun -elem-index (elem list) + "Return the index of the first element in the given LIST which +is equal to the query element ELEM, or nil if there is no +such element." + (declare (pure t) (side-effect-free t)) + (car (-elem-indices elem list))) + +(defun -elem-indices (elem list) + "Return the indices of all elements in LIST equal to the query +element ELEM, in ascending order." + (declare (pure t) (side-effect-free t)) + (-find-indices (-partial 'equal elem) list)) + +(defun -find-indices (pred list) + "Return the indices of all elements in LIST satisfying the +predicate PRED, in ascending order." + (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list))) + +(defmacro --find-indices (form list) + "Anaphoric version of `-find-indices'." + (declare (debug (form form))) + `(-find-indices (lambda (it) ,form) ,list)) + +(defun -find-index (pred list) + "Take a predicate PRED and a LIST and return the index of the +first element in the list satisfying the predicate, or nil if +there is no such element. + +See also `-first'." + (car (-find-indices pred list))) + +(defmacro --find-index (form list) + "Anaphoric version of `-find-index'." + (declare (debug (form form))) + `(-find-index (lambda (it) ,form) ,list)) + +(defun -find-last-index (pred list) + "Take a predicate PRED and a LIST and return the index of the +last element in the list satisfying the predicate, or nil if +there is no such element. + +See also `-last'." + (-last-item (-find-indices pred list))) + +(defmacro --find-last-index (form list) + "Anaphoric version of `-find-last-index'." + `(-find-last-index (lambda (it) ,form) ,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--> (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)))) + +(defun -grade-up (comparator list) + "Grade elements of LIST using COMPARATOR relation, yielding a +permutation vector such that applying this permutation to LIST +sorts it in ascending order." + ;; ugly hack to "fix" lack of lexical scope + (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other))))) + (->> (--map-indexed (cons it it-index) list) + (-sort comp) + (-map 'cdr)))) + +(defun -grade-down (comparator list) + "Grade elements of LIST using COMPARATOR relation, yielding a +permutation vector such that applying this permutation to LIST +sorts it in descending order." + ;; ugly hack to "fix" lack of lexical scope + (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it))))) + (->> (--map-indexed (cons it it-index) list) + (-sort comp) + (-map '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 (apply '-zip (-pad 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 + ((symbolp 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 (--map (list (caar it) (cadr it)) (-zip 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 the description of destructuring mechanism." + (declare (doc-string 2) (indent defun) + (debug (&define sexp + [&optional stringp] + [&optional ("interactive" interactive)] + def-body))) + (cond + ((not (consp match-form)) + (signal 'wrong-type-argument "match-form must be a list")) + ;; no destructuring, so just return regular lambda to make things faster + ((-all? 'symbolp match-form) + `(lambda ,match-form ,@body)) + (t + (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 to create the extra bindings to ensure that. + ;; We should find a way to optimize that. Not critical however. + `(lambda ,(--map (cadr it) 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) + (error "Odd number of arguments")) + (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))) + +(defvar -compare-fn nil + "Tests for equality use this function or `equal' if this is nil. +It should only be set using dynamic scope with a let, like: + + (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)") + +(defun -distinct (list) + "Return a new list with all duplicates removed. +The test for equality is done with `equal', +or with `-compare-fn' if that's non-nil. + +Alias: `-uniq'" + ;; Implementation note: The speedup gained from hash table lookup + ;; starts to outweigh its overhead for lists of length greater than + ;; 32. See discussion in PR #305. + (let* ((len (length list)) + (lut (and (> len 32) + ;; Check that `-compare-fn' is a valid hash-table + ;; lookup function or `nil'. + (memq -compare-fn '(nil equal eq eql)) + (make-hash-table :test (or -compare-fn #'equal) + :size len)))) + (if lut + (--filter (unless (gethash it lut) + (puthash it t lut)) + list) + (--each list (unless (-contains? lut it) (!cons it lut))) + (nreverse lut)))) + +(defalias '-uniq '-distinct) + +(defun -union (list list2) + "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST. +The test for equality is done with `equal', +or with `-compare-fn' if that's non-nil." + ;; We fall back to iteration implementation if the comparison + ;; function isn't one of `eq', `eql' or `equal'. + (let* ((result (reverse list)) + ;; TODO: get rid of this dynamic variable, pass it as an + ;; argument instead. + (-compare-fn (if (bound-and-true-p -compare-fn) + -compare-fn + 'equal))) + (if (memq -compare-fn '(eq eql equal)) + (let ((ht (make-hash-table :test -compare-fn))) + (--each list (puthash it t ht)) + (--each list2 (unless (gethash it ht) (!cons it result)))) + (--each list2 (unless (-contains? result it) (!cons it result)))) + (nreverse result))) + +(defun -intersection (list list2) + "Return a new list containing only the elements that are members of both LIST and LIST2. +The test for equality is done with `equal', +or with `-compare-fn' if that's non-nil." + (--filter (-contains? list2 it) list)) + +(defun -difference (list list2) + "Return a new list with only the members of LIST that are not in LIST2. +The test for equality is done with `equal', +or with `-compare-fn' if that's non-nil." + (--filter (not (-contains? list2 it)) list)) + +(defun -powerset (list) + "Return the power set of LIST." + (if (null list) '(()) + (let ((last (-powerset (cdr list)))) + (append (mapcar (lambda (x) (cons (car list) x)) last) + last)))) + +(defun -permutations (list) + "Return the permutations of LIST." + (if (null list) '(()) + (apply #'append + (mapcar (lambda (x) + (mapcar (lambda (perm) (cons x perm)) + (-permutations (remove x list)))) + list)))) + +(defun -inits (list) + "Return all prefixes of LIST." + (let ((res (list list))) + (setq list (reverse list)) + (while list + (push (reverse (!cdr list)) res)) + res)) + +(defun -tails (list) + "Return all suffixes of LIST" + (-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." + (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's non-nil. + +Alias: `-contains-p'" + (not + (null + (cond + ((null -compare-fn) (member element list)) + ((eq -compare-fn 'eq) (memq element list)) + ((eq -compare-fn 'eql) (memql element list)) + (t + (let ((lst list)) + (while (and lst + (not (funcall -compare-fn element (car lst)))) + (setq lst (cdr lst))) + lst)))))) + +(defalias '-contains-p '-contains?) + +(defun -same-items? (list list2) + "Return true if LIST and LIST2 has the same items. + +The order of the elements in the lists does not matter. + +Alias: `-same-items-p'" + (let ((length-a (length list)) + (length-b (length list2))) + (and + (= length-a length-b) + (= length-a (length (-intersection list list2)))))) + +(defalias '-same-items-p '-same-items?) + +(defun -is-prefix? (prefix list) + "Return non-nil if PREFIX is prefix of LIST. + +Alias: `-is-prefix-p'" + (declare (pure t) (side-effect-free t)) + (--each-while list (equal (car prefix) it) + (!cdr prefix)) + (not prefix)) + +(defun -is-suffix? (suffix list) + "Return non-nil if SUFFIX is suffix of LIST. + +Alias: `-is-suffix-p'" + (declare (pure t) (side-effect-free t)) + (-is-prefix? (reverse suffix) (reverse list))) + +(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." + (sort (copy-sequence list) comparator)) + +(defmacro --sort (form list) + "Anaphoric form of `-sort'." + (declare (debug (form form))) + `(-sort (lambda (it other) ,form) ,list)) + +(defun -list (&rest args) + "Return a list with ARGS. + +If first item of ARGS is already a list, simply return ARGS. If +not, return a list with ARGS as elements." + (declare (pure t) (side-effect-free t)) + (let ((arg (car args))) + (if (listp arg) 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 (natnump n) (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)) + (unless (consp list) + (error "LIST must be non-empty")) + (-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)) + (unless (consp list) + (error "LIST must be non-empty")) + (-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." + (--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." + (--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 (form form))) + `(-max-by (lambda (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 (form form))) + `(-min-by (lambda (it other) ,form) ,list)) + +(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'." + (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'." + `(-fix (lambda (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." + (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 (form form))) + `(-unfold (lambda (it) ,form) ,seed)) + +(defun -cons-pair? (con) + "Return non-nil if CON is true cons pair. +That is (A . B) where B is not a list. + +Alias: `-cons-pair-p'" + (declare (pure t) (side-effect-free t)) + (and (listp con) + (not (listp (cdr con))))) + +(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)) + (cond + ((-cons-pair? val) (-cons-to-list val)) + (t (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." + (cond + ((not tree) nil) + ((-cons-pair? tree) (funcall fn tree)) + ((listp tree) + (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) + (t (funcall fn tree)))) + +(defmacro --tree-mapreduce-from (form folder init-value tree) + "Anaphoric form of `-tree-mapreduce-from'." + (declare (debug (form form form form))) + `(-tree-mapreduce-from (lambda (it) ,form) (lambda (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." + (cond + ((not tree) nil) + ((-cons-pair? tree) (funcall fn tree)) + ((listp tree) + (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) + (t (funcall fn tree)))) + +(defmacro --tree-mapreduce (form folder tree) + "Anaphoric form of `-tree-mapreduce'." + (declare (debug (form form form))) + `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree)) + +(defun -tree-map (fn tree) + "Apply FN to each element of TREE while preserving the tree structure." + (cond + ((not tree) nil) + ((-cons-pair? tree) (funcall fn tree)) + ((listp tree) + (mapcar (lambda (x) (-tree-map fn x)) tree)) + (t (funcall fn tree)))) + +(defmacro --tree-map (form tree) + "Anaphoric form of `-tree-map'." + (declare (debug (form form))) + `(-tree-map (lambda (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." + (cond + ((not tree) nil) + ((-cons-pair? tree) tree) + ((listp tree) + (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) + (t tree))) + +(defmacro --tree-reduce-from (form init-value tree) + "Anaphoric form of `-tree-reduce-from'." + (declare (debug (form form form))) + `(-tree-reduce-from (lambda (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." + (cond + ((not tree) nil) + ((-cons-pair? tree) tree) + ((listp tree) + (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) + (t tree))) + +(defmacro --tree-reduce (form tree) + "Anaphoric form of `-tree-reduce'." + (declare (debug (form form))) + `(-tree-reduce (lambda (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." + (if (funcall pred tree) + (funcall fun tree) + (if (and (listp tree) + (not (-cons-pair? 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'." + `(-tree-map-nodes (lambda (it) ,pred) (lambda (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." + (cons tree + (when (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'." + `(-tree-seq (lambda (it) ,branch) (lambda (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)) + +;;; Font lock + +(defvar dash--keywords + `(;; TODO: Do not fontify the following automatic variables + ;; globally; detect and limit to their local anaphoric scope. + (,(concat "\\_<" (regexp-opt '("acc" "it" "it-index" "other")) "\\_>") + 0 font-lock-variable-name-face) + ;; Elisp macro fontification was static prior to Emacs 25. + ,@(when (< emacs-major-version 25) + (let ((macs '("!cdr" + "!cons" + "-->" + "--all?" + "--annotate" + "--any?" + "--count" + "--dotimes" + "--doto" + "--drop-while" + "--each" + "--each-r" + "--each-r-while" + "--each-while" + "--filter" + "--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?" + "--only-some?" + "--partition-by" + "--partition-by-header" + "--reduce" + "--reduce-from" + "--reduce-r" + "--reduce-r-from" + "--remove" + "--remove-first" + "--remove-last" + "--separate" + "--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->" + "-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") + :group 'dash + :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'." + :group 'dash :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 + :group 'dash) + +(defcustom dash-enable-fontlock nil + "If non-nil, fontify Dash macro calls and special variables." + :group 'dash + :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") + +(provide 'dash) +;;; dash.el ends here diff --git a/elpa/dash-20210105.414/dash.info b/elpa/dash-20210105.414/dash.info new file mode 100644 index 00000000..a0c99c25 --- /dev/null +++ b/elpa/dash-20210105.414/dash.info @@ -0,0 +1,4744 @@ +This is dash.info, produced by makeinfo version 6.5 from dash.texi. + +This manual is for Dash version 2.17.0. + + Copyright © 2012–2021 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.17.0. + + Copyright © 2012–2021 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. + +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. +* Change log:: List of significant changes by version. +* 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/) 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. + +‘M-x package-install dash-functional ’ + Install an optional library of additional function combinators. + + Alternatively, you can just dump ‘dash.el’ or ‘dash-functional.el’ in +your load path somewhere. + +* Menu: + +* Using in a package:: Listing Dash as a package dependency. +* Fontification of special variables:: Font Lock of anaphoric macro variables. + + +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.17.0")) + + The same goes for the ‘dash-functional.el’ library of function +combinators: + + ;; Package-Requires: ((dash "2.17.0") (dash-functional "1.2.0")) + + +File: dash.info, Node: Fontification of special variables, 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: 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 new list. + + -- Function: -map (fn list) + Return a new list consisting of the result of applying FN to the + items in LIST. + + (-map (lambda (num) (* num num)) '(1 2 3 4)) + ⇒ '(1 4 9 16) + (-map 'square '(1 2 3 4)) + ⇒ '(1 4 9 16) + (--map (* it it) '(1 2 3 4)) + ⇒ '(1 4 9 16) + + -- Function: -map-when (pred rep list) + Return a new list where the elements in LIST that do not match the + PRED function are unchanged, and where the elements in LIST that do + match the PRED function 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) + Replace first item in LIST satisfying PRED with result of REP + called on this 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) + Replace last item in LIST satisfying PRED with result of REP called + on this 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) + Return a new list consisting of the result of (FN index item) for + each item in LIST. + + In the anaphoric form ‘--map-indexed’, the index is exposed as + symbol ‘it-index’. + + 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) + + -- Function: -annotate (fn list) + Return a list of cons cells where each cell is FN applied to each + element of LIST paired with the unmodified element of LIST. + + (-annotate '1+ '(1 2 3)) + ⇒ '((2 . 1) (3 . 2) (4 . 3)) + (-annotate 'length '(("h" "e" "l" "l" "o") ("hello" "world"))) + ⇒ '((5 "h" "e" "l" "l" "o") (2 "hello" "world")) + (--annotate (< 1 it) '(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 elements matching PRED in + LIST. + + FUN takes the element matching PRED as input. + + This function can be used as replacement for ‘,@’ in case you need + to splice several lists at marked positions (for example with + keywords). + + See also: ‘-splice-list’ (*note -splice-list::), ‘-insert-at’ + (*note -insert-at::) + + (-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) + ⇒ '(1 2 2 3 4 4) + (--splice 't (list it it) '(1 2 3 4)) + ⇒ '(1 1 2 2 3 3 4 4) + (--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar) :magic (baz))) + ⇒ '((foo) (bar) (list of) (magical) (code) (baz)) + + -- 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 (arg) + Create a shallow copy of LIST. + + (fn 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 a + non-nil value. + + Alias: ‘-select’ + + See also: ‘-keep’ (*note -keep::), ‘-remove’ (*note -remove::). + + (-filter (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) + ⇒ '(2 4) + (-filter 'even? '(1 2 3 4)) + ⇒ '(2 4) + (--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’ + + See also: ‘-filter’ (*note -filter::). + + (-remove (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) + ⇒ '(1 3) + (-remove 'even? '(1 2 3 4)) + ⇒ '(1 3) + (--remove (= 0 (% it 2)) '(1 2 3 4)) + ⇒ '(1 3) + + -- Function: -remove-first (pred list) + Return a new list with the first item matching PRED removed. + + Alias: ‘-reject-first’ + + See also: ‘-remove’ (*note -remove::), ‘-map-first’ (*note + -map-first::) + + (-remove-first 'even? '(1 3 5 4 7 8 10)) + ⇒ '(1 3 5 7 8 10) + (-remove-first 'stringp '(1 2 "first" "second" "third")) + ⇒ '(1 2 "second" "third") + (--remove-first (> it 3) '(1 2 3 4 5 6 7 8 9 10)) + ⇒ '(1 2 3 5 6 7 8 9 10) + + -- Function: -remove-last (pred list) + Return a new list with the last item matching PRED removed. + + Alias: ‘-reject-last’ + + See also: ‘-remove’ (*note -remove::), ‘-map-last’ (*note + -map-last::) + + (-remove-last 'even? '(1 3 5 4 7 8 10 11)) + ⇒ '(1 3 5 4 7 8 11) + (-remove-last 'stringp '(1 2 "last" "second" "third")) + ⇒ '(1 2 "last" "second") + (--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) + Remove all occurrences of ITEM from LIST. + + 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" "dave")) + ⇒ '("alice" "eve" "dave") + + -- Function: -non-nil (list) + Return all non-nil elements of LIST. + + (-non-nil '(1 nil 2 nil nil 3 4 nil 5 nil)) + ⇒ '(1 2 3 4 5) + + -- 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)) + ⇒ nil + + -- 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 a copy of the tail of LIST without the first 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-last’ (*note -drop-last::) + + (-drop 3 '(1 2 3 4 5)) + ⇒ '(4 5) + (-drop 17 '(1 2 3 4 5)) + ⇒ nil + (-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)) + ⇒ nil + (-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. + + See also: ‘-drop-while’ (*note -drop-while::) + + (-take-while 'even? '(1 2 3 4)) + ⇒ nil + (-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 a copy of the tail of + LIST starting from its first element for which PRED returns nil. + + 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 the + items in LIST. + + If you want to select the original items satisfying a predicate use + ‘-filter’ (*note -filter::). + + (-keep 'cdr '((1 2 3) (4 5) (6))) + ⇒ '((2 3) (5)) + (-keep (lambda (num) (when (> num 3) (* 10 num))) '(1 2 3 4 5 6)) + ⇒ '(40 50 60) + (--keep (when (> it 3) (* 10 it)) '(1 2 3 4 5 6)) + ⇒ '(40 50 60) + + -- Function: -concat (&rest lists) + Return a new list with the concatenation of the elements in the + supplied LISTS. + + (-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) + Return a list with element at Nth position in LIST replaced with + ‘(func (nth n list))‘. + + 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 a list with element at Nth position in LIST removed. + + See also: ‘-remove-at-indices’ (*note -remove-at-indices::), + ‘-remove’ (*note -remove::) + + (-remove-at 0 '("0" "1" "2" "3" "4" "5")) + ⇒ '("1" "2" "3" "4" "5") + (-remove-at 1 '("0" "1" "2" "3" "4" "5")) + ⇒ '("0" "2" "3" "4" "5") + (-remove-at 2 '("0" "1" "2" "3" "4" "5")) + ⇒ '("0" "1" "3" "4" "5") + + -- Function: -remove-at-indices (indices list) + Return a list whose elements are elements from LIST without + elements selected as ‘(nth i list)‘ for all i from INDICES. + + See also: ‘-remove-at’ (*note -remove-at::), ‘-remove’ (*note + -remove::) + + (-remove-at-indices '(0) '("0" "1" "2" "3" "4" "5")) + ⇒ '("1" "2" "3" "4" "5") + (-remove-at-indices '(0 2 4) '("0" "1" "2" "3" "4" "5")) + ⇒ '("1" "3" "5") + (-remove-at-indices '(0 5) '("0" "1" "2" "3" "4" "5")) + ⇒ '("1" "2" "3" "4") + + +File: dash.info, Node: Reductions, Next: Unfolding, Prev: List to list, Up: Functions + +2.4 Reductions +============== + +Functions reducing lists into single value. + + -- Function: -reduce-from (fn initial-value list) + Return the result of applying FN to INITIAL-VALUE and the first + item in LIST, then applying FN to that result and the 2nd item, + etc. If LIST contains no items, return INITIAL-VALUE and do not + call FN. + + In the anaphoric form ‘--reduce-from’, the accumulated value is + exposed as symbol ‘acc’. + + See also: ‘-reduce’ (*note -reduce::), ‘-reduce-r’ (*note + -reduce-r::) + + (-reduce-from '- 10 '(1 2 3)) + ⇒ 4 + (-reduce-from (lambda (memo item) (format "(%s - %d)" memo item)) "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 initial-value list) + Replace conses with FN, nil with INITIAL-VALUE and evaluate the + resulting expression. If LIST is empty, INITIAL-VALUE is returned + and FN is not called. + + Note: this function works the same as ‘-reduce-from’ (*note + -reduce-from::) but the operation associates from right instead of + from left. + + See also: ‘-reduce-r’ (*note -reduce-r::), ‘-reduce’ (*note + -reduce::) + + (-reduce-r-from '- 10 '(1 2 3)) + ⇒ -8 + (-reduce-r-from (lambda (item memo) (format "(%d - %s)" item memo)) "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) + Return the result of applying FN to the first 2 items in LIST, then + applying FN to that result and the 3rd item, etc. If LIST contains + no items, return the result of calling FN with no arguments. If + LIST contains a single item, return that item and do not call FN. + + In the anaphoric form ‘--reduce’, the accumulated value is exposed + as symbol ‘acc’. + + See also: ‘-reduce-from’ (*note -reduce-from::), ‘-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) + Replace conses with FN and evaluate the resulting expression. The + final nil is ignored. If LIST contains no items, return the result + of calling FN with no arguments. If LIST contains a single item, + return that item and do not call FN. + + The first argument of FN is the new item, the second is the + accumulated value. + + Note: this function works the same as ‘-reduce’ (*note -reduce::) + but the operation associates from right instead of from left. + + See also: ‘-reduce-r-from’ (*note -reduce-r-from::), ‘-reduce’ + (*note -reduce::) + + (-reduce-r '- '(1 2 3 4)) + ⇒ -2 + (-reduce-r (lambda (item memo) (format "%s-%d" memo item)) '(1 2 3)) + ⇒ "3-2-1" + (--reduce-r (format "%s-%d" acc it) '(1 2 3)) + ⇒ "3-2-1" + + -- Function: -reductions-from (fn init list) + Return a list of the intermediate values of the reduction. + + See ‘-reduce-from’ (*note -reduce-from::) for explanation of the + arguments. + + See also: ‘-reductions’ (*note -reductions::), ‘-reductions-r’ + (*note -reductions-r::), ‘-reduce-r’ (*note -reduce-r::) + + (-reductions-from (lambda (a i) (format "(%s FN %d)" a i)) "INIT" '(1 2 3 4)) + ⇒ '("INIT" "(INIT FN 1)" "((INIT FN 1) FN 2)" "(((INIT FN 1) FN 2) FN 3)" "((((INIT FN 1) FN 2) FN 3) FN 4)") + (-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) + + -- Function: -reductions-r-from (fn init list) + Return a list of the intermediate values of the reduction. + + See ‘-reduce-r-from’ (*note -reduce-r-from::) for explanation of + the arguments. + + See also: ‘-reductions-r’ (*note -reductions-r::), ‘-reductions’ + (*note -reductions::), ‘-reduce’ (*note -reduce::) + + (-reductions-r-from (lambda (i a) (format "(%d FN %s)" i a)) "INIT" '(1 2 3 4)) + ⇒ '("(1 FN (2 FN (3 FN (4 FN INIT))))" "(2 FN (3 FN (4 FN INIT)))" "(3 FN (4 FN INIT))" "(4 FN INIT)" "INIT") + (-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) + + -- Function: -reductions (fn list) + Return a list of the intermediate values of the reduction. + + See ‘-reduce’ (*note -reduce::) for explanation of the arguments. + + See also: ‘-reductions-from’ (*note -reductions-from::), + ‘-reductions-r’ (*note -reductions-r::), ‘-reduce-r’ (*note + -reduce-r::) + + (-reductions (lambda (a i) (format "(%s FN %d)" a i)) '(1 2 3 4)) + ⇒ '(1 "(1 FN 2)" "((1 FN 2) FN 3)" "(((1 FN 2) FN 3) FN 4)") + (-reductions '+ '(1 2 3 4)) + ⇒ '(1 3 6 10) + (-reductions '* '(1 2 3 4)) + ⇒ '(1 2 6 24) + + -- Function: -reductions-r (fn list) + Return a list of the intermediate values of the reduction. + + See ‘-reduce-r’ (*note -reduce-r::) for explanation of the + arguments. + + See also: ‘-reductions-r-from’ (*note -reductions-r-from::), + ‘-reductions’ (*note -reductions::), ‘-reduce’ (*note -reduce::) + + (-reductions-r (lambda (i a) (format "(%d FN %s)" i a)) '(1 2 3 4)) + ⇒ '("(1 FN (2 FN (3 FN 4)))" "(2 FN (3 FN 4))" "(3 FN 4)" 4) + (-reductions-r '+ '(1 2 3 4)) + ⇒ '(10 9 7 4) + (-reductions-r '* '(1 2 3 4)) + ⇒ '(24 24 12 4) + + -- 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 + + -- 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 + + -- 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)) + ⇒ nil + (-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)) + ⇒ nil + (-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) + + +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)) + + +File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Functions + +2.6 Predicates +============== + + -- 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? 'even? '(1 2 3)) + ⇒ t + (-any? 'even? '(1 3 5)) + ⇒ 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. + + Alias: ‘-all-p’, ‘-every?’, ‘-every-p’ + + (-all? 'even? '(1 2 3)) + ⇒ nil + (-all? 'even? '(2 4 6)) + ⇒ t + (--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 at least one item of LIST matches PRED and at least + one item of LIST does not match PRED. Return ‘nil‘ both if all + items match the predicate or if none of the items match the + predicate. + + 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’s non-nil. + + Alias: ‘-contains-p’ + + (-contains? '(1 2 3) 1) + ⇒ t + (-contains? '(1 2 3) 2) + ⇒ t + (-contains? '(1 2 3) 4) + ⇒ nil + + -- Function: -same-items? (list list2) + Return true if LIST and LIST2 has the same items. + + The order of the elements in the lists does not matter. + + Alias: ‘-same-items-p’ + + (-same-items? '(1 2 3) '(1 2 3)) + ⇒ t + (-same-items? '(1 2 3) '(3 2 1)) + ⇒ t + (-same-items? '(1 2 3) '(1 2 3 4)) + ⇒ nil + + -- Function: -is-prefix? (prefix list) + Return non-nil if PREFIX is 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 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 + + +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) + Return a list of ((-take N LIST) (-drop N LIST)), in no more than + one pass through the list. + + (-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) + + -- Function: -split-with (pred list) + Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), + in no more than one pass through the 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) + Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one + pass through the 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) + Return a new list with the items in LIST grouped into N-sized + sublists at offsets STEP apart. 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) + Return a new list with the items in LIST grouped into N-sized + sublists at offsets STEP apart. The last 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 directly after each time PRED is true on an element of + LIST. + + (-partition-after-pred #'odd? '()) + ⇒ '() + (-partition-after-pred #'odd? '(1)) + ⇒ '((1)) + (-partition-after-pred #'odd? '(0 1)) + ⇒ '((0 1)) + + -- Function: -partition-before-pred (pred list) + Partition directly before each time PRED is true on an element of + LIST. + + (-partition-before-pred #'odd? '()) + ⇒ '() + (-partition-before-pred #'odd? '(1)) + ⇒ '((1)) + (-partition-before-pred #'odd? '(0 1)) + ⇒ '((0) (1)) + + -- 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 +============ + +Return indices of elements based on predicates, sort elements by indices +etc. + + -- Function: -elem-index (elem list) + Return the index of the first element in the given LIST which is + equal to the query element ELEM, or nil if there is no such + element. + + (-elem-index 2 '(6 7 8 2 3 4)) + ⇒ 3 + (-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 indices of all elements in LIST equal to the query + element ELEM, in ascending order. + + (-elem-indices 2 '(6 7 8 2 3 4 2 1)) + ⇒ '(3 6) + (-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) + Take a predicate PRED and a LIST and return the index of the first + element in the list satisfying the predicate, or nil if there is no + such element. + + See also ‘-first’ (*note -first::). + + (-find-index 'even? '(2 4 1 6 3 3 5 8)) + ⇒ 0 + (--find-index (< 5 it) '(2 4 1 6 3 3 5 8)) + ⇒ 3 + (-find-index (-partial 'string-lessp "baz") '("bar" "foo" "baz")) + ⇒ 1 + + -- Function: -find-last-index (pred list) + Take a predicate PRED and a LIST and return the index of the last + element in the list satisfying the predicate, or nil if there is no + such element. + + See also ‘-last’ (*note -last::). + + (-find-last-index 'even? '(2 4 1 6 3 3 5 8)) + ⇒ 7 + (--find-last-index (< 5 it) '(2 7 1 6 3 8 5 2)) + ⇒ 5 + (-find-last-index (-partial 'string-lessp "baz") '("q" "foo" "baz")) + ⇒ 1 + + -- Function: -find-indices (pred list) + Return the indices of all elements in LIST satisfying the predicate + PRED, in ascending order. + + (-find-indices 'even? '(2 4 1 6 3 3 5 8)) + ⇒ '(0 1 3 7) + (--find-indices (< 5 it) '(2 4 1 6 3 3 5 8)) + ⇒ '(3 7) + (-find-indices (-partial 'string-lessp "baz") '("bar" "foo" "baz")) + ⇒ '(1) + + -- Function: -grade-up (comparator list) + Grade elements of LIST using COMPARATOR relation, yielding 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, yielding 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 (list list2) + Return a new list containing the elements of LIST and elements of + LIST2 that are not in LIST. The test for equality is done with + ‘equal’, or with ‘-compare-fn’ if that’s non-nil. + + (-union '(1 2 3) '(3 4 5)) + ⇒ '(1 2 3 4 5) + (-union '(1 2 3 4) '()) + ⇒ '(1 2 3 4) + (-union '(1 1 2 2) '(3 2 1)) + ⇒ '(1 1 2 2 3) + + -- Function: -difference (list list2) + Return a new list with only the members of LIST that are not in + LIST2. The test for equality is done with ‘equal’, or with + ‘-compare-fn’ if that’s 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 (list list2) + Return a new list containing only the elements that are members of + both LIST and LIST2. The test for equality is done with ‘equal’, + or with ‘-compare-fn’ if that’s non-nil. + + (-intersection '() '()) + ⇒ '() + (-intersection '(1 2 3) '(4 5 6)) + ⇒ '() + (-intersection '(1 2 3 4) '(3 4 5 6)) + ⇒ '(3 4) + + -- Function: -powerset (list) + Return the power set of LIST. + + (-powerset '()) + ⇒ '(nil) + (-powerset '(x y z)) + ⇒ '((x y z) (x y) (x z) (x) (y z) (y) (z) nil) + + -- Function: -permutations (list) + Return the permutations of LIST. + + (-permutations '()) + ⇒ '(nil) + (-permutations '(1 2)) + ⇒ '((1 2) (2 1)) + (-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 new list with all duplicates removed. The test for + equality is done with ‘equal’, or with ‘-compare-fn’ if that’s + non-nil. + + Alias: ‘-uniq’ + + (-distinct '()) + ⇒ '() + (-distinct '(1 2 2 4)) + ⇒ '(1 2 4) + (-distinct '(t t t)) + ⇒ '(t) + + +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. With N negative, rotate to the + left. 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: -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) + ⇒ nil + + -- Function: -cons* (&rest args) + Make a new list from the elements of ARGS. + + The last 2 members of ARGS are used as the final cons of the result + so if the final member of ARGS is not a list the result is a dotted + list. + + (-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 ELEMENTS is non nil, append these 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: -zip-with (fn list1 list2) + Zip the two lists LIST1 and LIST2 using a function FN. This + function is applied pairwise taking as first argument element of + LIST1 and as second argument element of LIST2 at corresponding + position. + + The anaphoric form ‘--zip-with’ binds the elements from LIST1 as + symbol ‘it’, and the elements from LIST2 as symbol ‘other’. + + (-zip-with '+ '(1 2 3) '(4 5 6)) + ⇒ '(5 7 9) + (-zip-with 'cons '(1 2 3) '(4 5 6)) + ⇒ '((1 . 4) (2 . 5) (3 . 6)) + (--zip-with (concat it " and " other) '("Batman" "Jekyll") '("Robin" "Hyde")) + ⇒ '("Batman and Robin" "Jekyll and Hyde") + + -- Function: -zip (&rest lists) + Zip LISTS together. Group the head of each list, followed by the + second elements of each list, and so on. The lengths of the + returned groupings are equal to the length of the shortest input + list. + + If two lists are provided as arguments, return the groupings as a + list of cons cells. Otherwise, return the groupings as a list of + lists. + + Use ‘-zip-lists’ (*note -zip-lists::) if you need the return value + to always be a list of lists. + + Alias: ‘-zip-pair’ + + See also: ‘-zip-lists’ (*note -zip-lists::) + + (-zip '(1 2 3) '(4 5 6)) + ⇒ '((1 . 4) (2 . 5) (3 . 6)) + (-zip '(1 2 3) '(4 5 6 7)) + ⇒ '((1 . 4) (2 . 5) (3 . 6)) + (-zip '(1 2) '(3 4 5) '(6)) + ⇒ '((1 3 6)) + + -- Function: -zip-lists (&rest lists) + Zip LISTS together. Group the head of each list, followed by the + second elements of each list, and so on. The lengths of the + returned groupings are equal to the length of the shortest input + list. + + The return value is always list of lists, which is a difference + from ‘-zip-pair’ which returns a cons-cell in case two input lists + are provided. + + See also: ‘-zip’ (*note -zip::) + + (-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-fill (fill-value &rest lists) + Zip LISTS, with FILL-VALUE padded onto the shorter lists. The + lengths of the returned groupings are equal to the length of the + longest input list. + + (-zip-fill 0 '(1 2 3 4 5) '(6 7 8 9)) + ⇒ '((1 . 6) (2 . 7) (3 . 8) (4 . 9) (5 . 0)) + + -- Function: -unzip (lists) + Unzip LISTS. + + This works just like ‘-zip’ (*note -zip::) 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 the same length). + + Note in particular that calling this on a list of two lists will + return a list of cons-cells such that the above identity works. + + See also: ‘-zip’ (*note -zip::) + + (-unzip (-zip '(1 2 3) '(a b c) '("e" "f" "g"))) + ⇒ '((1 2 3) (a b c) ("e" "f" "g")) + (-unzip '((1 2) (3 4) (5 6) (7 8) (9 10))) + ⇒ '((1 3 5 7 9) (2 4 6 8 10)) + (-unzip '((1 2) (3 4))) + ⇒ '((1 . 3) (2 . 4)) + + -- 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 (-cycle '(1 2 3)) '(1 2)) + ⇒ '((1 . 1) (2 . 2)) + + -- Function: -pad (fill-value &rest lists) + Appends FILL-VALUE to the end of each list in LISTS such that they + will all have the same length. + + (-pad 0 '()) + ⇒ '(nil) + (-pad 0 '(1)) + ⇒ '((1)) + (-pad 0 '(1 2 3) '(4 5)) + ⇒ '((1 2 3) (4 5 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 x in LIST where (PRED x) is non-nil, else nil. + + To get the first item in the list no questions asked, use ‘car’. + + Alias: ‘-find’ + + (-first 'even? '(1 2 3)) + ⇒ 2 + (-first 'even? '(1 3 5)) + ⇒ nil + (-first 'null '(1 3 5)) + ⇒ nil + + -- Function: -some (pred list) + Return (PRED x) for the first LIST item where (PRED x) is non-nil, + else nil. + + Alias: ‘-any’ + + (-some 'even? '(1 2 3)) + ⇒ t + (-some 'null '(1 2 3)) + ⇒ nil + (-some 'null '(1 2 nil)) + ⇒ t + + -- 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::). + + (fn LIST) + + (-first-item '(1 2 3)) + ⇒ 1 + (-first-item nil) + ⇒ nil + (let ((list (list 1 2 3))) (setf (-first-item list) 5) list) + ⇒ '(5 2 3) + + -- Function: -second-item (arg1) + Return the second item of LIST, or nil if LIST is too short. + + See also: ‘-third-item’ (*note -third-item::). + + (fn LIST) + + (-second-item '(1 2 3)) + ⇒ 2 + (-second-item nil) + ⇒ nil + + -- Function: -third-item (arg1) + Return the third item of LIST, or nil if LIST is too short. + + See also: ‘-fourth-item’ (*note -fourth-item::). + + (fn LIST) + + (-third-item '(1 2 3)) + ⇒ 3 + (-third-item nil) + ⇒ nil + + -- Function: -fourth-item (list) + Return the fourth item of LIST, or nil if LIST is too short. + + See also: ‘-fifth-item’ (*note -fifth-item::). + + (-fourth-item '(1 2 3 4)) + ⇒ 4 + (-fourth-item nil) + ⇒ nil + + -- Function: -fifth-item (list) + Return the fifth item of LIST, or nil if LIST is too short. + + See also: ‘-last-item’ (*note -last-item::). + + (-fifth-item '(1 2 3 4 5)) + ⇒ 5 + (-fifth-item nil) + ⇒ nil + + -- Function: -last-item (list) + Return the last item of LIST, or nil on an empty list. + + (-last-item '(1 2 3)) + ⇒ 3 + (-last-item nil) + ⇒ nil + (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 (&rest args) + Return a list with ARGS. + + If first item of ARGS is already a list, simply return ARGS. If + not, return a list with ARGS as elements. + + (-list 1) + ⇒ '(1) + (-list 1 2 3) + ⇒ '(1 2 3) + (-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 4 5 6))) + ⇒ '((1) (2) (3) (4) (5) (6)) + (let ((data '(("starwars" "scifi") ("jedi" "starwars" "warrior")))) (--fix (-uniq (--mapcat (cons it (cdr (assoc it data))) 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) "}" '((elips-mode (foo (bar . booze)) (baz . qux)) (c-mode (foo . bla) (bum . bam))))) + ⇒ "{elips-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 '(1 2 3)) (b (-clone a))) (nreverse a) b) + ⇒ '(1 2 3) + + +File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions + +2.12 Threading macros +===================== + + -- 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--> (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--> "def" (concat "abc" it "ghi")) + ⇒ "abcdefghi" + (-some--> nil (concat "abc" it "ghi")) + ⇒ nil + (-some--> '(1 3 5) (-filter 'even? it) (append it it) (-map 'square it)) + ⇒ nil + + +File: dash.info, Node: Binding, Next: Side-effects, Prev: Threading macros, Up: Functions + +2.13 Binding +============ + +Convenient versions of ‘let‘ and ‘let*‘ constructs combined with 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::). + + (fn (VAR VAL) &rest BODY) + + (-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::). + + (fn (VAR VAL) THEN &rest ELSE) + + (-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 the description of 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 (&rest forms) + 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. + + (fn [MATCH-FORM VAL]...) + + (progn (-setq a 1) a) + ⇒ 1 + (progn (-setq (a b) (list 1 2)) (list a b)) + ⇒ '(1 2) + (progn (-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 with every item in LIST. Return nil, used for side-effects + only. + + (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item s))))) + ⇒ nil + (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item s)))) s) + ⇒ '(3 2 1) + (let (s) (--each '(1 2 3) (setq s (cons it s))) s) + ⇒ '(3 2 1) + + -- Function: -each-while (list pred fn) + Call FN with every item in LIST while (PRED item) is non-nil. + Return nil, used for side-effects only. + + (let (s) (-each-while '(2 4 5 6) 'even? (lambda (item) (push item s))) s) + ⇒ '(4 2) + (let (s) (--each-while '(1 2 3 4) (< it 3) (push it s)) s) + ⇒ '(2 1) + (let ((s 0)) (--each-while '(1 3 4 5) (odd? it) (setq s (+ s it))) s) + ⇒ 4 + + -- Function: -each-indexed (list fn) + Call (FN index item) for each item in LIST. + + In the anaphoric form ‘--each-indexed’, the index is exposed as + symbol ‘it-index’. + + See also: ‘-map-indexed’ (*note -map-indexed::). + + (let (s) (-each-indexed '(a b c) (lambda (index item) (setq s (cons (list item index) s)))) s) + ⇒ '((c 2) (b 1) (a 0)) + (let (s) (--each-indexed '(a b c) (setq s (cons (list it it-index) s))) s) + ⇒ '((c 2) (b 1) (a 0)) + + -- Function: -each-r (list fn) + Call FN with every item in LIST in reversed order. Return nil, + used for side-effects only. + + (let (s) (-each-r '(1 2 3) (lambda (item) (setq s (cons item s))))) + ⇒ nil + (let (s) (-each-r '(1 2 3) (lambda (item) (setq s (cons item s)))) s) + ⇒ '(1 2 3) + (let (s) (--each-r '(1 2 3) (setq s (cons it s))) s) + ⇒ '(1 2 3) + + -- Function: -each-r-while (list pred fn) + Call FN with every item in reversed LIST while (PRED item) is + non-nil. Return nil, used for side-effects only. + + (let (s) (-each-r-while '(2 4 5 6) 'even? (lambda (item) (!cons item s))) s) + ⇒ '(6) + (let (s) (--each-r-while '(1 2 3 4) (>= it 3) (!cons it s)) s) + ⇒ '(3 4) + + -- 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. + + (let (s) (-dotimes 3 (lambda (n) (push n s))) s) + ⇒ '(2 1 0) + (let (s) (-dotimes 0 (lambda (n) (push n s))) s) + ⇒ nil + (let (s) (--dotimes 5 (push it s)) s) + ⇒ '(4 3 2 1 0) + + -- Macro: -doto (init &rest forms) + Evaluate INIT and thread the result as the 2nd argument to other + FORMS. INIT is evaluated once. Its result is passed to FORMS, + which are then evaluated sequentially. Returns the target form. + + (-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: Destructive operations, Next: Function combinators, Prev: Side-effects, Up: Functions + +2.15 Destructive operations +=========================== + + -- 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 +========================= + +These combinators require Emacs 24 for its lexical scope. So they are +offered in a separate package: ‘dash-functional‘. + + -- Function: -partial (fn &rest args) + Take a function FN and fewer than the normal arguments to FN, and + return a fn that takes a variable number of additional ARGS. When + called, the returned function calls FN with ARGS first and then + additional args. + + (funcall (-partial '- 5) 3) + ⇒ 2 + (funcall (-partial '+ 5 2) 3) + ⇒ 10 + + -- Function: -rpartial (fn &rest args) + Takes a function FN and fewer than the normal arguments to FN, and + returns a fn that takes a variable number of additional ARGS. When + called, the returned function calls FN with the additional args + first and then ARGS. + + (funcall (-rpartial '- 5) 8) + ⇒ 3 + (funcall (-rpartial '- 5 2) 10) + ⇒ 3 + + -- Function: -juxt (&rest fns) + Takes a list of functions and returns a fn that is the + juxtaposition of those fns. The returned fn takes a variable + number of args, and returns a list containing the result of + applying each fn to the args (left-to-right). + + (funcall (-juxt '+ '-) 3 5) + ⇒ '(8 -2) + (-map (-juxt 'identity 'square) '(1 2 3)) + ⇒ '((1 1) (2 4) (3 9)) + + -- Function: -compose (&rest fns) + Takes a list of functions and returns a fn that is the composition + of those fns. The returned fn takes a variable number of + arguments, and returns the result of applying each fn to the result + of applying the previous fn to the arguments (right-to-left). + + (funcall (-compose 'square '+) 2 3) + ⇒ (square (+ 2 3)) + (funcall (-compose 'identity 'square) 3) + ⇒ (square 3) + (funcall (-compose 'square 'identity) 3) + ⇒ (square 3) + + -- Function: -applify (fn) + Changes an n-arity function FN to a 1-arity function that expects a + list with n items as arguments + + (-map (-applify '+) '((1 1 1) (1 2 3) (5 5 5))) + ⇒ '(3 6 15) + (-map (-applify (lambda (a b c) `(,a (,b (,c))))) '((1 1 1) (1 2 3) (5 5 5))) + ⇒ '((1 (1 (1))) (1 (2 (3))) (5 (5 (5)))) + (funcall (-applify '<) '(3 6)) + ⇒ t + + -- Function: -on (operator transformer) + Return a function of two arguments that first applies TRANSFORMER + to each of them and then applies OPERATOR on the results (in the + same order). + + In types: (b -> b -> c) -> (a -> b) -> a -> a -> c + + (-sort (-on '< 'length) '((1 2 3) (1) (1 2))) + ⇒ '((1) (1 2) (1 2 3)) + (-min-by (-on '> 'length) '((1 2 3) (4) (1 2))) + ⇒ '(4) + (-min-by (-on 'string-lessp 'number-to-string) '(2 100 22)) + ⇒ 22 + + -- Function: -flip (func) + Swap the order of arguments for binary function FUNC. + + In types: (a -> b -> c) -> b -> a -> c + + (funcall (-flip '<) 2 1) + ⇒ t + (funcall (-flip '-) 3 8) + ⇒ 5 + (-sort (-flip '<) '(4 3 6 1)) + ⇒ '(6 4 3 1) + + -- 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 + (-map (-const 1) '("a" "b" "c" "d")) + ⇒ '(1 1 1 1) + (-sum (-map (-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 'list 'vector 'string)) + ⇒ '((1 2 3) [1 2 3] "") + + -- Function: -not (pred) + Take a unary predicate PRED and return a unary predicate that + returns t if PRED returns nil and nil if PRED returns non-nil. + + (funcall (-not 'even?) 5) + ⇒ t + (-filter (-not (-partial '< 4)) '(1 2 3 4 5 6 7 8)) + ⇒ '(1 2 3 4) + + -- Function: -orfn (&rest preds) + Take list of unary predicates PREDS and return a unary predicate + with argument x that returns non-nil if at least one of the PREDS + returns non-nil on x. + + In types: [a -> Bool] -> a -> Bool + + (-filter (-orfn 'even? (-partial (-flip '<) 5)) '(1 2 3 4 5 6 7 8 9 10)) + ⇒ '(1 2 3 4 6 8 10) + (funcall (-orfn 'stringp 'even?) "foo") + ⇒ t + + -- Function: -andfn (&rest preds) + Take list of unary predicates PREDS and return a unary predicate + with argument x that returns non-nil if all of the PREDS returns + non-nil on x. + + In types: [a -> Bool] -> a -> Bool + + (funcall (-andfn (-cut < <> 10) 'even?) 6) + ⇒ t + (funcall (-andfn (-cut < <> 10) 'even?) 12) + ⇒ nil + (-filter (-andfn (-not 'even?) (-cut >= 5 <>)) '(1 2 3 4 5 6 7 8 9 10)) + ⇒ '(1 3 5) + + -- 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-equal) 0.7) + ⇒ 0.7390851332151607 + (funcall (-fixfn (lambda (x) (expt (+ x 10) 0.25))) 2.0) + ⇒ 1.8555845286409378 + (funcall (-fixfn 'sin 'approx-equal) 0.1) + ⇒ '(halted . t) + + -- Function: -prodfn (&rest fns) + Take a list of n functions and return a function that takes a list + of length n, applying i-th function to i-th 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) (7 8))) + ⇒ '((2 1) (4 3) (6 5) (8 7)) + (apply '+ (funcall (-prodfn 'length 'string-to-number) '((1 2 3) "15"))) + ⇒ 18 + + +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. +* Change log:: List of significant changes by version. +* Contributors:: List of contributors. + + +File: dash.info, Node: Contribute, Next: Change log, 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 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: Change log, Next: Contributors, Prev: Contribute, Up: Development + +3.2 Change log +============== + +Changes in 2.17: + + • Sped up ‘-uniq’ by using hash-tables when possible (Zhu + Zihao). + • Fixed ‘-inits’ to be non-destructive (Zach Shaftel). + • Fixed indent rules for ‘-some->’ and family (Wouter + Bolsterlee). + • Added ‘-zip-lists’ which always returns a list of proper + lists, even for two input lists (see issue #135). + +Changes in 2.16: + + • Added ‘--doto’, anaphoric version of ‘-doto’. + • Aliased ‘-cons-pair-p’ to ‘-cons-pair?’. + • Generalized ‘-rotate’ for |N| greater than the length of the + list (Brian Leung). + • Added a mechanism to extend destructuring with custom matchers + (Ivan Yonchovski). + +Changes in 2.15: + + This release brought new destructuring features, some new control + flow functions, and performance optimizations. + + • Added ‘-setq’ with destructuring binding support similar to + the ‘-let’ family. + • Added smarter key destructuring in ‘-let’ and friends where + variables are auto-derived from keys. + • Allowed ‘-let’ bindings without a source value form. + • Added ‘-each-r’ and ‘-each-r-while’ (Paul Pogonyshev). + • Added ‘-common-suffix’ (Basil L. Contovounesios). + • Improved performance of folds (‘-reduce’ and friends) (Basil + L. Contovounesios). + +Changes in 2.14: + + This release retired support for Emacs 23. + + • Added Edebug support for threading macros (Wilfred Hughes). + • Added ‘-unzip’. + • Added support for ‘-first-item’ and ‘-last-item’ as place + forms (*note (elisp)Generalized Variables::). + • Added ‘-powerset’ and ‘-permutations’ (Mark Oteiza). + • Added ‘-as->’ for threading a named variable (Zachary Kanfer). + • Added ‘-partition-after-pred’, ‘-partition-before-pred’, + ‘-partition-after-item’, and ‘-partition-before-item’ (Zachary + Kanfer). + • Fixed a bug in ‘-any-p’ and friends testing for ‘null’ on + lists containing ‘nil’. + • Fixed infinite loop bug in ‘-zip’ and ‘-interleave’ when + called with empty input. + • Added ‘-second-item’ through ‘-fifth-item’ as alternatives to + ‘nth’ (Wilfred Hughes). + • Added ‘-tails’ and ‘-inits’. + • Added ‘-running-sum’ and ‘-running-product’. + • Added the ‘-reductions[-r][-from]’ family of functions (like + ‘-reduce’ but collecting intermediate results). + • Added ‘-common-prefix’ (Basil L. Contovounesios). + +Changes in 2.13: + + • ‘-let’ now supports ‘&alist’ destructuring. + • Various performance improvements. + • ‘-zip’ might change in a future release to always return a + list of proper lists. Added ‘-zip-pair’ for users who + explicitly want the old behavior. + • Enabled lexical binding in ‘dash.el’ for Emacs versions 24 or + newer. + • Added ‘-select-column’ and ‘-select-columns’. + • Fixed ‘-map-last’ and ‘--remove-last’ to be non-destructive. + • Added ‘-each-indexed’ and ‘--each-indexed’. + • Added ‘-take-last’ and ‘-drop-last’. + • Added the ‘-doto’ macro. + • ‘-cut <>’ is now treated as a function, consistent with SRFI + 26 (https://srfi.schemers.org/srfi-26/srfi-26.html). + +Changes in 2.12: + + • Added GNU ELPA support (Phillip Lord). + • Added ‘-some->’, ‘-some->>’, and ‘-some-->’ macros (Cam Saul). + • ‘-is-suffix?’ is now non-destructive. + • Faster hash table implementation for ‘-union’. + • Improvements to docstrings and examples. + +Changes in 2.11: + + • Lots of clean up w.r.t. byte compilation, debug macros, and + tests. + +Changes in 2.10: + + • Added ‘-let’ destructuring to ‘-if-let’ and ‘-when-let’ + (Fredrik Bergroth). + +Changes in 2.9: + + • Added ‘-let’, ‘-let*’, and ‘-lambda’ with destructuring. + • Added ‘-tree-seq’ and ‘-tree-map-nodes’. + • Added ‘-non-nil’. + • Added ‘-fix’. + • Added ‘-fixfn’ (‘dash-functional’ version 1.2). + • Added ‘-copy’ (Wilfred Hughes). + +Changes in 2.8: + + • Added ‘-butlast’. + +Changes in 2.7: + + • ‘-zip’ now supports more than two lists (Steve Lamb). + • Added ‘-cycle’, ‘-pad’, ‘-annotate’, and ‘-zip-fill’ (Steve + Lamb). + • Added ‘-table’, ‘-table-flat’ (finite Cartesian product). + • Added ‘-flatten-n’. + • ‘-slice’ now supports a “step” argument. + • Added functional combinators ‘-iteratefn’ and ‘-prodfn’. + • Added ‘-replace’, ‘-splice’, and ‘-splice-list’ which + generalize ‘-replace-at’ and ‘-insert-at’. + • Added ‘-compose’, ‘-iteratefn’, and ‘-prodfn’ + (‘dash-functional’ version 1.1). + +Changes in 2.6: + + • Added ‘-is-prefix-p’, ‘-is-suffix-p’, and ‘-is-infix-p’ (Matus + Goljer). + • Added ‘-iterate’ and ‘-unfold’ (Matus Goljer). + • Added ‘-split-on’ and ‘-split-when’ (Matus Goljer). + • Added ‘-find-last-index’ (Matus Goljer). + • Added ‘-list’ (Johan Andersson). + +Changes in 2.5: + + • Added ‘-same-items?’ (Johan Andersson). + • Various bugfixes. + +Changes in 2.4: + + • Added ‘-snoc’ (Matus Goljer). + • Added ‘-replace-at’, ‘-update-at’, ‘-remove-at’, and + ‘-remove-at-indices’ (Matus Goljer). + +Changes in 2.3: + + • Added tree operations (Matus Goljer). + • Made Font Lock optional. + +Changes in 2.2: + + • Added ‘-compose’ (Christina Whyte). + +Changes in 2.1: + + • Added indexing operations (Matus Goljer). + +Changes in 2.0: + + • Split out ‘dash-functional.el’ (Matus Goljer). + • Added ‘-andfn’, ‘-orfn’, ‘-not’, ‘-cut’, ‘-const’, ‘-flip’, + and ‘-on’ (Matus Goljer). + • Fixed ‘-min’, ‘-max’, ‘-min-by’, and ‘-max-by’ (Matus Goljer). + +Changes in 1.8: + + • Added ‘-first-item’ and ‘-last-item’ (Wilfred Hughes). + +Changes in 1.7: + + • Added ‘-rotate’ (Matus Goljer). + +Changes in 1.6: + + • Added ‘-min’, ‘-max’, ‘-min-by’, and ‘-max-by’ (Johan + Andersson). + +Changes in 1.5: + + • Added ‘-sum’ and ‘-product’ (Johan Andersson). + +Changes in 1.4: + + • Added ‘-sort’. + • Added ‘-reduce-r’ (Matus Goljer). + • Added ‘-reduce-r-from’ (Matus Goljer). + +Changes in 1.3: + + • Added ‘-partition-in-steps’. + • Added ‘-partition-all-in-steps’. + +Changes in 1.2: + + • Added ‘-last’ (Matus Goljer). + • Added ‘-insert-at’ (Emanuel Evans). + • Added ‘-when-let’ and ‘-if-let’ (Emanuel Evans). + • Added ‘-when-let*’ and ‘-if-let*’ (Emanuel Evans). + • Various bugfixes. + + +File: dash.info, Node: Contributors, Prev: Change log, Up: Development + +3.3 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 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’. + • 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 14) +* !cons: Destructive operations. + (line 6) +* -->: Threading macros. (line 32) +* ->: Threading macros. (line 6) +* ->>: Threading macros. (line 19) +* -all?: Predicates. (line 18) +* -andfn: Function combinators. + (line 138) +* -annotate: Maps. (line 79) +* -any?: Predicates. (line 6) +* -applify: Function combinators. + (line 55) +* -as->: Threading macros. (line 46) +* -butlast: Other list operations. + (line 340) +* -clone: Tree operations. (line 122) +* -common-prefix: Reductions. (line 223) +* -common-suffix: Reductions. (line 233) +* -compose: Function combinators. + (line 42) +* -concat: List to list. (line 22) +* -cons*: Other list operations. + (line 30) +* -const: Function combinators. + (line 92) +* -contains?: Predicates. (line 57) +* -copy: Maps. (line 134) +* -count: Reductions. (line 151) +* -cut: Function combinators. + (line 104) +* -cycle: Other list operations. + (line 168) +* -difference: Set operations. (line 20) +* -distinct: Set operations. (line 62) +* -dotimes: Side-effects. (line 63) +* -doto: Side-effects. (line 75) +* -drop: Sublist selection. (line 128) +* -drop-last: Sublist selection. (line 142) +* -drop-while: Sublist selection. (line 171) +* -each: Side-effects. (line 8) +* -each-indexed: Side-effects. (line 30) +* -each-r: Side-effects. (line 43) +* -each-r-while: Side-effects. (line 54) +* -each-while: Side-effects. (line 19) +* -elem-index: Indexing. (line 9) +* -elem-indices: Indexing. (line 21) +* -fifth-item: Other list operations. + (line 320) +* -filter: Sublist selection. (line 8) +* -find-index: Indexing. (line 32) +* -find-indices: Indexing. (line 60) +* -find-last-index: Indexing. (line 46) +* -first: Other list operations. + (line 234) +* -first-item: Other list operations. + (line 271) +* -fix: Other list operations. + (line 376) +* -fixfn: Function combinators. + (line 175) +* -flatten: List to list. (line 33) +* -flatten-n: List to list. (line 55) +* -flip: Function combinators. + (line 80) +* -fourth-item: Other list operations. + (line 310) +* -grade-down: Indexing. (line 81) +* -grade-up: Indexing. (line 71) +* -group-by: Partitioning. (line 187) +* -if-let: Binding. (line 36) +* -if-let*: Binding. (line 49) +* -inits: Reductions. (line 203) +* -insert-at: List to list. (line 109) +* -interleave: Other list operations. + (line 68) +* -interpose: Other list operations. + (line 58) +* -intersection: Set operations. (line 32) +* -is-infix?: Predicates. (line 110) +* -is-prefix?: Predicates. (line 86) +* -is-suffix?: Predicates. (line 98) +* -iterate: Unfolding. (line 9) +* -iteratefn: Function combinators. + (line 152) +* -juxt: Function combinators. + (line 31) +* -keep: List to list. (line 8) +* -lambda: Binding. (line 251) +* -last: Other list operations. + (line 261) +* -last-item: Other list operations. + (line 330) +* -let: Binding. (line 65) +* -let*: Binding. (line 231) +* -list: Other list operations. + (line 363) +* -map: Maps. (line 10) +* -map-first: Maps. (line 37) +* -map-indexed: Maps. (line 65) +* -map-last: Maps. (line 51) +* -map-when: Maps. (line 21) +* -mapcat: Maps. (line 123) +* -max: Reductions. (line 267) +* -max-by: Reductions. (line 277) +* -min: Reductions. (line 243) +* -min-by: Reductions. (line 253) +* -non-nil: Sublist selection. (line 79) +* -none?: Predicates. (line 30) +* -not: Function combinators. + (line 117) +* -on: Function combinators. + (line 66) +* -only-some?: Predicates. (line 42) +* -orfn: Function combinators. + (line 126) +* -pad: Other list operations. + (line 179) +* -partial: Function combinators. + (line 9) +* -partition: Partitioning. (line 74) +* -partition-after-item: Partitioning. (line 177) +* -partition-after-pred: Partitioning. (line 145) +* -partition-all: Partitioning. (line 86) +* -partition-all-in-steps: Partitioning. (line 109) +* -partition-before-item: Partitioning. (line 167) +* -partition-before-pred: Partitioning. (line 156) +* -partition-by: Partitioning. (line 121) +* -partition-by-header: Partitioning. (line 132) +* -partition-in-steps: Partitioning. (line 97) +* -permutations: Set operations. (line 52) +* -powerset: Set operations. (line 44) +* -prodfn: Function combinators. + (line 209) +* -product: Reductions. (line 181) +* -reduce: Reductions. (line 46) +* -reduce-from: Reductions. (line 8) +* -reduce-r: Reductions. (line 65) +* -reduce-r-from: Reductions. (line 27) +* -reductions: Reductions. (line 119) +* -reductions-from: Reductions. (line 87) +* -reductions-r: Reductions. (line 135) +* -reductions-r-from: Reductions. (line 103) +* -remove: Sublist selection. (line 23) +* -remove-at: List to list. (line 145) +* -remove-at-indices: List to list. (line 158) +* -remove-first: Sublist selection. (line 37) +* -remove-item: Sublist selection. (line 67) +* -remove-last: Sublist selection. (line 52) +* -repeat: Other list operations. + (line 19) +* -replace: List to list. (line 67) +* -replace-at: List to list. (line 120) +* -replace-first: List to list. (line 81) +* -replace-last: List to list. (line 95) +* -rotate: Other list operations. + (line 8) +* -rpartial: Function combinators. + (line 20) +* -running-product: Reductions. (line 191) +* -running-sum: Reductions. (line 169) +* -same-items?: Predicates. (line 72) +* -second-item: Other list operations. + (line 286) +* -select-by-indices: Sublist selection. (line 185) +* -select-column: Sublist selection. (line 215) +* -select-columns: Sublist selection. (line 196) +* -separate: Partitioning. (line 63) +* -setq: Binding. (line 273) +* -slice: Sublist selection. (line 85) +* -snoc: Other list operations. + (line 44) +* -some: Other list operations. + (line 248) +* -some-->: Threading macros. (line 83) +* -some->: Threading macros. (line 59) +* -some->>: Threading macros. (line 71) +* -sort: Other list operations. + (line 350) +* -splice: Maps. (line 90) +* -splice-list: Maps. (line 110) +* -split-at: Partitioning. (line 8) +* -split-on: Partitioning. (line 28) +* -split-when: Partitioning. (line 46) +* -split-with: Partitioning. (line 17) +* -sum: Reductions. (line 159) +* -table: Other list operations. + (line 190) +* -table-flat: Other list operations. + (line 209) +* -tails: Reductions. (line 213) +* -take: Sublist selection. (line 101) +* -take-last: Sublist selection. (line 114) +* -take-while: Sublist selection. (line 156) +* -third-item: Other list operations. + (line 298) +* -tree-map: Tree operations. (line 28) +* -tree-map-nodes: Tree operations. (line 39) +* -tree-mapreduce: Tree operations. (line 84) +* -tree-mapreduce-from: Tree operations. (line 103) +* -tree-reduce: Tree operations. (line 52) +* -tree-reduce-from: Tree operations. (line 69) +* -tree-seq: Tree operations. (line 8) +* -unfold: Unfolding. (line 25) +* -union: Set operations. (line 8) +* -unzip: Other list operations. + (line 146) +* -update-at: List to list. (line 132) +* -when-let: Binding. (line 9) +* -when-let*: Binding. (line 23) +* -zip: Other list operations. + (line 95) +* -zip-fill: Other list operations. + (line 138) +* -zip-lists: Other list operations. + (line 119) +* -zip-with: Other list operations. + (line 79) +* dash-fontify-mode: Fontification of special variables. + (line 6) +* global-dash-fontify-mode: Fontification of special variables. + (line 12) + + + +Tag Table: +Node: Top742 +Node: Installation2397 +Node: Using in a package3162 +Node: Fontification of special variables3662 +Node: Functions4425 +Node: Maps5909 +Ref: -map6204 +Ref: -map-when6545 +Ref: -map-first7123 +Ref: -map-last7601 +Ref: -map-indexed8074 +Ref: -annotate8554 +Ref: -splice9044 +Ref: -splice-list9825 +Ref: -mapcat10287 +Ref: -copy10663 +Node: Sublist selection10867 +Ref: -filter11060 +Ref: -remove11512 +Ref: -remove-first11918 +Ref: -remove-last12445 +Ref: -remove-item12966 +Ref: -non-nil13361 +Ref: -slice13520 +Ref: -take14052 +Ref: -take-last14461 +Ref: -drop14894 +Ref: -drop-last15324 +Ref: -take-while15752 +Ref: -drop-while16278 +Ref: -select-by-indices16802 +Ref: -select-columns17316 +Ref: -select-column18022 +Node: List to list18486 +Ref: -keep18678 +Ref: -concat19181 +Ref: -flatten19478 +Ref: -flatten-n20237 +Ref: -replace20624 +Ref: -replace-first21087 +Ref: -replace-last21584 +Ref: -insert-at22074 +Ref: -replace-at22401 +Ref: -update-at22791 +Ref: -remove-at23282 +Ref: -remove-at-indices23770 +Node: Reductions24352 +Ref: -reduce-from24521 +Ref: -reduce-r-from25287 +Ref: -reduce26054 +Ref: -reduce-r26783 +Ref: -reductions-from27654 +Ref: -reductions-r-from28369 +Ref: -reductions29094 +Ref: -reductions-r29719 +Ref: -count30354 +Ref: -sum30578 +Ref: -running-sum30767 +Ref: -product31060 +Ref: -running-product31269 +Ref: -inits31582 +Ref: -tails31830 +Ref: -common-prefix32077 +Ref: -common-suffix32374 +Ref: -min32671 +Ref: -min-by32897 +Ref: -max33420 +Ref: -max-by33645 +Node: Unfolding34173 +Ref: -iterate34414 +Ref: -unfold34864 +Node: Predicates35672 +Ref: -any?35796 +Ref: -all?36116 +Ref: -none?36446 +Ref: -only-some?36748 +Ref: -contains?37233 +Ref: -same-items?37622 +Ref: -is-prefix?38007 +Ref: -is-suffix?38330 +Ref: -is-infix?38653 +Node: Partitioning39007 +Ref: -split-at39195 +Ref: -split-with39480 +Ref: -split-on39883 +Ref: -split-when40559 +Ref: -separate41199 +Ref: -partition41641 +Ref: -partition-all42093 +Ref: -partition-in-steps42521 +Ref: -partition-all-in-steps43018 +Ref: -partition-by43503 +Ref: -partition-by-header43885 +Ref: -partition-after-pred44489 +Ref: -partition-before-pred44833 +Ref: -partition-before-item45184 +Ref: -partition-after-item45495 +Ref: -group-by45801 +Node: Indexing46238 +Ref: -elem-index46440 +Ref: -elem-indices46835 +Ref: -find-index47218 +Ref: -find-last-index47707 +Ref: -find-indices48211 +Ref: -grade-up48619 +Ref: -grade-down49022 +Node: Set operations49432 +Ref: -union49615 +Ref: -difference50057 +Ref: -intersection50474 +Ref: -powerset50911 +Ref: -permutations51124 +Ref: -distinct51424 +Node: Other list operations51802 +Ref: -rotate52027 +Ref: -repeat52397 +Ref: -cons*52678 +Ref: -snoc53065 +Ref: -interpose53478 +Ref: -interleave53776 +Ref: -zip-with54145 +Ref: -zip54862 +Ref: -zip-lists55694 +Ref: -zip-fill56395 +Ref: -unzip56718 +Ref: -cycle57463 +Ref: -pad57865 +Ref: -table58188 +Ref: -table-flat58977 +Ref: -first59985 +Ref: -some60357 +Ref: -last60666 +Ref: -first-item61000 +Ref: -second-item61416 +Ref: -third-item61696 +Ref: -fourth-item61974 +Ref: -fifth-item62240 +Ref: -last-item62502 +Ref: -butlast62794 +Ref: -sort63041 +Ref: -list63530 +Ref: -fix63861 +Node: Tree operations64401 +Ref: -tree-seq64597 +Ref: -tree-map65455 +Ref: -tree-map-nodes65898 +Ref: -tree-reduce66748 +Ref: -tree-reduce-from67630 +Ref: -tree-mapreduce68231 +Ref: -tree-mapreduce-from69091 +Ref: -clone70377 +Node: Threading macros70705 +Ref: ->70850 +Ref: ->>71341 +Ref: -->71846 +Ref: -as->72402 +Ref: -some->72857 +Ref: -some->>73231 +Ref: -some-->73667 +Node: Binding74138 +Ref: -when-let74350 +Ref: -when-let*74835 +Ref: -if-let75358 +Ref: -if-let*75753 +Ref: -let76370 +Ref: -let*82445 +Ref: -lambda83385 +Ref: -setq84181 +Node: Side-effects84997 +Ref: -each85191 +Ref: -each-while85598 +Ref: -each-indexed86056 +Ref: -each-r86574 +Ref: -each-r-while87007 +Ref: -dotimes87382 +Ref: -doto87872 +Node: Destructive operations88353 +Ref: !cons88526 +Ref: !cdr88732 +Node: Function combinators88927 +Ref: -partial89201 +Ref: -rpartial89595 +Ref: -juxt89998 +Ref: -compose90430 +Ref: -applify90983 +Ref: -on91414 +Ref: -flip91940 +Ref: -const92252 +Ref: -cut92591 +Ref: -not93077 +Ref: -orfn93387 +Ref: -andfn93821 +Ref: -iteratefn94316 +Ref: -fixfn95019 +Ref: -prodfn96582 +Node: Development97642 +Node: Contribute97995 +Node: Change log99001 +Node: Contributors106539 +Node: FDL108557 +Node: GPL133877 +Node: Index171626 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/dash-20210105.414/dir b/elpa/dash-20210105.414/dir new file mode 100644 index 00000000..7d473f49 --- /dev/null +++ b/elpa/dash-20210105.414/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-20200105.1259/smartparens-autoloads.el b/elpa/smartparens-20200105.1259/smartparens-autoloads.el deleted file mode 100644 index f433e335..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-autoloads.el +++ /dev/null @@ -1,330 +0,0 @@ -;;; smartparens-autoloads.el --- automatically extracted autoloads -;; -;;; 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'. - -\(fn)" t nil) - -(autoload 'sp-use-smartparens-bindings "smartparens" "\ -Initiate `smartparens-mode-map' with `sp-smartparens-bindings'. - -\(fn)" t nil) - -(autoload 'smartparens-mode "smartparens" "\ -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} - -\(fn &optional ARG)" t nil) - -(autoload 'smartparens-strict-mode "smartparens" "\ -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. - -\(fn &optional ARG)" t nil) - -(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, enable the mode if -ARG is omitted or nil. - -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'. - -\(fn)" t nil) - -(autoload 'turn-off-smartparens-strict-mode "smartparens" "\ -Turn off `smartparens-strict-mode'. - -\(fn)" t nil) - -(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, enable the mode if -ARG is omitted or nil. - -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'. - -\(fn)" t nil) - -(autoload 'turn-off-smartparens-mode "smartparens" "\ -Turn off `smartparens-mode'. - -\(fn)" 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. - -\(fn &optional ARG)" t nil) - -(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, enable the mode if -ARG is omitted or nil. - -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'. - -\(fn)" t nil) - -(autoload 'turn-off-show-smartparens-mode "smartparens" "\ -Turn off `show-smartparens-mode'. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens" '("smartparens-" "sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-clojure" "smartparens-clojure.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-clojure.el - -(if (fboundp 'register-definition-prefixes) (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 - -(if (fboundp 'register-definition-prefixes) (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 - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-crystal" '("sp-crystal-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-elixir" "smartparens-elixir.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-elixir.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-elixir" '("sp-elixir-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-ess" "smartparens-ess.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-ess.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-ess" '("sp-ess-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-haskell" "smartparens-haskell.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-haskell.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-haskell" '("sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-html" "smartparens-html.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-html.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-html" '("sp-html-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-latex" "smartparens-latex.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-latex.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-latex" '("sp-latex-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-lua" "smartparens-lua.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-lua.el - -(if (fboundp 'register-definition-prefixes) (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 - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-markdown" '("sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-org" "smartparens-org.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from smartparens-org.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-org" '("sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-python" "smartparens-python.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-python.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-python" '("sp-python-fix-tripple-quotes"))) - -;;;*** - -;;;### (autoloads nil "smartparens-ruby" "smartparens-ruby.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-ruby.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-ruby" '("sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-rust" "smartparens-rust.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-rust.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-rust" '("sp-"))) - -;;;*** - -;;;### (autoloads nil "smartparens-scala" "smartparens-scala.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from smartparens-scala.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-scala" '("sp-scala-wrap-with-indented-newlines"))) - -;;;*** - -;;;### (autoloads nil "smartparens-text" "smartparens-text.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from smartparens-text.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-text" '("sp-text-mode-"))) - -;;;*** - -;;;### (autoloads nil nil ("smartparens-c.el" "smartparens-javascript.el" -;;;;;; "smartparens-ml.el" "smartparens-pkg.el" "smartparens-racket.el" -;;;;;; "smartparens-rst.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-20200105.1259/smartparens-c.el b/elpa/smartparens-20200105.1259/smartparens-c.el deleted file mode 100644 index 58216a83..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-clojure.el b/elpa/smartparens-20200105.1259/smartparens-clojure.el deleted file mode 100644 index e07e650d..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-config.el b/elpa/smartparens-20200105.1259/smartparens-config.el deleted file mode 100644 index 1d2e4b0b..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-config.el +++ /dev/null @@ -1,134 +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. - -(--each sp-c-modes - (eval-after-load it '(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 '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 'scala-mode '(require 'smartparens-scala)) -(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-20200105.1259/smartparens-crystal.el b/elpa/smartparens-20200105.1259/smartparens-crystal.el deleted file mode 100644 index 574ac8ea..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-elixir.el b/elpa/smartparens-20200105.1259/smartparens-elixir.el deleted file mode 100644 index 8411162c..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-elixir.el +++ /dev/null @@ -1,135 +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 ""))) - -(defun sp-elixir-def-p (id) - "Return non-nil if the \"do\" keyword is part of definition. - -ID is the opening delimiter. - -Definitions are the constructions of the form defmodule-do-end, -def-do-end and similar pairs." - (save-excursion - (when (equal "do" id) - (back-to-indentation) - (looking-at (regexp-opt '( - "defmodule" - "defmacro" - "defmacrop" - "quote" - "def" - "defp" - "if" - "unless" - "case" - "cond" - "with" - "for" - "receive" - "try" - )))))) - -(defun sp-elixir-skip-def-p (ms _mb _me) - "Test if \"do\" is part of definition. -MS, MB, ME." - (sp-elixir-def-p ms)) - -(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) - :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) - :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) - :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) - :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) - :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) - :unless '(sp-in-comment-p sp-in-string-p)) - (sp-local-pair "receive" "end" - :when '(("RET" "")) - :post-handlers '(sp-elixir-empty-do-block-post-handler)) - ) - -(provide 'smartparens-elixir) -;;; smartparens-elixir.el ends here diff --git a/elpa/smartparens-20200105.1259/smartparens-ess.el b/elpa/smartparens-20200105.1259/smartparens-ess.el deleted file mode 100644 index 3bac0b5f..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-ess.el +++ /dev/null @@ -1,228 +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") - - -;; avoid traveling commas when slurping -;; (|a, b), c ---> (|a, b, c) -(dolist (mode '(ess-mode inferior-ess-mode)) - (add-to-list 'sp-sexp-suffix (list mode 'regexp ""))) - -;; `sp-sexp-prefix' for ESS -(add-to-list 'sp-sexp-prefix - (list 'ess-mode 'regexp - (rx (zero-or-more (or word (syntax symbol)))))) - -;; 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 (boundp '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 "{[^}]*}")) - - -(provide 'smartparens-ess) -;;; smartparens-ess ends here diff --git a/elpa/smartparens-20200105.1259/smartparens-haskell.el b/elpa/smartparens-20200105.1259/smartparens-haskell.el deleted file mode 100644 index 47a9ab58..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-html.el b/elpa/smartparens-20200105.1259/smartparens-html.el deleted file mode 100644 index 3ba64060..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-javascript.el b/elpa/smartparens-20200105.1259/smartparens-javascript.el deleted file mode 100644 index aa024d68..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-latex.el b/elpa/smartparens-20200105.1259/smartparens-latex.el deleted file mode 100644 index 61d9a00c..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-lua.el b/elpa/smartparens-20200105.1259/smartparens-lua.el deleted file mode 100644 index 29621a6c..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-markdown.el b/elpa/smartparens-20200105.1259/smartparens-markdown.el deleted file mode 100644 index b097fb5d..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-ml.el b/elpa/smartparens-20200105.1259/smartparens-ml.el deleted file mode 100644 index 7960c5f1..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-ml.el +++ /dev/null @@ -1,76 +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 "(*" "*)" )) - -;; 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-20200105.1259/smartparens-org.el b/elpa/smartparens-20200105.1259/smartparens-org.el deleted file mode 100644 index 87dfeca3..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-pkg.el b/elpa/smartparens-20200105.1259/smartparens-pkg.el deleted file mode 100644 index 1fd39009..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-pkg.el +++ /dev/null @@ -1,6 +0,0 @@ -(define-package "smartparens" "20200105.1259" "Automatic insertion, wrapping and paredit-like navigation with user defined pairs." - '((dash "2.13.0") - (cl-lib "0.3"))) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/smartparens-20200105.1259/smartparens-python.el b/elpa/smartparens-20200105.1259/smartparens-python.el deleted file mode 100644 index d6ac93ff..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-python.el +++ /dev/null @@ -1,92 +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) - -;; 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 ""))) - -(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 "\"\"\"" "\"\"\"")) - -(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-20200105.1259/smartparens-racket.el b/elpa/smartparens-20200105.1259/smartparens-racket.el deleted file mode 100644 index 08af6760..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-rst.el b/elpa/smartparens-20200105.1259/smartparens-rst.el deleted file mode 100644 index b1e25f8a..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-rst.el +++ /dev/null @@ -1,62 +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) - -(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-local-pair "``" "``")) - -(provide 'smartparens-rst) -;;; smartparens-rst.el ends here diff --git a/elpa/smartparens-20200105.1259/smartparens-ruby.el b/elpa/smartparens-20200105.1259/smartparens-ruby.el deleted file mode 100644 index ed504842..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-ruby.el +++ /dev/null @@ -1,412 +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)) - (end-line (line-number-at-pos :end-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-20200105.1259/smartparens-rust.el b/elpa/smartparens-20200105.1259/smartparens-rust.el deleted file mode 100644 index e3f46ceb..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens-scala.el b/elpa/smartparens-20200105.1259/smartparens-scala.el deleted file mode 100644 index 7e79016d..00000000 --- a/elpa/smartparens-20200105.1259/smartparens-scala.el +++ /dev/null @@ -1,80 +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) - (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)) - -(provide 'smartparens-scala) -;;; smartparens-scala.el ends here diff --git a/elpa/smartparens-20200105.1259/smartparens-text.el b/elpa/smartparens-20200105.1259/smartparens-text.el deleted file mode 100644 index 91c07be1..00000000 --- a/elpa/smartparens-20200105.1259/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-20200105.1259/smartparens.el b/elpa/smartparens-20200105.1259/smartparens.el deleted file mode 100644 index fea2d3ee..00000000 --- a/elpa/smartparens-20200105.1259/smartparens.el +++ /dev/null @@ -1,9609 +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")) 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))) - - -;;;###autoload -(defvar smartparens-mode-map (make-sparse-keymap) - "Keymap used for `smartparens-mode'.") -(defvaralias 'sp-keymap 'smartparens-mode-map) -(make-obsolete-variable 'sp-keymap 'smartparens-mode-map "2015-01-01") - -(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 sp-escape-char nil - "Character used to escape quotes inside strings.") -(make-variable-buffer-local 'sp-escape-char) - -(defvar sp-comment-char nil - "Character used to start comments.") -(make-variable-buffer-local 'sp-comment-char) - -(defvar sp-pair-list nil - "List of pairs for autoinsertion or wrapping. - -Maximum length of opening or closing pair is -`sp-max-pair-length' characters.") -(make-variable-buffer-local 'sp-pair-list) - -(defvar sp-local-pairs nil - "List of pair definitions used for current buffer.") -(make-variable-buffer-local 'sp-local-pairs) - -(defvar sp-last-operation nil - "Symbol holding the last successful operation.") -(make-variable-buffer-local 'sp-last-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 sp-state (make-sp-state) - "Smartparens state for the current buffer.") -(make-variable-buffer-local 'sp-state) - -;; TODO: get rid of this -(defvar 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!") -(make-variable-buffer-local 'sp-previous-point) - -;; TODO: get rid of this -(defvar 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.") -(make-variable-buffer-local 'sp-wrap-point) - -;; TODO: get rid of this -(defvar 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.") -(make-variable-buffer-local 'sp-wrap-mark) - -(defvar 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.") -(make-variable-buffer-local 'sp-last-inserted-characters) - -(defvar sp-last-inserted-pair nil - "Last inserted pair.") -(make-variable-buffer-local 'sp-last-inserted-pair) - -(defvar 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)") -(make-variable-buffer-local 'sp-delayed-pair) - -(defvar sp-last-wrapped-region nil - "Information about the last wrapped region. -The format is the same as returned by `sp-get-sexp'.") -(make-variable-buffer-local 'sp-last-wrapped-region) - -(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 - 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 - 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 (-find-indices (lambda (it) (eq (car it) 'smartparens-strict-mode)) minor-mode-overriding-map-alist) - (setq minor-mode-overriding-map-alist - (cons `(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 - (-remove (lambda (it) (eq (car it) '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-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)))))) - -(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'." - (let ((parent-modes (-fix (lambda (x) - (--if-let (get (car x) 'derived-mode-parent) - (cons it x) - x)) - (list major-mode)))) - ;; Combine all the definitions from the most ancient parent to the - ;; most recent parent - (--each parent-modes (sp-update-local-pairs it)))) - -(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." - (let ((ind 0)) - (--each new-pair - (when (= 0 (% ind 2)) - (sp--merge-prop it new-pair old-pair)) - (setq ind (1+ ind)))) - 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." - (let ((ind 0)) - (--each new-pair - (when (= 0 (% ind 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)))) - (setq ind (1+ ind)))) - 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))) - (if prop - (cond - ((eq prop :op-l) - (length (plist-get pair :open))) - ((eq prop :cl-l) - (length (plist-get pair :close))) - ((eq prop :len) - (+ (length (plist-get pair :open)) (length (plist-get pair :close)))) - ((eq prop :post-handlers) - (--filter (not (listp it)) (plist-get pair prop))) - ((eq prop :post-handlers-cond) - (--filter (listp it) (plist-get pair :post-handlers))) - ((eq prop :when) - (--filter (not (listp it)) (plist-get pair :when))) - ((eq prop :when-cond) - (-flatten (-concat (--filter (listp it) (plist-get pair :when))))) - (t (plist-get pair prop))) - pair))) - -(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 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.") -(make-variable-buffer-local 'sp-pair-overlay-list) - -(defvar sp-wrap-overlays nil - "Cons pair of wrap overlays.") -(make-variable-buffer-local 'sp-wrap-overlays) - -(defvar sp-wrap-tag-overlays nil - "Cons pair of tag wrap overlays.") -(make-variable-buffer-local 'sp-wrap-tag-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) - (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 (char-syntax (aref id 0)) ?\")) - (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)) - (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 - (when (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 - (when (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--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)) - (allowed-open (sp--get-opening-regexp (sp--get-allowed-pair-list))) - (allowed-close (sp--get-closing-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)) - (progn - (setq prefix (,prefix-fn)) - (> (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)))))))) - -(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))))) - (memq (char-syntax (following-char)) '(?w ?_))) - (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)))) - (memq (char-syntax (preceding-char)) '(?w ?_))) - (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 (items (sp-get-list-items)) - (let ((op (sp-get (car items) :op)) - (cl (sp-get (car items) :cl)) - (beg (sp-get (car items) :beg)) - (end (sp-get (car items) :end))) - (!cdr items) - (setq items (nreverse items)) - (save-excursion - (goto-char end) - (delete-char (- (length cl))) - (while items - (sp-get (car items) - (goto-char :end) - (insert cl) - (goto-char :beg) - (insert op)) - (!cdr items)) - (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 (1- (cdr (sp-get-quoted-string-bounds)))) - (sp-get-enclosing-sexp 1)) - (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)))) - -(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 - (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-20201229.1937/smartparens-autoloads.el b/elpa/smartparens-20201229.1937/smartparens-autoloads.el new file mode 100644 index 00000000..04931a77 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-autoloads.el @@ -0,0 +1,351 @@ +;;; smartparens-autoloads.el --- automatically extracted autoloads +;; +;;; 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. + +If called interactively, enable Smartparens mode if ARG is +positive, and disable it if ARG is zero or negative. If called +from Lisp, also enable the mode if ARG is omitted or nil, and +toggle it if ARG is `toggle'; disable the mode otherwise. + +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. + +If called interactively, enable Smartparens-Strict mode if ARG is +positive, and disable it if ARG is zero or negative. If called +from Lisp, also enable the mode if ARG is omitted or nil, and +toggle it if ARG is `toggle'; disable the mode otherwise. + +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, enable the mode if +ARG is omitted or nil. + +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, enable the mode if +ARG is omitted or nil. + +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. + +If called interactively, enable Show-Smartparens mode if ARG is +positive, and disable it if ARG is zero or negative. If called +from Lisp, also enable the mode if ARG is omitted or nil, and +toggle it if ARG is `toggle'; disable the mode otherwise. + +\(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, enable the mode if +ARG is omitted or nil. + +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) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens" '("smartparens-" "sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-clojure" "smartparens-clojure.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-clojure.el + +(if (fboundp 'register-definition-prefixes) (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 + +(if (fboundp 'register-definition-prefixes) (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 + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-crystal" '("sp-crystal-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-elixir" "smartparens-elixir.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-elixir.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-elixir" '("sp-elixir-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-ess" "smartparens-ess.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-ess.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-ess" '("sp-ess-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-haskell" "smartparens-haskell.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-haskell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-haskell" '("sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-html" "smartparens-html.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-html.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-html" '("sp-html-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-latex" "smartparens-latex.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-latex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-latex" '("sp-latex-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-lua" "smartparens-lua.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-lua.el + +(if (fboundp 'register-definition-prefixes) (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 + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-markdown" '("sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-org" "smartparens-org.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-org.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-org" '("sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-python" "smartparens-python.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-python.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-python" '("sp-python-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-rst" "smartparens-rst.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from smartparens-rst.el + +(if (fboundp 'register-definition-prefixes) (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 + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-ruby" '("sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-rust" "smartparens-rust.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-rust.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-rust" '("sp-"))) + +;;;*** + +;;;### (autoloads nil "smartparens-scala" "smartparens-scala.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from smartparens-scala.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smartparens-scala" '("sp-scala-wrap-with-indented-newlines"))) + +;;;*** + +;;;### (autoloads nil "smartparens-text" "smartparens-text.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from smartparens-text.el + +(if (fboundp 'register-definition-prefixes) (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 + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sp-sublimetext-like" '("sp-point-not-before-word"))) + +;;;*** + +;;;### (autoloads nil nil ("smartparens-c.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-20201229.1937/smartparens-c.el b/elpa/smartparens-20201229.1937/smartparens-c.el new file mode 100644 index 00000000..eeb96b5a --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-c.el @@ -0,0 +1,52 @@ +;;; 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-20201229.1937/smartparens-clojure.el b/elpa/smartparens-20201229.1937/smartparens-clojure.el new file mode 100644 index 00000000..e07e650d --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-clojure.el @@ -0,0 +1,56 @@ +;;; 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-20201229.1937/smartparens-config.el b/elpa/smartparens-20201229.1937/smartparens-config.el new file mode 100644 index 00000000..6e17e4b4 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-config.el @@ -0,0 +1,134 @@ +;;; 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 '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 '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-20201229.1937/smartparens-crystal.el b/elpa/smartparens-20201229.1937/smartparens-crystal.el new file mode 100644 index 00000000..574ac8ea --- /dev/null +++ b/elpa/smartparens-20201229.1937/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-20201229.1937/smartparens-elixir.el b/elpa/smartparens-20201229.1937/smartparens-elixir.el new file mode 100644 index 00000000..8411162c --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-elixir.el @@ -0,0 +1,135 @@ +;;; 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 ""))) + +(defun sp-elixir-def-p (id) + "Return non-nil if the \"do\" keyword is part of definition. + +ID is the opening delimiter. + +Definitions are the constructions of the form defmodule-do-end, +def-do-end and similar pairs." + (save-excursion + (when (equal "do" id) + (back-to-indentation) + (looking-at (regexp-opt '( + "defmodule" + "defmacro" + "defmacrop" + "quote" + "def" + "defp" + "if" + "unless" + "case" + "cond" + "with" + "for" + "receive" + "try" + )))))) + +(defun sp-elixir-skip-def-p (ms _mb _me) + "Test if \"do\" is part of definition. +MS, MB, ME." + (sp-elixir-def-p ms)) + +(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) + :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) + :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) + :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) + :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) + :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) + :unless '(sp-in-comment-p sp-in-string-p)) + (sp-local-pair "receive" "end" + :when '(("RET" "")) + :post-handlers '(sp-elixir-empty-do-block-post-handler)) + ) + +(provide 'smartparens-elixir) +;;; smartparens-elixir.el ends here diff --git a/elpa/smartparens-20201229.1937/smartparens-ess.el b/elpa/smartparens-20201229.1937/smartparens-ess.el new file mode 100644 index 00000000..15b923ea --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-ess.el @@ -0,0 +1,234 @@ +;;; 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 (boundp '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 "{[^}]*}")) + + +(provide 'smartparens-ess) +;;; smartparens-ess ends here diff --git a/elpa/smartparens-20201229.1937/smartparens-haskell.el b/elpa/smartparens-20201229.1937/smartparens-haskell.el new file mode 100644 index 00000000..47a9ab58 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-haskell.el @@ -0,0 +1,113 @@ +;;; 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-20201229.1937/smartparens-html.el b/elpa/smartparens-20201229.1937/smartparens-html.el new file mode 100644 index 00000000..3ba64060 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-html.el @@ -0,0 +1,173 @@ +;;; 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-20201229.1937/smartparens-javascript.el b/elpa/smartparens-20201229.1937/smartparens-javascript.el new file mode 100644 index 00000000..aa024d68 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-javascript.el @@ -0,0 +1,55 @@ +;;; 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-20201229.1937/smartparens-latex.el b/elpa/smartparens-20201229.1937/smartparens-latex.el new file mode 100644 index 00000000..61d9a00c --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-latex.el @@ -0,0 +1,192 @@ +;;; 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-20201229.1937/smartparens-lua.el b/elpa/smartparens-20201229.1937/smartparens-lua.el new file mode 100644 index 00000000..29621a6c --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-lua.el @@ -0,0 +1,90 @@ +;;; 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-20201229.1937/smartparens-markdown.el b/elpa/smartparens-20201229.1937/smartparens-markdown.el new file mode 100644 index 00000000..b097fb5d --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-markdown.el @@ -0,0 +1,88 @@ +;;; 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-20201229.1937/smartparens-ml.el b/elpa/smartparens-20201229.1937/smartparens-ml.el new file mode 100644 index 00000000..7960c5f1 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-ml.el @@ -0,0 +1,76 @@ +;;; 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 "(*" "*)" )) + +;; 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-20201229.1937/smartparens-org.el b/elpa/smartparens-20201229.1937/smartparens-org.el new file mode 100644 index 00000000..87dfeca3 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-org.el @@ -0,0 +1,72 @@ +;;; 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-20201229.1937/smartparens-pkg.el b/elpa/smartparens-20201229.1937/smartparens-pkg.el new file mode 100644 index 00000000..9645fa2b --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-pkg.el @@ -0,0 +1,13 @@ +(define-package "smartparens" "20201229.1937" "Automatic insertion, wrapping and paredit-like navigation with user defined pairs." + '((dash "2.13.0") + (cl-lib "0.3")) + :commit "63695c64233d215a92bf08e762f643cdb595bdd9" :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-20201229.1937/smartparens-python.el b/elpa/smartparens-20201229.1937/smartparens-python.el new file mode 100644 index 00000000..4ad3cf2b --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-python.el @@ -0,0 +1,116 @@ +;;; 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 + "Whether to auto-insert a colon when parens insertion is +triggered while typing a function definition" + :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 function definition" + ;; 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 "^\\s-*def\\b" (line-end-position)))) + (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-20201229.1937/smartparens-racket.el b/elpa/smartparens-20201229.1937/smartparens-racket.el new file mode 100644 index 00000000..08af6760 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-racket.el @@ -0,0 +1,56 @@ +;;; 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-20201229.1937/smartparens-rst.el b/elpa/smartparens-20201229.1937/smartparens-rst.el new file mode 100644 index 00000000..ceac6a63 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-rst.el @@ -0,0 +1,66 @@ +;;; 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-20201229.1937/smartparens-ruby.el b/elpa/smartparens-20201229.1937/smartparens-ruby.el new file mode 100644 index 00000000..3ba86716 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-ruby.el @@ -0,0 +1,411 @@ +;;; 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-20201229.1937/smartparens-rust.el b/elpa/smartparens-20201229.1937/smartparens-rust.el new file mode 100644 index 00000000..e3f46ceb --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-rust.el @@ -0,0 +1,142 @@ +;;; 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-20201229.1937/smartparens-scala.el b/elpa/smartparens-20201229.1937/smartparens-scala.el new file mode 100644 index 00000000..7e79016d --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-scala.el @@ -0,0 +1,80 @@ +;;; 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) + (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)) + +(provide 'smartparens-scala) +;;; smartparens-scala.el ends here diff --git a/elpa/smartparens-20201229.1937/smartparens-text.el b/elpa/smartparens-20201229.1937/smartparens-text.el new file mode 100644 index 00000000..91c07be1 --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens-text.el @@ -0,0 +1,65 @@ +;;; 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-20201229.1937/smartparens.el b/elpa/smartparens-20201229.1937/smartparens.el new file mode 100644 index 00000000..88e10daf --- /dev/null +++ b/elpa/smartparens-20201229.1937/smartparens.el @@ -0,0 +1,9656 @@ +;;; 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")) 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))) + + +;;;###autoload +(defvar smartparens-mode-map (make-sparse-keymap) + "Keymap used for `smartparens-mode'.") +(defvaralias 'sp-keymap 'smartparens-mode-map) +(make-obsolete-variable 'sp-keymap 'smartparens-mode-map "2015-01-01") + +(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 + 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 + 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 (-find-indices (lambda (it) (eq (car it) 'smartparens-strict-mode)) minor-mode-overriding-map-alist) + (setq minor-mode-overriding-map-alist + (cons `(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 + (-remove (lambda (it) (eq (car it) '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-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)))))) + +(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'." + (let ((parent-modes (-fix (lambda (x) + (--if-let (get (car x) 'derived-mode-parent) + (cons it x) + x)) + (list major-mode)))) + ;; Combine all the definitions from the most ancient parent to the + ;; most recent parent + (--each parent-modes (sp-update-local-pairs it)))) + +(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." + (let ((ind 0)) + (--each new-pair + (when (= 0 (% ind 2)) + (sp--merge-prop it new-pair old-pair)) + (setq ind (1+ ind)))) + 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." + (let ((ind 0)) + (--each new-pair + (when (= 0 (% ind 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)))) + (setq ind (1+ ind)))) + 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))) + (if prop + (cond + ((eq prop :op-l) + (length (plist-get pair :open))) + ((eq prop :cl-l) + (length (plist-get pair :close))) + ((eq prop :len) + (+ (length (plist-get pair :open)) (length (plist-get pair :close)))) + ((eq prop :post-handlers) + (--filter (not (listp it)) (plist-get pair prop))) + ((eq prop :post-handlers-cond) + (--filter (listp it) (plist-get pair :post-handlers))) + ((eq prop :when) + (--filter (not (listp it)) (plist-get pair :when))) + ((eq prop :when-cond) + (-flatten (-concat (--filter (listp it) (plist-get pair :when))))) + (t (plist-get pair prop))) + pair))) + +(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) + (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)) + (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 (items (sp-get-list-items)) + (let ((op (sp-get (car items) :op)) + (cl (sp-get (car items) :cl)) + (beg (sp-get (car items) :beg)) + (end (sp-get (car items) :end))) + (!cdr items) + (setq items (nreverse items)) + (save-excursion + (goto-char end) + (delete-char (- (length cl))) + (while items + (sp-get (car items) + (goto-char :end) + (insert cl) + (goto-char :beg) + (insert op)) + (!cdr items)) + (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-20201229.1937/sp-sublimetext-like.el b/elpa/smartparens-20201229.1937/sp-sublimetext-like.el new file mode 100644 index 00000000..1cae7f43 --- /dev/null +++ b/elpa/smartparens-20201229.1937/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