Permalink
Fetching contributors…
Cannot retrieve contributors at this time
8692 lines (8091 sloc) 302 KB
;;; lispy.el --- vi-like Paredit. -*- lexical-binding: t -*-
;; Copyright (C) 2014-2015 Oleh Krehel
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/lispy
;; Version: 0.26.0
;; Keywords: lisp
;; This file is not part of GNU Emacs
;; This file 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, 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.
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Due to the structure of Lisp syntax it's very rare for the
;; programmer to want to insert characters right before "(" or right
;; after ")". Thus unprefixed printable characters can be used to call
;; commands when the point is at one of these locations, which are
;; further referred to as special.
;;
;; Conveniently, when located at special position it's very clear to
;; which sexp the list-manipulating command will be applied to, what
;; the result be and where the point should end up afterwards. You
;; can enhance this effect with `show-paren-mode' or similar.
;;
;; Here's an illustration to this effect, with `lispy-clone' ("*"
;; represents the point):
;; |--------------------+-----+--------------------|
;; | before | key | after |
;; |--------------------+-----+--------------------|
;; | (looking-at "(")* | c | (looking-at "(") |
;; | | | (looking-at "(")* |
;; |--------------------+-----+--------------------|
;; | *(looking-at "(") | c | *(looking-at "(") |
;; | | | (looking-at "(") |
;; |--------------------+-----+--------------------|
;;
;; When special, the digit keys call `digit-argument', since most
;; `lispy' commands accept a numeric argument. For instance, "3c" is
;; equivalent to "ccc" (clone sexp 3 times), and "4j" is equivalent to
;; "jjjj" (move point 4 sexps down). Some useful applications are
;; "9l" and "9h" - they exit list forwards and backwards respectively
;; at most 9 times which makes them effectively equivalent to
;; `end-of-defun' and `beginning-of-defun'.
;;
;; To move the point into a special position, use:
;; "]" - calls `lispy-forward'
;; "[" - calls `lispy-backward'
;; "C-3" - calls `lispy-right' (exit current list forwards)
;; ")" - calls `lispy-right-nostring' (exit current list
;; forwards, but self-insert in strings and comments)
;;
;; These are the few Lispy commands that don't care whether the point
;; is special or not. Other such bindings are `DEL', `C-d', `C-k'.
;;
;; To get out of the special position, you can use any of the good-old
;; navigational commands such as `C-f' or `C-n'.
;; Additionally `SPC' will break out of special to get around the
;; situation when you have the point between open parens like this
;; "(|(" and want to start inserting. `SPC' will change the code to
;; this: "(| (".
;;
;; A lot of Lispy commands come in pairs: one reverses the other.
;; Some examples are:
;; |-----+--------------------------+------------+-------------------|
;; | key | command | key | command |
;; |-----+--------------------------+------------+-------------------|
;; | j | `lispy-down' | k | `lispy-up' |
;; | s | `lispy-move-down' | w | `lispy-move-up' |
;; | > | `lispy-slurp' | < | `lispy-barf' |
;; | c | `lispy-clone' | C-d or DEL | |
;; | C | `lispy-convolute' | C | reverses itself |
;; | d | `lispy-different' | d | reverses itself |
;; | M-j | `lispy-split' | + | `lispy-join' |
;; | O | `lispy-oneline' | M | `lispy-multiline' |
;; | S | `lispy-stringify' | C-u " | `lispy-quotes' |
;; | ; | `lispy-comment' | C-u ; | `lispy-comment' |
;; | xi | `lispy-to-ifs' | xc | `lispy-to-cond' |
;; | F | `lispy-follow' | D | `pop-tag-mark' |
;; |-----+--------------------------+------------+-------------------|
;;
;; Here's a list of commands for inserting pairs:
;; |-----+------------------------------------|
;; | key | command |
;; |-----+------------------------------------|
;; | ( | `lispy-parens' |
;; | { | `lispy-braces' |
;; | } | `lispy-brackets' |
;; | " | `lispy-quotes' |
;; |-----+------------------------------------|
;;
;; Here's a list of modified insertion commands that handle whitespace
;; in addition to self-inserting:
;; |-----+------------------------------------|
;; | key | command |
;; |-----+------------------------------------|
;; | SPC | `lispy-space' |
;; | : | `lispy-colon' |
;; | ^ | `lispy-hat' |
;; | ' | `lispy-tick' |
;; | ` | `lispy-backtick' |
;; | C-m | `lispy-newline-and-indent' |
;; |-----+------------------------------------|
;;
;; You can see the full list of bound commands with "F1 f lispy-mode".
;;
;; Most special commands will leave the point special after they're
;; done. This allows to chain them as well as apply them continuously
;; by holding the key. Some useful holdable keys are "jkf<>cws;".
;; Not so useful, but fun is "/": start it from "|(" position and hold
;; until all your Lisp code is turned into Python :).
;;
;; Some Clojure support depends on `cider'.
;; Some Scheme support depends on `geiser'.
;; Some Common Lisp support depends on `slime' or `sly'.
;; You can get them from MELPA.
;;
;; See http://abo-abo.github.io/lispy/ for a detailed documentation.
;;
;;; Code:
;;* Requires
(eval-when-compile
(require 'cl)
(require 'org))
(require 'lispy-tags)
(require 'help-fns)
(require 'edebug)
(require 'ediff)
(require 'ediff-util)
(require 'eldoc)
(require 'etags)
(require 'outline)
(require 'semantic)
(require 'semantic/db)
(require 'avy)
(require 'newcomment)
(require 'lispy-inline)
(require 'iedit)
(require 'delsel)
(require 'swiper)
;;* Customization
(defgroup lispy nil
"List navigation and editing for the Lisp family."
:group 'bindings
:prefix "lispy-")
(defvar lispy-left "[([{]"
"Opening delimiter.")
(defvar lispy-right "[])}]"
"Closing delimiter.")
(defvar lispy-outline "^;;\\(?:;[^#]\\|\\*+\\)"
"Outline delimiter.")
(defcustom lispy-no-space nil
"When non-nil, don't insert a space before parens/brackets/braces/colons."
:type 'boolean
:group 'lispy)
(make-variable-buffer-local 'lispy-no-space)
(defcustom lispy-lax-eval t
"When non-nil, fix \"unbound variable\" error by setting the it to nil.
This is useful when hacking functions with &optional arguments.
So evaling (setq mode (or mode major-mode)) will set mode to nil on
the first eval, and to major-mode on the second eval."
:type 'boolean
:group 'lispy)
(defcustom lispy-verbose t
"If t, lispy will display some messages on error state.
These messages are similar to \"Beginning of buffer\" error for
`backward-char' and can safely be ignored."
:type 'boolean
:group 'lispy)
(defcustom lispy-verbose-verbs t
"If t, verbs produced by `lispy-defverb' will have a hint in the echo area.
The hint will consist of the possible nouns that apply to the verb."
:type 'boolean
:group 'lispy)
(defcustom lispy-helm-columns '(70 80)
"Max lengths of tag and tag+filename when completing with `helm'."
:group 'lispy
:type '(list integer integer))
(defcustom lispy-no-permanent-semantic nil
"When t, `lispy' will not enable function `semantic-mode' when it's off."
:type 'boolean
:group 'lispy)
(defcustom lispy-completion-method 'ivy
"Method to select a candidate from a list of strings."
:type '(choice
(const :tag "Ivy" ivy)
;; sensible choice for many tags
(const :tag "Helm" helm)
;; `ido-vertical-mode' is highly recommended here
(const :tag "Ido" ido)
;; `icomplete-mode' and `icy-mode' will affect this
(const :tag "Default" default)))
(defcustom lispy-visit-method 'ffip
"Method to switch to a file in the current project."
:type '(choice
(const :tag "Find File in Project" ffip)
(const :tag "Projectile" projectile)))
(defcustom lispy-avy-style-char 'pre
"Method of displaying the overlays for a char during visual selection."
:type '(choice
(const :tag "Pre" pre)
(const :tag "At" at)
(const :tag "At full" at-full)
(const :tag "Post" post)))
(defcustom lispy-avy-style-paren 'at
"Method of displaying the overlays for a paren during visual selection."
:type '(choice
(const :tag "Pre" pre)
(const :tag "At" at)
(const :tag "At full" at-full)
(const :tag "Post" post)))
(defcustom lispy-avy-style-symbol 'pre
"Method of displaying the overlays for a symbol during visual selection."
:type '(choice
(const :tag "Pre" pre)
(const :tag "At" at)
(const :tag "At full" at-full)
(const :tag "Post" post)))
(defcustom lispy-avy-keys (number-sequence ?a ?z)
"Keys for jumping."
:type '(repeat :tag "Keys" (character :tag "char")))
(defface lispy-command-name-face
'((((class color) (background light))
:background "#d8d8f7" :inherit font-lock-function-name-face)
(((class color) (background dark))
:background "#333333" :inherit font-lock-function-name-face))
"Face for Elisp commands."
:group 'lispy-faces)
(defface lispy-cursor-face
'((((class color) (background light))
:background "#000000" :foreground "#ffffff")
(((class color) (background dark))
:background "#ffffff" :foreground "#000000"))
"Face for `lispy-view-test'."
:group 'lispy-faces)
(defface lispy-test-face
'((t (:inherit lispy-face-hint)))
"Face for `lispy-view-test'."
:group 'lispy-faces)
(defvar lispy-mode-map (make-sparse-keymap))
(defvar lispy-known-verbs nil
"List of registered verbs.")
(defvar lispy-ignore-whitespace nil
"When set to t, function `lispy-right' will not clean up whitespace.")
(defcustom lispy-compat '(edebug)
"List of package compatibility options.
Enabling them adds overhead, so make sure that you are actually
using those packages."
:type '(repeat
(choice
(const :tag "god-mode" god-mode)
(const :tag "magit-blame-mode" magit-blame-mode)
(const :tag "edebug" edebug)
(const :tag "cider" cider)
(const :tag "macrostep" macrostep))))
(defvar-local lispy-old-outline-settings nil
"Store the old values of `outline-regexp' and `outline-level'.
`lispy-mode' overrides those while it's on.")
(defcustom lispy-safe-delete nil
"When non-nil, killing/deleting an active region keeps delimiters balanced.
This applies to `lispy-delete', `lispy-kill-at-point', `lispy-paste', and
`lispy-delete-backward'. This also applies to `lispy-yank' when
`delete-selection-mode' is non-nil."
:group 'lispy
:type 'boolean)
(defcustom lispy-safe-copy nil
"When non-nil, `lispy-new-copy' won't copy unbalanced delimiters in a region."
:group 'lispy
:type 'boolean)
(defcustom lispy-safe-paste nil
"When non-nil, `lispy-paste' and `lispy-yank' will add missing delimiters."
:group 'lispy
:type 'boolean)
(defcustom lispy-safe-threshold 1500
"The max size of an active region that lispy will try to keep balanced.
This only applies when `lispy-safe-delete' and/or `lispy-safe-copy' are
non-nil."
:group 'lispy
:type 'number)
(defcustom lispy-safe-actions-ignore-strings t
"When non-nil, don't try to act safely in strings.
Any unmatched delimiters inside of strings will be copied or deleted. This only
applies when `lispy-safe-delete' and/or `lispy-safe-copy' are non-nil."
:group 'lispy
:type 'boolean)
(defcustom lispy-safe-actions-ignore-comments t
"When non-nil, don't try to act safely in comments.
Any unmatched delimiters inside of comments will be copied or deleted. This only
applies when `lispy-safe-delete' and/or `lispy-safe-copy' are non-nil."
:group 'lispy
:type 'boolean)
(defcustom lispy-insert-space-after-wrap t
"When non-nil, insert a space after the point when wrapping.
This applies to the commands that use `lispy-pair'."
:group 'lispy
:type 'boolean)
;;;###autoload
(define-minor-mode lispy-mode
"Minor mode for navigating and editing LISP dialects.
When `lispy-mode' is on, most unprefixed keys,
i.e. [a-zA-Z+-./<>], conditionally call commands instead of
self-inserting. The condition (called special further on) is one
of:
- the point is before \"(\"
- the point is after \")\"
- the region is active
For instance, when special, \"j\" moves down one sexp, otherwise
it inserts itself.
When special, [0-9] call `digit-argument'.
When `lispy-mode' is on, \"[\" and \"]\" move forward and
backward through lists, which is useful to move into special.
\\{lispy-mode-map}"
:keymap lispy-mode-map
:group 'lispy
:lighter " LY"
(if lispy-mode
(progn
(setq lispy-old-outline-settings
(cons outline-regexp outline-level))
(setq-local outline-level 'lispy-outline-level)
(cond ((eq major-mode 'latex-mode)
(setq-local lispy-outline "^\\(?:%\\*+\\|\\\\\\(?:sub\\)?section{\\)")
(setq lispy-outline-header "%")
(setq-local outline-regexp "\\(?:%\\*+\\|\\\\\\(?:sub\\)?section{\\)"))
((eq major-mode 'python-mode)
(setq-local lispy-outline "^#\\*+")
(setq lispy-outline-header "#")
(setq-local outline-regexp "#\\*+")
(setq-local outline-heading-end-regexp "\n"))
(t
(setq-local outline-regexp (substring lispy-outline 1))))
(when (called-interactively-p 'any)
(mapc #'lispy-raise-minor-mode
(cons 'lispy-mode lispy-known-verbs))))
(when lispy-old-outline-settings
(setq outline-regexp (car lispy-old-outline-settings))
(setq outline-level (cdr lispy-old-outline-settings))
(setq lispy-old-outline-settings nil))))
(defun lispy-raise-minor-mode (mode)
"Make MODE the first on `minor-mode-map-alist'."
(let ((x (assq mode minor-mode-map-alist)))
(when x
(setq minor-mode-map-alist
(cons x (delq mode minor-mode-map-alist))))))
;;* Macros
(defmacro lispy-dotimes (n &rest bodyform)
"Execute N times the BODYFORM unless an error is signaled.
Return nil if couldn't execute BODYFORM at least once.
Otherwise return the amount of times executed."
(declare (indent 1)
(debug (form body)))
`(let ((i 0))
(catch 'result
(condition-case e
(progn
(while (<= (incf i) ,n)
,@bodyform)
,n)
(error
(when (eq (car e) 'buffer-read-only)
(message "Buffer is read-only: %s" (current-buffer)))
(decf i)
(and (> i 0) i))))))
(defmacro lispy-save-excursion (&rest body)
"More intuitive (`save-excursion' BODY)."
(declare (indent 0))
`(let ((out (save-excursion
,@body)))
(when (bolp)
(back-to-indentation))
out))
(defmacro lispy-from-left (&rest body)
"Ensure that BODY is executed from start of list."
(let ((at-start (cl-gensym "at-start")))
`(let ((,at-start (lispy--leftp)))
(unless ,at-start
(lispy-different))
(unwind-protect
(lispy-save-excursion
,@body)
(unless (eq ,at-start (lispy--leftp))
(lispy-different))))))
(defmacro lispy-flet (binding &rest body)
"Temporarily override BINDING and execute BODY."
(declare (indent 1))
(let* ((name (car binding))
(old (cl-gensym (symbol-name name))))
`(let ((,old (symbol-function ',name)))
(unwind-protect
(progn
(fset ',name (lambda ,@(cdr binding)))
,@body)
(fset ',name ,old)))))
(defmacro lispy-multipop (lst n)
"Remove LST's first N elements and return them."
`(if (<= (length ,lst) ,n)
(prog1 ,lst
(setq ,lst nil))
(prog1 ,lst
(setcdr
(nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
nil))))
(defvar lispy-site-directory (file-name-directory
load-file-name)
"The directory where all of the lispy files are located.")
;;* Verb related
(defun lispy-disable-verbs-except (verb)
"Disable all verbs except VERB."
(mapc
(lambda (v) (funcall v -1))
(remq verb lispy-known-verbs)))
(defun lispy-quit ()
"Remove modifiers."
(interactive)
(lispy-disable-verbs-except nil))
(defmacro lispy-defverb (name grammar)
"Define the verb NAME.
GRAMMAR is a list of nouns that work with this verb."
(let* ((sym (intern (format "lispy-%s-mode" name)))
(keymap (intern (format "lispy-%s-mode-map" name)))
(doc (format "%s verb.\n\n \\{lispy-%s-mode-map}"
(capitalize name) name))
(lighter (format " [%s]" name))
(verb (intern (format "lispy-%s-verb" name)))
(msg (format "[%s]: %s" name
(mapconcat #'car grammar " "))))
`(progn
(defvar ,sym nil
,(format "Non-nil if Lispy-%s mode is enabled.
Use the command `%s' to change this variable."
(capitalize name)
sym))
(make-variable-buffer-local ',sym)
(defvar ,keymap (make-sparse-keymap))
(defun ,sym (&optional arg)
,doc
(interactive (list (or current-prefix-arg 'toggle)))
(let ((last-message (current-message)))
(setq ,sym (if (eq arg 'toggle)
(not ,sym)
(> (prefix-numeric-value arg)
0)))
(cond (,sym (lispy-disable-verbs-except ',sym))
(t nil))
(if (called-interactively-p 'any)
(unless (and (current-message)
(not (equal last-message (current-message))))
(if ,sym
(when lispy-verbose-verbs
(message ,msg))
(message "")))))
(force-mode-line-update))
(mapc (lambda (x)
(lispy-define-key
,keymap
(car x) (cadr x)
:disable ',sym))
',grammar)
(unless (memq ',sym lispy-known-verbs)
(push ',sym lispy-known-verbs))
(defun ,verb ()
(interactive)
(if (bound-and-true-p ,sym)
(,sym -1)
(,sym 1)))
(with-no-warnings
(add-minor-mode ',sym ,lighter ,keymap nil nil)))))
;;* Globals: navigation
(defsubst lispy-right-p ()
"Return t if after variable `lispy-right'."
(looking-back lispy-right
(line-beginning-position)))
(defsubst lispy-left-p ()
"Return t if before variable `lispy-left'."
(looking-at lispy-left))
(defun lispy-forward (arg)
"Move forward list ARG times or until error.
Return t if moved at least once,
otherwise call function `lispy-right' and return nil."
(interactive "p")
(when (= arg 0)
(setq arg 2000))
(lispy--exit-string)
(let ((bnd (lispy--bounds-comment)))
(when bnd
(goto-char (1+ (cdr bnd)))))
(let ((pt (point))
(r (lispy-dotimes arg
(when (= (point) (point-max))
(error "Reached end of buffer"))
(forward-list))))
;; `forward-list' returns true at and of buffer
(if (or (null r)
(= pt (point))
(and (not (lispy-right-p))
(progn
(backward-list)
(forward-list)
(= pt (point)))))
(prog1 nil
(lispy--out-forward 1))
(point))))
(defun lispy-backward (arg)
"Move backward list ARG times or until error.
If couldn't move backward at least once, move up backward and return nil."
(interactive "p")
(when (= arg 0)
(setq arg 2000))
(lispy--exit-string)
(let ((bnd (lispy--bounds-comment)))
(when bnd
(goto-char (car bnd))))
(let ((pt (point))
(r (lispy-dotimes arg
(when (= (point) (point-min))
(error "Reached beginning of buffer"))
(backward-list))))
;; `backward-list' returns true at beginning of buffer
(if (or (null r)
(= pt (point))
(and (not (lispy-left-p))
(progn
(forward-list)
(backward-list)
(= pt (point)))))
(prog1 nil
(condition-case nil
(progn
(lispy--out-forward 1)
(backward-list))
(error
(progn
(goto-char pt)
(up-list -1)))))
(point))))
(defun lispy-right (arg)
"Move outside list forwards ARG times.
Return nil on failure, t otherwise."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(when (bound-and-true-p abbrev-mode)
(ignore-errors (expand-abbrev)))
(cond ((region-active-p)
(lispy-mark-right arg))
((looking-at lispy-outline)
(lispy-outline-right))
(t
(lispy--out-forward arg))))
(defun lispy-right-nostring (arg)
"Call `lispy--out-forward' with ARG unless in string or comment.
Self-insert otherwise."
(interactive "p")
(if (or (lispy--in-string-or-comment-p)
(looking-back "?\\\\"
(line-beginning-position)))
(self-insert-command arg)
(lispy--out-forward arg)))
(defun lispy-left (arg)
"Move outside list forwards ARG times.
Return nil on failure, t otherwise."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(cond ((region-active-p)
(lispy-mark-left arg))
((looking-at lispy-outline)
(lispy-outline-left))
(t
(or (lispy--out-backward arg)
(ignore-errors
(up-list -1))))))
(defun lispy-out-forward-newline (arg)
"Call `lispy--out-forward', then ARG times `newline-and-indent'."
(interactive "p")
(lispy--out-forward 1)
(lispy-dotimes arg
(newline-and-indent)))
(defvar lispy-meol-point 1
"Point where `lispy-move-end-of-line' should go when already at eol.")
(defun lispy-move-end-of-line ()
"Forward to `move-end-of-line' unless already at end of line.
Then return to the point where it was called last.
If this point is inside string, move outside string."
(interactive)
(let ((pt (point))
bnd)
(if (eq pt (line-end-position))
(if (setq bnd (lispy--bounds-string))
(goto-char (cdr bnd))
(when (and (< lispy-meol-point pt)
(>= lispy-meol-point (line-beginning-position)))
(goto-char lispy-meol-point)
(when (setq bnd (lispy--bounds-string))
(goto-char (cdr bnd)))))
(setq lispy-meol-point (point))
(move-end-of-line 1))))
(defun lispy-move-beginning-of-line ()
"Forward to `move-beginning-of-line'.
Reveal outlines."
(interactive)
(lispy--ensure-visible)
(if (bolp)
(back-to-indentation)
(move-beginning-of-line 1)))
;;* Locals: navigation
(defun lispy-flow (arg)
"Move inside list ARG times.
Don't enter strings or comments.
Return nil if can't move."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(let ((pt (point))
success)
(lispy-dotimes arg
(cond ((or (lispy-left-p)
(and (lispy-bolp)
(looking-at ";")))
(forward-char)
(re-search-forward lispy-left nil t)
(while (and (lispy--in-string-or-comment-p)
(re-search-forward lispy-left nil t)))
(unless (lispy--in-string-or-comment-p)
(setq success t))
(backward-char))
((lispy-right-p)
(backward-char)
(re-search-backward lispy-right nil t)
(while (and (lispy--in-string-or-comment-p)
(re-search-backward lispy-right nil t)))
(unless (lispy--in-string-or-comment-p)
(setq success t))
(forward-char))))
(and (not (= (point) pt))
(or success
(prog1 nil
(goto-char pt))))))
(defun lispy-down (arg)
"Move down ARG times inside current list."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(cond ((region-active-p)
(let ((leftp (= (point) (region-beginning))))
(when leftp
(exchange-point-and-mark))
(cond ((save-excursion
(skip-chars-forward " \n")
(eobp)))
((lispy--symbolp (lispy--string-dwim))
(lispy-dotimes arg
(when (lispy-slurp 1)
(lispy-different)
(lispy-barf 1)
(lispy-different))))
((looking-at "[\n ]+\\(;\\)")
(deactivate-mark)
(goto-char (match-beginning 1))
(lispy--mark (lispy--bounds-comment)))
(t
(lispy-dotimes arg
(forward-sexp 1)
(lispy-different)
(if (lispy--in-comment-p)
(progn
(goto-char (1+ (cdr (lispy--bounds-comment))))
(skip-chars-forward "\n"))
(forward-sexp 2)
(forward-sexp -1))
(lispy-different))))
(when leftp
(exchange-point-and-mark))))
((lispy-left-p)
(lispy-forward arg)
(let ((pt (point))
(lispy-ignore-whitespace t))
(if (lispy-forward 1)
(lispy-backward 1)
(goto-char pt)
(lispy-different))))
((lispy-right-p)
(let ((pt (point)))
(unless (lispy-forward arg)
(goto-char pt))))
((or (looking-at lispy-outline)
(and (bolp) (looking-at ";")))
(let ((pt (point)))
(lispy-dotimes arg
(outline-next-visible-heading 1)
(if (looking-at lispy-outline)
(setq pt (point))
(goto-char pt)
(error "Last outline reached")))))
(t
(lispy-forward 1)
(lispy-backward 1)))
(lispy--ensure-visible))
(defun lispy-up (arg)
"Move up ARG times inside current list."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(cond ((region-active-p)
(let ((leftp (= (point) (region-beginning))))
(unless leftp
(exchange-point-and-mark))
(cond ((save-excursion
(skip-chars-backward "\n ")
(bobp)))
((looking-back "^ *\\(;\\)[^\n]*[\n ]*"
(save-excursion
(ignore-errors
(backward-sexp 1))
(point)))
(deactivate-mark)
(goto-char (match-beginning 1))
(lispy--mark (lispy--bounds-comment))
(exchange-point-and-mark))
((lispy--symbolp (lispy--string-dwim))
(lispy-dotimes arg
(when (lispy-slurp 1)
(lispy-different)
(lispy-barf 1)
(lispy-different))))
(t
(lispy-dotimes arg
(backward-sexp 1)
(lispy-different)
(if (lispy--in-comment-p)
(progn
(goto-char (1- (car (lispy--bounds-comment))))
(skip-chars-backward "\n"))
(backward-sexp 2)
(backward-sexp -1))
(lispy-different))))
(unless leftp
(exchange-point-and-mark))))
((lispy-left-p)
(let ((pt (point)))
(unless (lispy-backward arg)
(goto-char pt))))
((lispy-right-p)
(lispy-backward arg)
(let ((pt (point)))
(if (lispy-backward 1)
(lispy-forward 1)
(goto-char pt)
(lispy-different))))
((or (looking-at lispy-outline)
(and (bolp) (looking-at ";")))
(let ((pt (point)))
(lispy-dotimes arg
(outline-previous-visible-heading 1)
(if (looking-at lispy-outline)
(setq pt (point))
(goto-char pt)
(error "First outline reached")))))
(t
(lispy-backward 1)
(lispy-forward 1)))
(lispy--ensure-visible))
(defvar lispy-pos-ring (make-ring 100)
"Ring for point and mark position history.")
(defun lispy--remember ()
"Store the current point and mark in history."
(let* ((emptyp (zerop (ring-length lispy-pos-ring)))
(top (unless emptyp
(ring-ref lispy-pos-ring 0))))
(if (region-active-p)
(let* ((bnd (lispy--bounds-dwim))
(bnd (cons
(move-marker (make-marker) (car bnd))
(move-marker (make-marker) (cdr bnd)))))
(when (or emptyp
(not (equal bnd top)))
(ring-insert lispy-pos-ring bnd)))
(when (or emptyp
(not (equal (point-marker) top)))
(ring-insert lispy-pos-ring (point-marker))))))
(defun lispy-back (arg)
"Move point to ARGth previous position.
If position isn't special, move to previous or error."
(interactive "p")
(lispy-dotimes arg
(if (zerop (ring-length lispy-pos-ring))
(lispy-complain "At beginning of point history")
(let ((pt (ring-remove lispy-pos-ring 0)))
;; After deleting some text, markers that point to it converge
;; to one point
(while (and (not (zerop (ring-length lispy-pos-ring)))
(equal (ring-ref lispy-pos-ring 0)
pt))
(ring-remove lispy-pos-ring 0))
(if (consp pt)
(lispy--mark pt)
(deactivate-mark)
(goto-char pt))))))
(defun lispy-knight-down ()
"Make a knight-like move: down and right."
(interactive)
(cond ((lispy-right-p)
(lispy-different))
((lispy-left-p))
(t (lispy-backward 1)))
(let ((pt (point))
(bnd (save-excursion
(lispy-beginning-of-defun)
(lispy--bounds-list))))
(catch 'done
(while t
(forward-line)
(cond ((>= (point) (cdr bnd))
(goto-char pt)
(throw 'done nil))
((looking-at (concat "\\s-*" lispy-left))
(goto-char (1- (match-end 0)))
(throw 'done t)))))))
(defun lispy-knight-up ()
"Make a knight-like move: up and right."
(interactive)
(cond ((lispy-right-p)
(lispy-different))
((lispy-left-p))
(t (lispy-backward 1)))
(let ((pt (point))
(bnd (save-excursion
(lispy-beginning-of-defun)
(lispy--bounds-list))))
(catch 'done
(while t
(beginning-of-line 0)
(cond ((< (point) (car bnd))
(goto-char pt)
(throw 'done nil))
((looking-at (concat "\\s-*" lispy-left))
(goto-char (1- (match-end 0)))
(throw 'done t)))))))
(defun lispy-different ()
"Switch to the different side of current sexp."
(interactive)
(cond ((and (region-active-p)
(not (= (region-beginning) (region-end))))
(exchange-point-and-mark))
((lispy-right-p)
(backward-list))
((lispy-left-p)
(forward-list))
(t
(user-error "Unexpected"))))
;;* Globals: kill, yank, delete, mark, copy
(defun lispy-kill ()
"Kill line, keeping parens consistent."
(interactive)
(let (bnd)
(cond ((or (lispy--in-comment-p)
(and (lispy-bolp)
(looking-at " *;")))
(kill-line))
((and (setq bnd (lispy--bounds-string))
(or
(not (eq (point) (car bnd)))
(> (count-lines (car bnd) (cdr bnd)) 1)))
(if (> (cdr bnd) (line-end-position))
(if (eq (point) (car bnd))
(kill-region (car bnd) (cdr bnd))
(kill-line))
(kill-region (point) (1- (cdr bnd)))))
((looking-at " *\n")
(kill-region
(match-beginning 0)
(match-end 0))
(lispy--indent-for-tab))
((and (looking-at lispy-right) (looking-back lispy-left
(line-beginning-position)))
(delete-char 1)
(backward-delete-char 1))
((lispy-left-p)
(if (progn
(setq bnd (lispy--bounds-list))
(> (count-lines (car bnd) (cdr bnd)) 1))
(kill-region (car bnd)
(cdr bnd))
(narrow-to-region (car bnd) (line-end-position))
(let ((pt (point)))
(while (and (ignore-errors
(forward-list))
(> (point) pt))
(setq pt (point)))
(when (looking-at "[\t ]*;[^\n]*$")
(setq pt (match-end 0)))
(goto-char (point-min))
(widen)
(kill-region (point) pt))))
(t
(let ((beg (point))
(end (line-end-position))
bnd)
(while (and (< (point) end)
(ignore-errors
(forward-sexp 1)
(skip-chars-forward " ")
t))
(when (setq bnd (lispy--bounds-comment))
(goto-char (cdr bnd))))
(skip-chars-forward " \t")
(kill-region beg (point)))))))
(defun lispy-kill-word (arg)
"Kill ARG words, keeping parens consistent."
(interactive "p")
(if (< arg 0)
(lispy-backward-kill-word (- arg))
(let (bnd)
(lispy-dotimes arg
(while (not (or (eobp)
(memq (char-syntax (char-after))
'(?w ?_))))
(forward-char 1))
(unless (lispy-bolp)
(delete-horizontal-space))
(if (setq bnd (lispy--bounds-string))
(save-restriction
(narrow-to-region (1+ (car bnd)) (1- (cdr bnd)))
(kill-word 1)
(widen))
(kill-word 1))))))
(defun lispy-backward-kill-word (arg)
"Kill ARG words backward, keeping parens consistent."
(interactive "p")
(let (bnd
(pt (point))
skipped)
(lispy-dotimes arg
(setq skipped (skip-chars-backward " \n"))
(if (memq (char-syntax (char-before))
'(?w ?_))
(if (lispy-looking-back "\\_<\\s_+")
(delete-region (match-beginning 0)
(match-end 0))
(backward-word 1)
(kill-region (point) pt)
(when (and (lispy--in-string-p)
(not (lispy-looking-back "\\\\\\\\"))
(lispy-looking-back "\\\\"))
(delete-char -1)))
(delete-region (point) pt)
(unless (or (zerop skipped)
(looking-at " \\|$"))
(insert " ")
(backward-char))
(while (not (or (bobp)
(memq (char-syntax (char-before))
'(?w ?_))))
(backward-char 1))
(if (setq bnd (lispy--bounds-string))
(progn
(save-restriction
(if (and (looking-at "\\s-+\"")
(eq (match-end 0) (cdr bnd)))
(goto-char (1- (cdr bnd)))
(when (and (> pt (car bnd))
(< pt (cdr bnd)))
(goto-char pt)))
(narrow-to-region (1+ (car bnd)) (point))
(kill-region (progn
(forward-word -1)
(when (and (not (lispy-looking-back "\\\\\\\\"))
(lispy-looking-back "\\\\"))
(backward-char))
(point))
(point-max))
(widen)))
(backward-kill-word 1))))))
(defun lispy-kill-sentence ()
"Kill until the end of current string or list."
(interactive)
(let ((bnd (lispy--bounds-dwim)))
(if (or (lispy-left-p) (looking-at "\""))
(kill-region (car bnd) (cdr bnd))
(setq bnd (or (lispy--bounds-string)
(lispy--bounds-list)))
(kill-region (point) (1- (cdr bnd))))))
(defun lispy-yank ()
"Like regular `yank', but quotes body when called from \"|\"."
(interactive)
(setq this-command 'yank)
(cond
((and (region-active-p)
(bound-and-true-p delete-selection-mode))
(lispy--maybe-safe-delete-region (region-beginning) (region-end))
(insert (lispy--maybe-safe-current-kill)))
((and (eq (char-after) ?\")
(eq (char-before) ?\"))
(insert (replace-regexp-in-string "\"" "\\\\\""
(lispy--maybe-safe-current-kill))))
(t
(push-mark (point))
(insert (lispy--maybe-safe-current-kill)))))
(defun lispy-buffer-kill-ring-save ()
"Save the current buffer string for writing a test."
(interactive)
(insert "|")
(kill-new (format "%S"
(buffer-substring-no-properties
(point-min) (point-max))))
(delete-char -1))
(defun lispy-delete (arg)
"Delete ARG sexps."
(interactive "p")
(let (bnd)
(cond ((< arg 0)
(lispy-delete-backward (- arg)))
((region-active-p)
(lispy--maybe-safe-delete-region (region-beginning) (region-end)))
((setq bnd (lispy--bounds-string))
(cond ((eq (1+ (point)) (cdr bnd))
(goto-char (car bnd)))
((looking-at "\\\\\"")
(if (eq (+ (point) 2) (cdr bnd))
(goto-char (car bnd))
(delete-char 2)))
((and (looking-at "\"")
(lispy-looking-back "\\\\"))
(backward-char 1)
(delete-char 2))
((lispy--delete-pair-in-string "\\\\\\\\(" "\\\\\\\\)"))
((looking-at "\\\\\\\\")
(delete-char 2))
((and (looking-at "\\\\")
(lispy-looking-back "\\\\"))
(backward-char 1)
(delete-char 2))
((eq (point) (car bnd))
(delete-region (car bnd)
(cdr bnd))
(let ((pt (point)))
(skip-chars-forward " ")
(delete-region pt (point))))
((save-excursion
(forward-char 1)
(lispy--in-string-or-comment-p))
(delete-char arg))
(t
(lispy--exit-string))))
((lispy--in-comment-p)
(if (lispy-bolp)
(let ((bnd (lispy--bounds-comment)))
(delete-region (car bnd) (cdr bnd)))
(delete-char arg)))
((looking-at lispy-right)
(lispy-left 1))
((lispy-left-p)
(lispy--delete-leading-garbage)
(lispy-dotimes arg
(lispy--delete)))
((eolp)
(delete-char 1)
(let ((pt (point)))
(skip-chars-forward " ")
(delete-region pt (point))
(unless (or (eolp)
(bolp)
(lispy-bolp)
(eq (char-before) ?\ ))
(insert " "))))
(t
(delete-char arg)))))
(defun lispy--delete-leading-garbage ()
"Delete any syntax before an opening delimiter such as '.
Delete backwards to the closest whitespace char or opening delimiter or to the
beginning of the line."
(let ((pt (point)))
(re-search-backward (concat "[[:space:]]" "\\|"
lispy-left "\\|"
"^"))
(goto-char (match-end 0))
(delete-region (point) pt)))
(defun lispy--delete-whitespace-backward ()
"Delete spaces backward."
(let ((pt (point)))
(skip-chars-backward " ")
(delete-region (point) pt)))
(defvar lispy-delete-backward-recenter -20
"When cursor is near top of screen when calling
lispy-delete-backward, recenter cursor with arg.")
(defun lispy-delete-backward (arg)
"From \")|\", delete ARG sexps backwards.
Otherwise (`backward-delete-char-untabify' ARG)."
(interactive "p")
(let (bnd)
(cond ((< arg 0)
(lispy-delete (- arg)))
((region-active-p)
(lispy--maybe-safe-delete-region (region-beginning)
(region-end)))
((bobp))
((and (setq bnd (lispy--bounds-string))
(not (eq (point) (car bnd))))
(cond ((eq (- (point) (car bnd)) 1)
(goto-char (cdr bnd)))
((or (looking-back "\\\\\\\\(" (car bnd))
(looking-back "\\\\\\\\)" (car bnd)))
(let ((pt (point)))
(goto-char (match-beginning 0))
(unless (lispy--delete-pair-in-string
"\\\\\\\\(" "\\\\\\\\)")
(goto-char pt)
(backward-delete-char-untabify arg))))
((looking-back "[^\\]\\\\[^\\]" (car bnd))
(backward-delete-char 2))
(t
(backward-delete-char-untabify arg))))
((looking-at lispy-outline)
(if (lispy-looking-back (concat lispy-outline ".*\n"))
(delete-region
(match-beginning 0)
(match-end 0))
(delete-char -1)))
((lispy--in-comment-p)
(if (lispy-looking-back "^ +")
(progn
(delete-region (1- (match-beginning 0))
(match-end 0))
(lispy--indent-for-tab))
(backward-delete-char-untabify arg)))
((lispy-looking-back "\\\\.")
(backward-delete-char-untabify arg))
((and (lispy-looking-back (concat lispy-right " "))
(looking-at " *$"))
(backward-delete-char-untabify arg))
((or (and (lispy-right-p)
(not (lispy-looking-back "[\\?].")))
(and (lispy-looking-back (concat lispy-right " "))
(or (lispy-left-p) (looking-at "\""))))
(let ((pt (point)))
(lispy-backward arg)
(lispy--skip-delimiter-preceding-syntax-backward)
(skip-chars-backward " \t")
(while (plist-get (text-properties-at (point)) 'read-only)
(forward-char))
(delete-region (point) pt)
(unless (or (looking-at " ")
(lispy-bolp)
(and (lispy-right-p)
(not (or (lispy-left-p)
(looking-at "\""))))
(lispy-looking-back lispy-left))
(just-one-space))
(setq pt (point))
(if (and
(not (lispy-bolp))
(not (lispy-left-p))
(progn
(skip-chars-backward " \t\n")
(lispy-right-p)))
(delete-region (point) pt)
(goto-char pt)
(lispy--indent-for-tab))))
((and (lispy-looking-back lispy-left)
(not (lispy-looking-back "[\\?].")))
(lispy--out-forward 1)
(lispy-delete-backward 1))
((eq (char-before) ?\")
(backward-char 1)
(let ((bnd (lispy--bounds-string)))
(delete-region (car bnd)
(cdr bnd))
(lispy--delete-whitespace-backward)
(unless (looking-at " ")
(insert " "))
(lispy--indent-for-tab)))
((and (lispy-after-string-p "\" ")
(not (looking-at lispy-right)))
(let ((pt (point)))
(backward-char 2)
(delete-region (car (lispy--bounds-string)) pt))
(lispy--delete-whitespace-backward)
(unless (lispy-looking-back lispy-left)
(just-one-space))
(lispy--indent-for-tab))
((lispy-bolp)
(delete-region
(line-beginning-position)
(point))
(unless (bobp)
(if (and (not (eolp))
(save-excursion
(backward-char 1)
(lispy--in-comment-p)))
(progn
(backward-char 1)
(let ((bnd (lispy--bounds-comment)))
(delete-region (car bnd) (cdr bnd)))
(delete-char 1))
(backward-delete-char 1)
(unless (or (eolp)
(looking-at lispy-right)
(lispy-looking-back lispy-left))
(just-one-space)))
(lispy--indent-for-tab)))
((lispy-looking-back "[^ ] +")
(delete-region (+ (match-beginning 0) 2) (point)))
(t
(backward-delete-char-untabify arg))))
(when (and (buffer-file-name)
(< (- (line-number-at-pos (point))
(line-number-at-pos (window-start)))
5)
lispy-delete-backward-recenter)
(ignore-errors
(recenter lispy-delete-backward-recenter)))
(when (and (lispy-left-p)
(not (lispy--in-string-or-comment-p)))
(indent-sexp)))
(defun lispy-mark ()
"Mark the quoted string or the list that includes the point.
Extend region when it's aleardy active."
(interactive)
(let ((bounds (or (lispy--bounds-comment)
(lispy--bounds-string)
(lispy--bounds-list))))
(when bounds
(lispy--mark bounds))))
(defun lispy-mark-list (arg)
"Mark list from special position.
When ARG is more than 1, mark ARGth element."
(interactive "p")
(when (called-interactively-p 'interactive)
(lispy--remember))
(cond ((> arg 1)
(lispy-mark-car)
(lispy-down (1- arg)))
((= arg 0)
(let ((bnd (lispy--bounds-dwim)))
(lispy--mark
(cons (+ (car bnd) (if (eq (char-after (car bnd)) ?\#) 2 1))
(1- (cdr bnd))))))
((region-active-p)
(deactivate-mark)
(if (lispy--in-comment-p)
(progn
(beginning-of-line)
(skip-chars-forward " "))
(skip-chars-forward ",@'`")))
((lispy-left-p)
(lispy--mark
(lispy--bounds-dwim)))
((lispy-right-p)
(lispy--mark
(lispy--bounds-dwim))
(lispy-different))
((and (lispy-bolp) (looking-at ";"))
(lispy--mark (lispy--bounds-comment))))
(setq this-command 'lispy-mark-list))
(defvar-local lispy-bind-var-in-progress nil
"When t, `lispy-mark-symbol' will exit `iedit'.")
(defun lispy-mark-symbol ()
"Mark current symbol."
(interactive)
(let (bnd)
(cond ((and lispy-bind-var-in-progress iedit-mode)
(iedit-mode)
(setq lispy-bind-var-in-progress nil)
(set-mark (point))
(search-backward (iedit-default-occurrence)))
((lispy--in-comment-p)
(if (and (looking-at "\\(?:\\w\\|\\s_\\)*'")
(setq bnd (match-end 0))
(looking-back "`\\(?:\\w\\|\\s_\\)*"
(line-beginning-position)))
(progn
(goto-char (match-beginning 0))
(set-mark (point))
(goto-char bnd))
(lispy--mark (lispy--bounds-comment))))
((and
(not (region-active-p))
(setq bnd (lispy--bounds-string))
(= (1+ (point))
(cdr bnd)))
(lispy--mark bnd))
((and (lispy-after-string-p "\"")
(not (lispy--in-string-or-comment-p)))
(set-mark-command nil)
(forward-sexp -1)
(exchange-point-and-mark))
((looking-at " *[[({]")
(if (and (lispy-looking-back "\\sw\\|\\s_")
(not (region-active-p)))
(progn
(set-mark-command nil)
(forward-sexp -1)
(exchange-point-and-mark))
(let ((pt (point)))
(skip-chars-forward "(){}[] \"\n")
(set-mark-command nil)
(if (looking-at "\\sw\\|\\s_")
(forward-sexp)
(condition-case nil
(progn
(re-search-forward "[][(){} \n]")
(while (lispy--in-string-or-comment-p)
(re-search-forward "[() \n]"))
(backward-char 1))
(error
(message "No further symbols found")
(deactivate-mark)
(goto-char pt)))))))
((region-active-p)
(let ((bnd (lispy--bounds-string)))
(condition-case nil
(progn
(forward-sexp)
(when (and bnd (> (point) (cdr bnd)))
(goto-char (cdr bnd))
(error "`forward-sexp' went through string bounds")))
(error
(deactivate-mark)
(re-search-forward "\\sw\\|\\s_")
(forward-char -1)
(set-mark-command nil)
(forward-sexp)))))
((lispy-right-p)
(skip-chars-backward "}]) \n")
(set-mark-command nil)
(re-search-backward "[][{}() \n]")
(while (lispy--in-string-or-comment-p)
(re-search-backward "[() \n]"))
(forward-char 1))
((looking-at lispy-right)
(lispy--mark
(save-excursion
(backward-char 1)
(lispy--bounds-dwim))))
(t
(lispy--mark (lispy--bounds-dwim))))))
(defun lispy-kill-at-point ()
"Kill the quoted string or the list that includes the point."
(interactive)
(if (region-active-p)
(lispy--maybe-safe-kill-region (region-beginning)
(region-end))
(let ((bounds (or (lispy--bounds-comment)
(lispy--bounds-string)
(lispy--bounds-list))))
(kill-region (car bounds) (cdr bounds)))))
(defun lispy-new-copy ()
"Copy marked region or sexp to kill ring."
(interactive)
(let ((str (if (region-active-p)
(lispy--maybe-safe-region (region-beginning)
(region-end))
(lispy--string-dwim))))
(unless (equal str (ignore-errors
(current-kill 0)))
(kill-new str))))
;;* Globals: pairs
(defun lispy-pair (left right preceding-syntax-alist)
"Return (lambda (arg)(interactive \"P\")...) using LEFT RIGHT.
PRECEDING-SYNTAX-ALIST should be an alist of `major-mode' to a list of regexps.
The regexps correspond to valid syntax that can precede LEFT in each major mode.
When this function is called:
- with region active:
Wrap region with LEFT RIGHT.
- with region active and arg 1:
Wrap region with LEFT RIGHT and put the point after LEFT followed by a space.
- with arg nil:
Insert LEFT RIGHT.
- with arg negative:
Wrap as many sexps as possible with LEFT RIGHT.
- with arg 0:
Wrap as many sexps as possible until the end of the line with LEFT RIGHT.
- with the universal arg:
Wrap one sexp with LEFT RIGHT.
- with arg positive:
Wrap that number of sexps with LEFT RIGHT or as many as possible."
`(lambda (arg)
(interactive "P")
(cond ((not arg))
((listp arg)
(setq arg 1))
(t
(setq arg (prefix-numeric-value arg))))
(cond ((region-active-p)
(lispy--surround-region ,left ,right)
(when (and (lispy-looking-back lispy-left)
(or (lispy-left-p)
(> (or arg 0) 0)))
(insert " "))
(backward-char 1))
((and (lispy--in-string-p)
(lispy-looking-back "\\\\\\\\"))
(insert ,left "\\\\" ,right)
(backward-char 3))
((lispy--in-string-or-comment-p)
(if (and (string= ,left "(")
(= ?\( (aref (this-command-keys-vector) 0)))
(insert "(")
(insert ,left ,right)
(backward-char 1)))
((lispy-after-string-p "?\\\\")
(self-insert-command 1))
((not arg)
(lispy--indent-for-tab)
(lispy--delimiter-space-unless ,preceding-syntax-alist)
(insert ,left ,right)
(unless (or (eolp)
(lispy--in-string-p)
(looking-at "\n\\|)\\|}\\|\\]"))
(just-one-space)
(backward-char 1))
(when (looking-at ,(regexp-quote left))
(insert " ")
(backward-char))
(backward-char))
(t
;; don't jump backwards or out of a list when not at a sexp
(unless (lispy--not-at-sexp-p ,preceding-syntax-alist)
(goto-char (car (lispy--bounds-dwim))))
(lispy--indent-for-tab)
(insert ,left ,right)
(save-excursion
(lispy-slurp arg))
(when (or (looking-at lispy-right)
(and (eolp)
(looking-back lispy-right (1- (point)))))
;; failed to wrap anything
(backward-char))
(when (and lispy-insert-space-after-wrap
(not (lispy--in-empty-list-p))
(not (eolp)))
(just-one-space)
(backward-char))))))
(defvar lispy-parens-preceding-syntax-alist
'((lisp-mode . ("[#`',.@]+" "#[0-9]*" "#[.,Ss+-]" "#[0-9]+[=Aa]"))
(emacs-lisp-mode . ("[#`',@]+" "#s" "#[0-9]+="))
(clojure-mode . ("[`'~@]+" "#" "#\\?@?"))
(clojurescript-mode . ("[`'~@]+" "#" "#\\?@?"))
(clojurec-mode . ("[`'~@]+" "#" "#\\?@?"))
(cider-repl-mode . ("[`'~@]+" "#" "#\\?@?"))
(cider-clojure-interaction-mode . ("[`'~@]+" "#" "#\\?@?"))
(t . ("[`',@]+")))
"An alist of `major-mode' to a list of regexps.
Each regexp describes valid syntax that can precede an opening paren in that
major mode. These regexps are used to determine whether to insert a space for
`lispy-parens'.")
(defvar lispy-brackets-preceding-syntax-alist
'((clojure-mode . ("[`']" "#[A-z.]*"))
(clojurescript-mode . ("[`']" "#[A-z.]*"))
(clojurec-mode . ("[`']" "#[A-z.]*"))
(cider-repl-mode . ("[`']" "#[A-z.]*"))
(cider-clojure-interaction-mode . ("[`']" "#[A-z.]*"))
(t . nil))
"An alist of `major-mode' to a list of regexps.
Each regexp describes valid syntax that can precede an opening bracket in that
major mode. These regexps are used to determine whether to insert a space for
`lispy-brackets'.")
(defvar lispy-braces-preceding-syntax-alist
'((clojure-mode . ("[`'^]" "#[A-z.]*"))
(clojurescript-mode . ("[`'^]" "#[A-z.]*"))
(clojurec-mode . ("[`'^]" "#[A-z.]*"))
(cider-repl-mode . ("[`'^]" "#[A-z.]*"))
(cider-clojure-interaction-mode . ("[`'^]" "#[A-z.]*"))
(t . nil))
"An alist of `major-mode' to a list of regexps.
Each regexp describes valid syntax that can precede an opening brace in that
major mode. These regexps are used to determine whether to insert a space for
`lispy-braces'.")
(defalias 'lispy-parens
(lispy-pair "(" ")" 'lispy-parens-preceding-syntax-alist)
"`lispy-pair' with ().")
(defalias 'lispy-brackets
(lispy-pair "[" "]" 'lispy-brackets-preceding-syntax-alist)
"`lispy-pair' with [].")
(defalias 'lispy-braces
(lispy-pair "{" "}" 'lispy-braces-preceding-syntax-alist)
"`lispy-pair' with {}.")
(defun lispy-quotes (arg)
"Insert a pair of quotes around the point.
When the region is active, wrap it in quotes instead.
When inside string, if ARG is nil quotes are quoted,
otherwise the whole string is unquoted."
(interactive "P")
(let (bnd)
(cond ((region-active-p)
(if arg
(lispy-unstringify)
(lispy-stringify)))
((and (setq bnd (lispy--bounds-string))
(not (= (point) (car bnd))))
(if arg
(lispy-unstringify)
(insert "\\\"\\\"")
(backward-char 2)))
(arg
(lispy-stringify))
((lispy-after-string-p "?\\")
(self-insert-command 1))
(t
(lispy--space-unless "^\\|\\s-\\|\\s(\\|[#]")
(insert "\"\"")
(unless (looking-at "\n\\|)\\|}\\|\\]\\|$")
(just-one-space)
(backward-char 1))
(backward-char)))))
(defun lispy-parens-down ()
"Exit the current sexp, and start a new sexp below."
(interactive)
(condition-case nil
(progn
(lispy--out-forward 1)
(if (looking-at "\n *\\()\\)")
(progn
(goto-char (match-beginning 1))
(insert "()")
(lispy--indent-for-tab)
(backward-char))
(insert "\n()")
(lispy--indent-for-tab)
(backward-char)))
(error (indent-new-comment-line))))
;;* Globals: insertion
(defun lispy-space (arg)
"Insert one space, with position depending on ARG.
If ARG is 2, amend the current list with a space from current side.
If ARG is 3, switch to the different side beforehand.
If jammed between parens, \"(|(\" unjam: \"(| (\"."
(interactive "p")
(cond ((bound-and-true-p edebug-active)
(edebug-step-mode))
((region-active-p)
(goto-char (region-end))
(deactivate-mark)
(insert " "))
((eq arg 4)
(when (lispy--leftp)
(lispy-different))
(backward-char)
(unless (lispy-bolp)
(newline-and-indent)))
((or (eq arg 2)
(when (eq arg 3)
(lispy-different)
t))
(if (lispy-left-p)
(progn
(forward-char)
(just-one-space)
(backward-char))
(backward-char)
(just-one-space)))
((and (lispy-looking-back lispy-left)
(not (eq ?\\ (char-before (match-beginning 0)))))
(call-interactively 'self-insert-command)
(backward-char))
(t
(call-interactively 'self-insert-command)
(when (and (lispy-left-p)
(lispy-looking-back "[[({] "))
(backward-char)))))
(defvar lispy-colon-no-space-regex
'((lisp-mode . "\\s-\\|[:^?#]\\|\\(?:\\s([[:word:]-]*\\)"))
"Overrides REGEX that `lispy-colon' will consider for `major-mode'.
`lispy-colon' will insert \" :\" instead of \" \" unless
`lispy-no-space' is t or `looking-back' REGEX.")
(defun lispy-colon ()
"Insert :."
(interactive)
(lispy--space-unless
(or (cdr (assoc major-mode lispy-colon-no-space-regex))
"\\s-\\|\\s(\\|[#:^?]"))
(insert ":"))
(defun lispy-hat ()
"Insert ^."
(interactive)
(lispy--space-unless "\\s-\\|\\s(\\|[:?]\\|\\\\")
(insert "^"))
(defun lispy-tick (arg)
"Insert ' ARG times.
When the region is active and marks a string, unquote it.
Otherwise, when the region is active, toggle ' at the start of the region."
(interactive "p")
(cond ((lispy--string-markedp)
(lispy-unstringify))
((region-active-p)
(lispy-toggle-char ?\'))
(t
(lispy--space-unless "\\s-\\|\\s(\\|[~#:?'`]\\|\\\\")
(self-insert-command arg))))
(defun lispy-underscore (&optional arg)
"Insert _ ARG times.
For Clojure modes, toggle #_ sexp comment."
(interactive "p")
(setq arg (or arg 1))
(if (memq major-mode lispy-clojure-modes)
(let ((leftp (lispy--leftp)))
(unless leftp
(lispy-different))
(if (lispy-after-string-p "#_")
(delete-char -2)
(insert "#_"))
(unless leftp
(lispy-different)))
(self-insert-command arg)))
(defun lispy-backtick ()
"Insert `."
(interactive)
(if (region-active-p)
(lispy--surround-region "`" "'")
(lispy--space-unless "\\s-\\|\\s(\\|[:?`']\\|\\\\")
(insert "`")))
(defun lispy-tilde (arg)
"Insert ~ ARG times.
When the region is active, toggle a ~ at the start of the region."
(interactive "p")
(if (region-active-p)
(lispy-toggle-char ?~)
(self-insert-command arg)))
(defun lispy-toggle-char (char)
"Toggle CHAR at the start of the region."
(let ((bnd (lispy--bounds-dwim))
deactivate-mark)
(save-excursion
(goto-char (car bnd))
(if (eq (char-after) char)
(delete-char 1)
(insert char)))))
(defun lispy-hash ()
"Insert #."
(interactive)
(if (and (or (memq major-mode lispy-clojure-modes)
(memq major-mode '(nrepl-repl-mode
cider-clojure-interaction-mode)))
(lispy-looking-back "\\sw #"))
(progn
(backward-delete-char 2)
(insert "#"))
(lispy--space-unless "\\s-\\|\\s(\\|[#:?'`,]\\\\?")
(insert "#")))
(declare-function cider-eval-print-last-sexp "ext:cider-interaction")
(declare-function ielm-return "ielm")
(defun lispy-newline-and-indent ()
"Insert newline."
(interactive)
(cond ((eq major-mode 'lisp-interaction-mode)
(setq this-command 'eval-last-sexp)
(eval-print-last-sexp))
((eq major-mode 'cider-clojure-interaction-mode)
(setq this-command 'cider-eval-print-last-sexp)
(cider-eval-print-last-sexp))
((eq major-mode 'cider-repl-mode)
(setq this-command 'cider-repl-newline-and-indent)
(cider-repl-newline-and-indent))
((eq major-mode 'inferior-emacs-lisp-mode)
(setq this-command 'ielm-return)
(ielm-return))
((lispy-left-p)
(skip-chars-backward ",@'`#")
(newline-and-indent)
(skip-chars-forward ",@'`#")
(indent-sexp))
(t
(lispy-newline-and-indent-plain))))
(declare-function cider-repl-return "ext:cider-repl")
(declare-function slime-repl-return "ext:slime-repl")
(declare-function sly-mrepl-return "ext:sly-mrepl")
(defun lispy-newline-and-indent-plain ()
"When in minibuffer, exit it. Otherwise forward to `newline-and-indent'."
(interactive)
(cl-case major-mode
(minibuffer-inactive-mode
(exit-minibuffer))
(cider-repl-mode
(cider-repl-return))
(slime-repl-mode
(slime-repl-return))
(sly-mrepl-mode
(sly-mrepl-return))
(python-mode
(newline-and-indent))
(t
(if (and (not (lispy--in-string-or-comment-p))
(if (memq major-mode lispy-clojure-modes)
(lispy-looking-back "[^#`'@~][#`'@~]+")
(lispy-looking-back "[^#`',@|][#`',@]+")))
(save-excursion
(goto-char (match-beginning 0))
(newline-and-indent))
(newline-and-indent))
(let ((lispy-ignore-whitespace t))
(save-excursion
(lispy--out-backward 1)
(unless (< 50000
(- (save-excursion (forward-list 1))
(point)))
(indent-sexp)))))))
(defun lispy-open-line (arg)
"Add ARG lines after the current expression.
When ARG is nagative, add them above instead"
(interactive "p")
(save-excursion
(cond ((lispy-left-p)
(forward-list))
((lispy-right-p))
(t
(lispy--out-forward 1)))
(if (> arg 0)
(newline arg)
(forward-list -1)
(newline (- arg))
(lispy--indent-for-tab))))
(defvar-local lispy-outline-header ";;"
"Store the buffer-local outline start.")
(defun lispy-meta-return ()
"Insert a new heading."
(interactive)
(let ((pt (point)))
(cond ((lispy--in-comment-p)
(end-of-line)
(newline))
((and (lispy-bolp)
(looking-at " *$"))
(delete-region
(line-beginning-position)
(line-end-position)))
(t
(lispy-beginning-of-defun)
(if (save-excursion
(forward-list 1)
(= (point) pt))
(progn
(forward-list 1)
(newline))
(newline)
(backward-char 1)))))
(insert lispy-outline-header
(make-string (max (lispy-outline-level) 1)
?\*)
" ")
(beginning-of-line))
(defun lispy-alt-line (&optional N)
"Do a context-aware exit, then `newline-and-indent', N times.
Exit branches:
- When in the minibuffer, exit the minibuffer.
- When in a string, exit the string.
- When \")|\", do nothing.
- When \" |)\", exit the list and normalize it.
- When \"|(\", move to the other side of the list.
- When there's a \")\" on the current line before the point, move there.
- Otherwise, move to the end of the line.
This should generally be useful when generating new code.
If you find yourself with:
(foo (bar (baz 1 2 \"3|\")))
calling this function consecutively, you will get a chance to add arguments
to all the functions, while maintaining the parens in a pretty state."
(interactive "p")
(setq N (or N 1))
(when (bound-and-true-p abbrev-mode)
(expand-abbrev))
(let (bnd)
(lispy-dotimes N
(cond ((> (minibuffer-depth) 0)
(exit-minibuffer))
((when (setq bnd (lispy--bounds-string))
(if (> (cdr bnd) (line-end-position))
(goto-char (cdr bnd))
(goto-char (cdr bnd))
nil)))
((lispy-right-p))
((looking-at lispy-right)
(when (eq (char-before) ?\ )
(lispy-right 1)))
((lispy-left-p)
(lispy-different))
((lispy-looking-back "^ +")
(if (re-search-forward lispy-right (line-end-position) t)
(backward-char 1)
(move-end-of-line 1)))
(t
(when bnd
(goto-char (cdr bnd)))
(let ((end (min (line-end-position)
(cdr (lispy--bounds-list)))))
(while (< (point) (1- end))
(forward-sexp)))))
(newline-and-indent))))
;;* Globals: miscellanea
(defun lispy-string-oneline ()
"Convert current string to one line."
(interactive)
(when (eq (char-before) ?\")
(backward-char 1))
(let (bnd str)
(setq str (lispy--string-dwim (setq bnd (lispy--bounds-string))))
(delete-region (car bnd) (cdr bnd))
(insert (replace-regexp-in-string "\n" "\\\\n" str))))
(defun lispy-iedit (&optional arg)
"Wrap around `iedit'."
(interactive "P")
(if iedit-mode
(iedit-mode nil)
(when (lispy-left-p)
(forward-char 1))
(if arg
(iedit-mode 0)
(iedit-mode))))
;;* Locals: navigation
;;** Occur
(defcustom lispy-occur-backend 'ivy
"Method to navigate to a line with `lispy-occur'."
:type '(choice
(const :tag "Ivy" ivy)
(const :tag "Helm" helm)))
(defvar lispy--occur-beg 1
"Start position of the top level sexp during `lispy-occur'.")
(defvar lispy--occur-end 1
"End position of the top level sexp during `lispy-occur'.")
(defun lispy--occur-candidates ()
"Return the candidates for `lispy-occur'."
(let ((bnd (save-excursion
(unless (and (bolp)
(lispy-left-p))
(beginning-of-defun))
(lispy--bounds-dwim)))
(line-number -1)
candidates)
(setq lispy--occur-beg (car bnd))
(setq lispy--occur-end (cdr bnd))
(save-excursion
(goto-char lispy--occur-beg)
(while (< (point) lispy--occur-end)
(push (format "%-3d %s"
(cl-incf line-number)
(buffer-substring
(line-beginning-position)
(line-end-position)))
candidates)
(forward-line 1)))
(nreverse candidates)))
(defun lispy--occur-preselect ()
"Initial candidate regex for `lispy-occur'."
(format "^%d"
(-
(line-number-at-pos (point))
(line-number-at-pos lispy--occur-beg))))
(defvar helm-input)
(declare-function helm "ext:helm")
(defun lispy-occur-action-goto-paren (x)
"Goto line X for `lispy-occur'."
(setq x (read x))
(goto-char lispy--occur-beg)
(let ((input (if (eq lispy-occur-backend 'helm)
helm-input
ivy-text))
str-or-comment)
(cond ((string= input "")
(forward-line x)
(back-to-indentation)
(when (re-search-forward lispy-left (line-end-position) t)
(goto-char (match-beginning 0))))
((setq str-or-comment
(progn
(forward-line x)
(re-search-forward (ivy--regex input)
(line-end-position) t)
(lispy--in-string-or-comment-p)))
(goto-char str-or-comment))
((re-search-backward lispy-left (line-beginning-position) t)
(goto-char (match-beginning 0)))
((re-search-forward lispy-left (line-end-position) t)
(goto-char (match-beginning 0)))
(t
(back-to-indentation)))))
(defun lispy-occur-action-goto-end (x)
"Goto line X for `lispy-occur'."
(setq x (read x))
(goto-char lispy--occur-beg)
(forward-line x)
(re-search-forward (ivy--regex ivy-text) (line-end-position) t))
(defun lispy-occur-action-goto-beg (x)
"Goto line X for `lispy-occur'."
(when (lispy-occur-action-goto-end x)
(goto-char (match-beginning 0))))
(defun lispy-occur-action-mc (_x)
"Make a fake cursor for each `lispy-occur' candidate."
(let ((cands (nreverse ivy--old-cands))
cand)
(while (setq cand (pop cands))
(goto-char lispy--occur-beg)
(forward-line (read cand))
(re-search-forward (ivy--regex ivy-text) (line-end-position) t)
(when cands
(mc/create-fake-cursor-at-point))))
(multiple-cursors-mode 1))
(ivy-set-actions
'lispy-occur
'(("m" lispy-occur-action-mc "multiple-cursors")
("j" lispy-occur-action-goto-beg "goto start")
("k" lispy-occur-action-goto-end "goto end")))
(defun lispy-occur ()
"Select a line within current top level sexp.
See `lispy-occur-backend' for the selection back end."
(interactive)
(swiper--init)
(cond ((eq lispy-occur-backend 'helm)
(require 'helm)
(add-hook 'helm-move-selection-after-hook
#'lispy--occur-update-input-helm)
(add-hook 'helm-update-hook
#'lispy--occur-update-input-helm)
(unwind-protect
(helm :sources
`((name . "this defun")
(candidates . ,(lispy--occur-candidates))
(action . lispy-occur-action-goto-paren)
(match-strict .
(lambda (x)
(ignore-errors
(string-match
(ivy--regex helm-input) x)))))
:preselect (lispy--occur-preselect)
:buffer "*lispy-occur*")
(swiper--cleanup)
(remove-hook 'helm-move-selection-after-hook
#'lispy--occur-update-input-helm)
(remove-hook 'helm-update-hook
#'lispy--occur-update-input-helm)))
((eq lispy-occur-backend 'ivy)
(unwind-protect
(ivy-read "pattern: "
(lispy--occur-candidates)
:preselect (lispy--occur-preselect)
:require-match t
:update-fn (lambda ()
(lispy--occur-update-input
ivy-text ivy--current))
:action #'lispy-occur-action-goto-paren
:caller 'lispy-occur)
(swiper--cleanup)
(when (null ivy-exit)
(goto-char swiper--opoint))))
(t
(error "Bad `lispy-occur-backend': %S" lispy-occur-backend))))
(defun lispy--occur-update-input-helm ()
"Update selection for `lispy-occur' using `helm' back end."
(lispy--occur-update-input
helm-input
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
(defun lispy--occur-update-input (input str)
"Update selection for `ivy-occur'.
INPUT is the current input text.
STR is the full current candidate."
(swiper--cleanup)
(let ((re (ivy--regex input))
(num (if (string-match "^[0-9]+" str)
(string-to-number (match-string 0 str))
0)))
(with-selected-window (ivy-state-window ivy-last)
(goto-char lispy--occur-beg)
(when (cl-plusp num)
(forward-line num)
(unless (<= (point) lispy--occur-end)
(recenter)))
(let ((ov (make-overlay (line-beginning-position)
(1+ (line-end-position)))))
(overlay-put ov 'face 'swiper-line-face)
(overlay-put ov 'window (ivy-state-window ivy-last))
(push ov swiper--overlays))
(swiper--add-overlays
re
lispy--occur-beg
lispy--occur-end))))
;;* Locals: Paredit transformations
(defun lispy--sub-slurp-forward (arg)
"Grow current marked symbol by ARG words forwards.
Return the amount of successful grow steps, nil instead of zero."
(when (looking-at "\\s_")
(let ((end (cdr (bounds-of-thing-at-point 'symbol)))
prev)
(lispy-dotimes arg
(setq prev (point))
(forward-word 1)
(when (> (point) end)
(goto-char prev)
(throw 'result (1- i)))))))
(defun lispy--sub-slurp-backward (arg)
"Grow current marked symbol by ARG backwards.
Return the amount of successful grow steps, nil instead of zero."
(when (lispy-looking-back "\\s_")
(let ((beg (car (bounds-of-thing-at-point 'symbol)))
prev)
(lispy-dotimes arg
(setq prev (point))
(backward-word 1)
(when (< (point) beg)
(goto-char prev)
(throw 'result (1- i)))))))
(defun lispy-slurp (arg)
"Grow current sexp by ARG sexps.
If ARG is zero, grow as far as possible. If ARG is -1, grow until the end or
beginning of the line. If it is not possible to slurp to the end of the line,
slurp as far as possible within the line. If before a multi-line list, slurp to
the end of the line where that list ends."
(interactive "p")
(if (region-active-p)
(if (= (point) (region-end))
(cond ((= arg 0)
(while (and (lispy-dotimes 1 (forward-sexp 1))
(not (looking-at "\\'")))))
((= arg -1)
(while (and (not (looking-at (concat lispy-right "*$")))
(lispy-dotimes 1 (forward-sexp 1)))))
((or (looking-at "\\s_")
(save-excursion
(goto-char (region-beginning))
(and (not (lispy-left-p))
(lispy-looking-back "\\s_"))))
(lispy--sub-slurp-forward arg))
((looking-at "[\n ]+;")
(goto-char (match-end 0))
(goto-char (cdr (lispy--bounds-comment))))
(t
(lispy-dotimes arg
(forward-sexp 1))))
(cond ((= arg 0)
(while (and (lispy-dotimes 1 (forward-sexp -1))
(not (looking-at "\\`")))))
((= arg -1)
(while (and (not (lispy-looking-back "^[[:space:]]*"))
(lispy-dotimes 1 (forward-sexp -1)))))
((or (and (not (lispy-left-p))
(lispy-looking-back "\\s_"))
(save-excursion
(goto-char (region-end))
(looking-at "\\s_")))
(lispy--sub-slurp-backward arg))
((save-excursion
(skip-chars-backward " \n")
(lispy--in-comment-p))
(skip-chars-backward " \n")
(goto-char (car (lispy--bounds-comment))))
(t
(lispy-dotimes arg
(forward-sexp -1)))))
(if (lispy-right-p)
(cond ((= arg 0)
(let ((last-pos (point)))
(while (and (lispy-dotimes 1
(lispy--slurp-forward)
(lispy--reindent))
(not (= (point) last-pos)))
(setq last-pos (point)))))
((= arg -1)
(while (and (not (looking-at (concat "\\("
lispy-right
"\\|$\\)")))
(lispy-dotimes 1
(lispy--slurp-forward)))))
(t
(lispy-dotimes arg
(lispy--slurp-forward))))
(if (lispy-left-p)
(cond ((= arg 0)
;; lispy--slurp-backward errors when reaching another delimiter
(while (and (lispy-dotimes 1
(lispy--slurp-backward))
(not (lispy-looking-back "\\`")))))
((= arg -1)
(while (and (not (lispy-looking-back "^[[:space:]]*"))
(lispy-dotimes 1
(lispy--slurp-backward)))))
(t
(lispy-dotimes arg
(lispy--slurp-backward))))))
(lispy--reindent)))
(defun lispy-down-slurp ()
"Move current sexp or region into the next sexp."
(interactive)
(let ((bnd (lispy--bounds-dwim))
(leftp (lispy--leftp))
(regionp (region-active-p))
(bolp (bolp))
deactivate-mark)
(when (lispy-left-p)
(forward-sexp))
(let ((pt (save-excursion
(when (lispy-forward 1)
(lispy-backward 1)
(point)))))
(when pt
(goto-char pt)
(lispy--teleport (car bnd) (cdr bnd) (not leftp) regionp)
(save-excursion
(backward-char 1)
(when (lispy-looking-back (concat lispy-right " +"))
(just-one-space))
(when (and bolp (lispy-looking-back "^ +"))
(delete-region (match-beginning 0)
(match-end 0)))
(indent-sexp))))))
(defun lispy-up-slurp ()
"Move current sexp or region into the previous sexp.
If the point is by itself on a line or followed only by right delimiters, slurp
the point into the previous list. This can be of thought as indenting the code
to the next level and adjusting the parentheses accordingly."
(interactive)
(let* ((empty-line-p (lispy--empty-line-p))
(list-start (when (eq empty-line-p 'right)
(save-excursion
(re-search-forward lispy-right)
(lispy-different)
(point))))
(failp (when list-start
(= list-start
(save-excursion
(re-search-backward lispy-left)
(point)))))
(bnd (if empty-line-p
(cons (point) (point))
(lispy--bounds-dwim)))
(regionp (region-active-p))
(endp (or (lispy-right-p)
(and (region-active-p) (= (point) (region-end)))))
p-beg p-end
(deactivate-mark nil)
bsize)
(deactivate-mark)
(goto-char (car bnd))
(if (or failp
(not (lispy-backward 1)))
(progn
(lispy-complain "No list above to slurp into")
(if regionp
(lispy--mark bnd)
(goto-char
(if endp
(cdr bnd)
(car bnd)))))
(setq p-beg (point))
(forward-list)
(setq p-end (point))
(goto-char (car bnd))
(setq bsize (buffer-size))
(lispy-save-excursion
(goto-char (cdr bnd))
(insert (char-before p-end))
(goto-char p-end)
(backward-delete-char 1)
(goto-char p-beg)
(indent-sexp))
(setq bnd (cons (point)
(+ (point)
(- (cdr bnd) (car bnd))
(- (buffer-size)
bsize
(- (point) (car bnd))
1))))
(when regionp
(lispy--mark bnd))
(if endp
(goto-char (cdr bnd))
(if (region-active-p)
(lispy-different)
(goto-char (car bnd)))))))
(defun lispy-indent-adjust-parens (arg)
"Indent the line if it is incorrectly indented or act as `lispy-up-slurp'.
If indenting does not adjust indentation or move the point, call
`lispy-up-slurp' ARG times."
(interactive "p")
(let ((tick (buffer-chars-modified-tick))
(pt (point))
(bnd (when (region-active-p)
(cons (region-beginning)
(region-end)))))
(indent-for-tab-command)
(when (and (= tick (buffer-chars-modified-tick))
(= pt (point)))
(if bnd
(lispy--mark bnd)
(unless (lispy--empty-line-p)
(set-mark (point))
(lispy-slurp -1)))
(dotimes (_ arg)
(lispy-up-slurp))
(when (and (not bnd)
(region-active-p))
(ignore-errors (lispy-different))
(deactivate-mark)))))
(defun lispy--backward-sexp-or-comment ()
"When in comment, move to the comment start.
Otherwise, move to the previous sexp."
(if (lispy--in-comment-p)
(goto-char (car (lispy--bounds-comment)))
(forward-sexp -1))
(skip-chars-backward " \n"))
(defun lispy--forward-sexp-or-comment ()
"When before comment, move to the comment end.
Otherwise, move to the next sexp."
(if (save-excursion
(skip-chars-forward " \n")
(lispy--in-comment-p))
(progn
(skip-chars-forward " \n")
(goto-char (cdr (lispy--bounds-comment))))
(forward-sexp 1)))
(defun lispy-barf (arg)
"Shrink current sexp or region by ARG sexps."
(interactive "p")
(cond ((region-active-p)
(let* ((bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
(one-symbolp (lispy--symbolp str)))
(if (= (point) (region-end))
(cond (one-symbolp
(lispy-dotimes arg
(if (re-search-backward "\\sw\\s_+" (region-beginning) t)
(forward-char 1)
(throw 'result i))))
((lispy--in-comment-p)
(goto-char (car (lispy--bounds-comment)))
(if (= (point) (region-beginning))
(goto-char (cdr (lispy--bounds-comment)))
(skip-chars-backward " \n")))
(t
(incf arg)
(lispy-dotimes arg
(lispy--backward-sexp-or-comment))
(when (< (point) (car bnd))
(goto-char (car bnd)))
(lispy--forward-sexp-or-comment)))
(cond (one-symbolp
(lispy-dotimes arg
(if (re-search-forward "\\s_+\\sw" (region-end) t)
(backward-char 1)
(throw 'result i))))
((lispy--in-comment-p)
(goto-char (cdr (lispy--bounds-comment)))
(if (= (region-beginning) (region-end))
(goto-char (car bnd))
(skip-chars-forward " \n")))
(t
(save-restriction
(narrow-to-region (point-min)
(region-end))
(incf arg)
(lispy-dotimes arg
(lispy--forward-sexp-or-comment))
(if (lispy--in-comment-p)
(goto-char (car (lispy--bounds-comment)))
(forward-sexp -1))
(widen)))))))
((looking-at "()"))
((lispy-right-p)
(lispy-dotimes arg
(lispy--barf-backward)))
((lispy-left-p)
(lispy-dotimes arg
(lispy--barf-forward)))))
(defun lispy-slurp-or-barf-right (arg)
"Barfs or slurps current sexp so that visually, the delimiter at point moves to the right.
When cursor is at lispy-right, will slurp ARG sexps forwards.
((a)| b c) -> ((a b)| c)
When lispy-left, will barf ARG sexps forwards.
(|(a b) c) -> (a |(b) c)"
(interactive "p")
(if (region-active-p)
(if (= (point) (region-end))
(lispy-slurp arg)
(lispy-barf arg))
(if (lispy-right-p)
(lispy-slurp arg)
(lispy-barf arg))))
(defun lispy-slurp-or-barf-left (arg)
"Barfs or slurps current sexp so that visually, the delimiter at point moves to the left.
When cursor is at lispy-right, will barf ARG sexps backwards.
(a (b c)|) -> (a (b)| c)
When lispy-left, will slurp ARG sexps forwards.
(a |(b) c) -> (|(a b) c)"
(interactive "p")
(if (region-active-p)
(if (= (point) (region-beginning))
(lispy-slurp arg)
(lispy-barf arg))
(if (lispy-left-p)
(lispy-slurp arg)
(lispy-barf arg))))
(defun lispy-splice (arg)
"Splice ARG sexps into containing list."
(interactive "p")
(lispy-dotimes arg
(let ((bnd (lispy--bounds-dwim))
(deactivate-mark nil))
(cond ((region-active-p)
(save-excursion
(goto-char (cdr bnd))
(re-search-backward lispy-right)
(delete-region (point) (cdr bnd)))
(save-excursion
(goto-char (car bnd))
(re-search-forward lispy-left)
(delete-region (car bnd) (point))))
((lispy-splice-let))
((lispy-left-p)
(save-excursion
(goto-char (cdr bnd))
(delete-char -1))
(lispy--delete-leading-garbage)
(delete-char 1)
(lispy-forward 1)
(lispy-backward 1))
((lispy-right-p)
(setq bnd (lispy--bounds-dwim))
(delete-char -1)
(goto-char (car bnd))
(let ((pt (point)))
(re-search-forward lispy-left nil t)
(delete-region pt (point)))
(lispy-backward 1)
(forward-list))
(t
(setq bnd (lispy--bounds-list))
(save-excursion
(goto-char (cdr bnd))
(delete-char -1))
(save-excursion
(goto-char (car bnd))
(delete-char 1)))))))
(defun lispy-find (item tree)
(cond ((null tree)
nil)
((consp tree)
(or (lispy-find item (car tree))
(lispy-find item (cdr tree))))
(t
(eq item tree))))
(defun lispy-splice-let ()
"Join the current `let' into the parent `let'."
(when (and (looking-at "(let")
(save-excursion
(lispy-left 1)
(looking-at "(let")))
(let ((child-binds (save-excursion
(lispy-flow 2)
(lispy--read (lispy--string-dwim))))
(parent-binds
(mapcar (lambda (x) (if (consp x) (car x) x))
(save-excursion
(lispy-up 1)
(lispy--read (lispy--string-dwim)))))
(end (save-excursion
(lispy-flow 2)
(point)))
(beg (save-excursion
(lispy-up 1)
(lispy-different)
(1- (point)))))
(save-excursion
(forward-list)
(delete-char -1))
(delete-region beg end)
(newline-and-indent)
(lispy-left 2)
(when (cl-find-if (lambda (v) (lispy-find v child-binds))
parent-binds)
(if (looking-at "(\\(let\\)")
(progn
(replace-match "(let*")
(lispy--out-backward 1)
(indent-sexp))
(error "unexpected")))
(lispy--normalize-1))
t))
(defun lispy-barf-to-point (arg)
"Barf to the closest sexp before the point.
When ARG is non-nil, barf from the left."
(interactive "P")
(if (and (not arg)
(looking-at lispy-right))
(forward-char)
(unless (or (not (cadr (syntax-ppss)))
(let ((str (lispy--bounds-string)))
(and str
(not (= (car str) (point))))))
(let ((line-number (line-number-at-pos))
split-moved-point-down)
(lispy-split)
(when (and arg
(not (= (line-number-at-pos) line-number)))
(setq split-moved-point-down t))
(lispy--normalize-1)
(cond (arg
(save-excursion
(lispy-up 1)
(lispy-splice 1))
(when split-moved-point-down
(lispy-delete-backward 1)))
(t
(save-excursion
(lispy-splice 1))
(join-line)
(when (looking-at " $")
(delete-char 1))))
(lispy--reindent 1)))))
(defun lispy-reverse ()
"Reverse the current list or region selection."
(interactive)
(let* ((leftp (lispy--leftp))
(bnd (lispy--bounds-dwim))
(expr (lispy--read (format "(%s)" (lispy--string-dwim bnd))))
(deactivate-mark nil))
(delete-region (car bnd) (cdr bnd))
(if (eq (length expr) 1)
(lispy--insert (nreverse (car expr)))
(lispy--insert (nreverse expr))
(lispy-splice 1))
(when leftp
(lispy-different))))
(defun lispy-raise (arg)
"Use current sexp or region as replacement for its parent.
Do so ARG times."
(interactive "p")
(lispy-dotimes arg
(let ((regionp (region-active-p))
(leftp (lispy--leftp))
(deactivate-mark nil)
bnd1 bnd2)
;; re-indent first
(lispy-save-excursion (lispy--out-forward 1))
(unless leftp
(lispy-different))
(setq bnd1 (lispy--bounds-dwim))
(deactivate-mark)
(lispy--out-forward 1)
(setq bnd2 (lispy--bounds-dwim))
(delete-region (cdr bnd2) (cdr bnd1))
(delete-region (car bnd2) (car bnd1))
(if regionp
(progn
(indent-region (car bnd2) (point))
(lispy--mark (cons (car bnd2) (point))))
(lispy-from-left
(indent-sexp)))
(unless (eq leftp (lispy--leftp))
(lispy-different)))))
(defun lispy-raise-some ()
"Use current sexps as replacement for their parent.
The outcome when ahead of sexps is different from when behind."
(interactive)
(let ((pt (point)))
(cond ((region-active-p))
((lispy-left-p)
(if (null (lispy--out-forward 1))
(progn
(goto-char pt)
(lispy-complain "Not enough depth to raise"))
(backward-char 1)
(set-mark (point))
(goto-char pt)))
((lispy-right-p)
(if (null (lispy--out-forward 1))
(progn
(goto-char pt)
(lispy-complain "Not enough depth to raise"))
(backward-list)
(forward-char 1)
(set-mark (point))
(goto-char pt)))
(t
(error "Unexpected")))
(lispy-raise 1)
(deactivate-mark)))
(defun lispy-convolute (arg)
"Replace (...(,,,|( with (,,,(...|( where ... and ,,, is arbitrary code.
When ARG is more than 1, pull ARGth expression to enclose current sexp."
(interactive "p")
(let ((deactivate-mark nil))
(if (and (save-excursion
(lispy--out-forward (1+ arg)))
(save-excursion
(lispy--out-backward (1+ arg))))
(let (beg end)
(lispy-from-left
(setq beg (point))
(setq end (lispy--out-backward arg))
(lispy--out-backward 1)
(lispy--swap-regions (cons beg end)
(cons (point) (point)))
(lispy--reindent arg))
(lispy-from-left
(lispy-different)
(setq beg (point))
(setq end (lispy--out-forward arg))
(lispy--out-forward 1)
(lispy--swap-regions (cons beg end)
(cons (point) (point)))
(ignore-errors
(lispy-different))
(lispy--reindent (1+ arg))))
(error "Not enough depth to convolute"))))
(defun lispy-convolute-left ()
"Convolute and move left.
Useful for propagating `let' bindings."
(interactive)
(if (region-active-p)
(progn
(lispy-convolute 1)
(lispy-left 1))
(user-error "region must be active")))
(defvar lispy-repeat--command nil
"Command to use with `lispy-repeat'.")
(defvar lispy-repeat--prefix-arg nil
"Prefix arg to use with `lispy-repeat'.")
(defun lispy-repeat ()
"Repeat last command with last prefix arg."
(interactive)
(unless (memq last-command
'(special-lispy-repeat lispy-repeat))
(setq lispy-repeat--command last-command)
(setq lispy-repeat--prefix-arg
(or last-prefix-arg 1)))
(setq current-prefix-arg lispy-repeat--prefix-arg)
(funcall lispy-repeat--command))
(defun lispy-join ()
"Join sexps."
(interactive)
(let ((pt (point))
bnd)
(cond ((lispy-right-p)
(when (lispy-forward 1)
(backward-list)
(delete-char 1)
(goto-char pt)
(backward-delete-char 1)
(lispy--out-forward 1)
(lispy--reindent 1)))
((lispy-left-p)
(when (lispy-backward 1)
(forward-list)
(backward-delete-char 1)
(goto-char (1- pt))
(delete-char 1)
(lispy-save-excursion
(forward-char 1)
(lispy-left 2)
(lispy--normalize-1))))
((and (setq bnd (lispy--bounds-string))
(or (save-excursion
(goto-char (car bnd))
(skip-chars-backward " \t\n")
(when (eq (char-before) ?\")
(delete-region (1- (point))
(1+ (car bnd)))
t))
(save-excursion
(goto-char (cdr bnd))
(skip-chars-forward " \t\n")
(when (looking-at "\"")
(delete-region (1- (cdr bnd))
(1+ (point)))
t))))))))
(defun lispy-split ()
"Split sexps."
(interactive)
(let (bnd
char-left
char-right)
(cond ((lispy--in-comment-p)
(indent-new-comment-line))
((and (setq bnd (lispy--bounds-string))
(not (= (point) (car bnd))))
(insert "\"\"")
(when (eolp)
(delete-char 1))
(backward-char)
(newline-and-indent))
(t
(when (save-excursion
(prog1 (lispy--out-forward 1)
(setq char-right (char-before))
(forward-list -1)
(setq char-left (char-after))))
(insert (string char-right char-left))
(backward-char 2)
(lispy-right 1))
(newline-and-indent)
(when (lispy-left-p)
(indent-sexp))))))
;;* Locals: more transformations
(defun lispy-move-up (arg)
"Move current expression up ARG times. Don't exit parent list.
Also works from inside the list."
(interactive "p")
(if (or (lispy-left-p)
(lispy-right-p)
(region-active-p)
(looking-at lispy-outline))
(lispy--move-up-special arg)
(let ((offset (-
(point)
(progn
(lispy--out-backward 1)
(point)))))
(lispy--move-up-special arg)
(forward-char offset))))
(defun lispy-move-down (arg)
"Move current expression down ARG times. Don't exit parent list.
Also works from inside the list."
(interactive "p")
(if (or (lispy-left-p)
(lispy-right-p)
(region-active-p)
(looking-at lispy-outline))
(lispy--move-down-special arg)
(let ((offset (-
(point)
(progn
(lispy--out-backward 1)
(point)))))
(lispy--move-down-special arg)
(forward-char offset))))
(defun lispy--move-up-region (arg)
"Swap the marked region ARG positions up.
Precondition: the region is active and the point is at `region-beginning'."
(cond
((and (looking-at "\\_<")
(save-excursion
(goto-char (region-end))
(looking-at "-"))))
((lispy-after-string-p "-")
(let ((bnd1 (lispy--bounds-dwim))
bnd2)
(lispy-up arg)
(setq bnd2 (lispy--bounds-dwim))
(lispy--swap-regions bnd1 bnd2)
(setq deactivate-mark nil)
(set-mark (point))
(forward-char (- (cdr bnd1) (car bnd1)))))
((= arg 1)
(let ((bnd1 (lispy--bounds-dwim))
(bnd0 (save-excursion
(deactivate-mark)
(if (ignore-errors (up-list) t)
(lispy--bounds-dwim)
(cons (point-min) (point-max)))))
bnd2)
(goto-char (car bnd1))
(if (re-search-backward "[^ \t\n`'#({[]" (car bnd0) t)
(progn
(deactivate-mark)
(if (lispy--in-comment-p)
(setq bnd2 (lispy--bounds-comment))
(when (eq (char-after) ?\")
(forward-char)
(backward-sexp))
(when (memq (char-after) '(?\) ?\] ?\}))
(forward-char))
(setq bnd2 (lispy--bounds-dwim)))
(lispy--swap-regions bnd1 bnd2)
(setq deactivate-mark nil)
(goto-char (car bnd2))
(set-mark (point))
(forward-char (- (cdr bnd1) (car bnd1))))
(setq deactivate-mark nil)
(lispy--mark bnd1)))
(exchange-point-and-mark))
(t
(let ((bnd1 (lispy--bounds-dwim)))
(lispy-up arg)
(lispy--mark
(car
(lispy--swap-regions
bnd1 (lispy--bounds-dwim)))))
(exchange-point-and-mark))))
(defun lispy--move-up-special (arg)
"Move current expression up ARG times. Don't exit parent list."
(let ((at-start (lispy--leftp)))
(unless (or at-start (looking-at lispy-outline))
(lispy-different))
(cond ((region-active-p)
(lispy--move-up-region arg))
((looking-at lispy-outline)
(lispy-move-outline-up arg))
(t
(lispy--mark (lispy--bounds-dwim))
(lispy-move-up arg)
(deactivate-mark)
(lispy-different)))
(unless at-start (lispy-different))))
(declare-function zo-up "zoutline")
(defun lispy-move-outline-up (arg)
(interactive)
(require 'zoutline)
(lispy-dotimes arg
(let ((lvl1 (lispy-outline-level))
(lvl2 (save-excursion
(backward-char)
(lispy-outline-level))))
(when (<= lvl1 lvl2)
(let ((bnd1 (lispy--bounds-outline))
(bnd2 (progn
(zo-up 1)
(lispy--bounds-outline))))
(if (or (equal bnd1 bnd2)
(and (eq (car bnd2) (point-min))
(not (save-excursion
(goto-char (point-min))
(looking-at lispy-outline)))))
(goto-char (car bnd1))
(lispy--swap-regions bnd1 bnd2)
(goto-char (car bnd2))))))))
(defun lispy--move-down-region (arg)
"Swap the marked region ARG positions down.
Precondition: the region is active and the point is at `region-beginning'."
(cond
((and (lispy-after-string-p "-")
(save-excursion
(goto-char (region-end))
(looking-at "\\_>"))))
((save-excursion
(goto-char (region-end))
(looking-at "-"))
(let ((bnd1 (lispy--bounds-dwim))
bnd2)
(lispy-down arg)
(setq bnd2 (lispy--bounds-dwim))
(lispy--swap-regions bnd1 bnd2)
(goto-char (cdr bnd2))
(setq deactivate-mark nil)
(set-mark (point))
(forward-char (- (car bnd1) (cdr bnd1)))))
((= arg 1)
(let ((bnd1 (lispy--bounds-dwim))
(bnd0 (save-excursion
(deactivate-mark)
(if (ignore-errors (up-list) t)
(lispy--bounds-dwim)
(cons (point-min) (point-max)))))
bnd2)
(goto-char (cdr bnd1))
(if (re-search-forward "[^ \t\n]" (max (1- (cdr bnd0))
(point)) t)
(progn
(deactivate-mark)
(if (lispy--in-comment-p)
(setq bnd2 (lispy--bounds-comment))
(when (memq (char-before) '(?\( ?\" ?\[ ?\{))
(backward-char))
(setq bnd2 (lispy--bounds-dwim)))
(lispy--swap-regions bnd1 bnd2)
(setq deactivate-mark nil)
(goto-char (cdr bnd2))
(set-mark (point))
(backward-char (- (cdr bnd1) (car bnd1))))
(lispy--mark bnd1)
(exchange-point-and-mark))))
(t
(let ((bnd1 (lispy--bounds-dwim)))
(lispy-down arg)
(lispy--mark
(cdr
(lispy--swap-regions
bnd1 (lispy--bounds-dwim))))
(lispy-different)))))
(defun lispy--move-down-special (arg)
"Move current expression down ARG times. Don't exit parent list."
(let ((at-start (lispy--leftp)))
(unless (or at-start (looking-at lispy-outline))
(lispy-different))
(cond ((region-active-p)
(lispy--move-down-region arg))
((looking-at lispy-outline)
(lispy-dotimes arg
(let ((bnd1 (lispy--bounds-outline))
bnd2)
(goto-char (1+ (cdr bnd1)))
(if (and (setq bnd2 (lispy--bounds-outline))
(not (equal bnd1 bnd2)))
(progn
(lispy--swap-regions bnd1 bnd2)
(forward-char (1+ (- (cdr bnd2) (car bnd2)))))
(goto-char (car bnd1))))))
(t
(lispy--mark (lispy--bounds-dwim))
(lispy-move-down arg)
(deactivate-mark)
(lispy-different)))
(unless at-start (lispy-different))))
(defun lispy-move-left (arg)
"Move region left ARG times."
(interactive "p")
(lispy-dotimes arg
(when (save-excursion (ignore-errors (up-list) t))
(let* ((regionp (region-active-p))
(leftp (lispy--leftp))
(bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
pt)
(delete-region (car bnd) (cdr bnd))
(cond ((looking-at " *;"))
((and (looking-at "\n")
(lispy-bolp))
(delete-region
(line-beginning-position)
(1+ (point))))
((looking-at "\\([\n ]+\\)[^\n ;]")
(delete-region (match-beginning 1)
(match-end 1))))
(deactivate-mark)
(lispy--out-backward 1)
(setq pt (point))
(insert str)
(newline-and-indent)
(skip-chars-backward " \n")
(indent-region pt (point))
(if regionp
(progn
(setq deactivate-mark nil)
(set-mark pt)
(when leftp
(exchange-point-and-mark)))
(when leftp
(lispy-different)))))))
(defun lispy-move-right (arg)
"Move region right ARG times."
(interactive "p")
(lispy-dotimes arg
(when (save-excursion (ignore-errors (up-list) t))
(let* ((regionp (region-active-p))
(leftp (lispy--leftp))
(bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
pt)
(delete-region (car bnd) (cdr bnd))
(cond ((looking-at " *;"))
((and (looking-at "\n")
(lispy-bolp))
(delete-region
(line-beginning-position)
(1+ (point))))
((looking-at "\\([\n ]+\\)[^\n ;]")
(delete-region (match-beginning 1)
(match-end 1))))
(lispy--out-backward 1)
(deactivate-mark)
(lispy-different)
(newline-and-indent)
(setq pt (point))
(insert str)
(indent-region pt (point))
(if regionp
(progn
(setq deactivate-mark nil)
(set-mark pt)
(when leftp
(exchange-point-and-mark)))
(when leftp
(lispy-different)))))))
(defun lispy-dedent-adjust-parens (arg)
"Move region or all the following sexps in the current list right.
This can be of thought as dedenting the code to the previous level and adjusting
the parentheses accordingly."
(interactive "p")
(let ((line-type (lispy--empty-line-p)))
(cond ((eq line-type 'right)
(unless (looking-at lispy-right)
(re-search-forward lispy-right)
(backward-char))
(lispy-dotimes arg
(when (looking-at "$")
(error "No longer in sexp"))
(unless (save-excursion
(forward-line -1)
(end-of-line)
(lispy--in-comment-p))
(lispy-delete-backward 1))
(forward-char)
(newline-and-indent)))
((region-active-p)
(lispy-move-right arg))
((not line-type)
(set-mark (point))
(lispy-slurp 0)
(lispy-move-right arg)
(lispy-different)
(deactivate-mark)))))
(defun lispy-clone (arg)
"Clone sexp ARG times.
When the sexp is top level, insert an additional newline."
(interactive "p")
(let* ((bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
(pt (point)))
(cond ((region-active-p)
(lispy-dotimes arg
(cl-labels
((doit ()
(let (deactivate-mark)
(save-excursion
(newline)
(insert str)
(lispy--indent-for-tab)))))
(if (= (point) (region-end))
(doit)
(exchange-point-and-mark)
(doit)
(exchange-point-and-mark)))))
((lispy-left-p)
(goto-char (car bnd))
(if (and (bolp) (looking-at "(defun"))
(lispy-dotimes arg
(insert str)
(newline)
(newline))
(lispy-dotimes arg
(insert str)
(newline-and-indent)))
(goto-char pt))
((lispy-right-p)
(if (save-excursion
(backward-list)
(and (bolp) (looking-at "(defun")))
(lispy-dotimes arg
(newline)
(newline-and-indent)
(insert str))
(lispy-dotimes arg
(newline-and-indent)
(insert str))))
(t
(error "Unexpected")))))
(defvar lispy--oneline-comments nil
"Collect comments for `lispy--oneline'.")
(defun lispy-mapcan-tree (func expr)
"Reduce with FUNC all lists in EXPR."
(cond ((null expr)
nil)
((and (vectorp expr) (> (length expr) 0))
(apply #'vector
(funcall func
(lispy-mapcan-tree func (aref expr 0))
(lispy-mapcan-tree
func
(cdr
(mapcar #'identity expr))))))
((listp expr)
(funcall func
(lispy-mapcan-tree func (car expr))
(lispy-mapcan-tree func (cdr expr))))
(t
expr)))
(defun lispy--oneline (expr &optional ignore-comments)
"Remove newlines from EXPR.
When IGNORE-COMMENTS is not nil, don't remove comments.
Instead keep them, with a newline after each comment."
(lispy-mapcan-tree
(lambda (x y)
(cond ((equal x '(ly-raw newline))
y)
((lispy--raw-comment-p x)
(if (null ignore-comments)
(progn
(push x lispy--oneline-comments)
y)
(if (equal (car y) '(ly-raw newline))
(cons x y)
`(,x (ly-raw newline) ,@y))))
((and (lispy--raw-string-p x)
(null ignore-comments))
(cons `(ly-raw string ,(replace-regexp-in-string "\n" "\\\\n" (caddr x)))
y))
(t
(cons x y))))
expr))
(defun lispy-oneline ()
"Squeeze current sexp into one line.
Comments will be moved ahead of sexp."
(interactive)
(if (lispy--in-comment-p)
(let* ((bnd (lispy--bounds-comment))
(str (lispy--string-dwim bnd)))
(delete-region (car bnd) (cdr bnd))
(insert ";; "
(mapconcat #'identity
(split-string str "[ \n]*;;[ \n]*" t)
" "))
(beginning-of-line)
(back-to-indentation))
(unless (or (lispy-left-p)
(lispy-right-p))
(lispy--out-backward 1))
(let* ((bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
(from-left (lispy-left-p))
expr)
(delete-region (car bnd) (cdr bnd))
(when (region-active-p)
(deactivate-mark))
(setq lispy--oneline-comments nil)
(if (setq expr (ignore-errors
(lispy--oneline
(lispy--read str))))
(progn
(mapc (lambda (x)
(lispy--insert x)
(newline))
lispy--oneline-comments)
(lispy--insert expr))
(let ((no-comment "")
comments)
(loop for s in (split-string str "\n" t)
do (if (string-match "^ *\\(;\\)" s)
(push (substring s (match-beginning 1)) comments)
(setq no-comment (concat no-comment "\n" s))))
(when comments
(insert (mapconcat #'identity comments "\n") "\n"))
(insert (substring
(replace-regexp-in-string "\n *" " " no-comment) 1))))
(when from-left
(backward-list)))))
(defun lispy-multiline (&optional arg)
"Spread current sexp over multiple lines.
When ARG is `fill', do nothing for short expressions."
(interactive "p")
(unless (or (lispy-left-p)
(lispy-right-p))
(lispy--out-backward 1))
(lispy-from-left
(let* ((bnd (lispy--bounds-list))
(str (lispy--string-dwim bnd))
(plain-expr (read str))
(expr (lispy--read str))
res)
(unless (and (eq arg 'fill)
(< (length str) 80))
(unless (listp plain-expr)
(setq plain-expr nil))
(if (or (cl-some #'listp plain-expr)
(member '(ly-raw newline) expr))
(let ((pt (point)))
(lispy-forward 1)
(while (and (lispy-flow 1) (> (point) pt))
(unless (looking-at "\]\\|)\\|\n")
(when (looking-at " *")
(replace-match "\n")
(backward-char 1))))
(goto-char pt)
(indent-sexp))
(delete-region (car bnd) (cdr bnd))
(setq res
(butlast
(cl-mapcan (lambda (y)
(if (memq y '(ly-raw clojure-map clojure-set))
(list y)
(list y '(ly-raw newline))))
(lispy--read str))))
(when (vectorp expr)
(setq res (apply #'vector res)))
(lispy--insert res))))))
(defvar-local lispy--multiline-take-3
'(defvar defun defmacro defcustom defgroup defvar-local declare-function
define-key nth throw define-error defadvice defhydra defsubst)
"List of constructs for which the first 3 elements are on the first line.")
(setq-mode-local
clojure-mode
lispy--multiline-take-3 '())
(defvar lispy--multiline-take-3-arg
'(defun defmacro declare-function define-error defadvice defhydra defsubst)
"List of constructs for which the first 3 elements are on the first line.
The third one is assumed to be the arglist and will not be changed.")
(defvar-local lispy--multiline-take-2
'(defface define-minor-mode
condition-case while incf car
cdr > >= < <= /= = eq equal incf
decf cl-incf cl-decf catch
require provide setq cons when
if unless interactive assq delq
assoc declare lambda remq
make-variable-buffer-local
bound-and-true-p
called-interactively-p
lispy-dotimes cond case cl-case
defalias 1+ 1- dotimes dolist boundp fboundp macrop
null consp oddp zerop plusp minusp kbd
not pop listp or and)
"List of constructs for which the first 2 elements are on the first line.")
(setq-mode-local
clojure-mode
lispy--multiline-take-2 '(loop recur for fn def defn ns if -> ->>
+ +' - -' * *' / > >= < <= = ==
or and not
assoc! assoc assoc-in concat))
(defvar lispy--multiline-take-2-arg '(declare lambda
make-variable-buffer-local
bound-and-true-p
called-interactively-p
lispy-dotimes dotimes)
"List of constructs for which the first 2 elements are on the first line.
The second one will not be changed.")
(defun lispy-interleave (x lst &optional step)
"Insert X in between each element of LST.
Don't insert X when it's already there.
When STEP is non-nil, insert in between each STEP elements instead."
(setq step (or step 1))
(let ((res (nreverse (lispy-multipop lst step)))
item)
(while lst
(unless (equal (car res) x)
(push x res))
(unless (equal (car res)
(car (setq item (lispy-multipop lst step))))
(setq res (nconc (nreverse item) res))))
(nreverse res)))
(defcustom lispy-multiline-threshold 32
"Don't multiline expresssions shorter than this when printed as a string."
:type 'integer)
(defun lispy--translate-newlines (str)
"Replace quoted newlines with real ones in STR."
(with-temp-buffer
(insert str)
(goto-char (point-min))
(while (re-search-forward "\\\\n" nil t)
(unless (= ?\\
(char-before (- (point) 2)))
(replace-match "\n" nil t)))
(buffer-string)))
(defun lispy--multiline-1 (expr &optional quoted)
"Transform a one-line EXPR into a multi-line.
When QUOTED is not nil, assume that EXPR is quoted and ignore some rules."
(cond ((vectorp expr)
(apply #'vector
(lispy--multiline-1
(mapcar #'identity expr))))
((not (listp expr))
expr)
((and lispy-multiline-threshold
(< (length (lispy--prin1-to-string
expr 0 'emacs-lisp-mode))
lispy-multiline-threshold))
expr)
(t
(let ((res nil)
elt)
(while expr
(setq elt (pop expr))
(cond
((eq elt 'ly-raw)
(cl-case (car expr)
(empty
(setq res '(ly-raw empty)))
(raw
(setq res (cons elt expr)))
(dot
(setq res (cons elt expr)))
(newline
(setq res '(ly-raw newline)))
(comment
(setq res (cons elt expr)))
(string
(setq res
`(ly-raw string
,(lispy--translate-newlines
(cadr expr)))))
(t (unless (= (length expr) 2)
(error "Unexpected expr: %S" expr))
(unless (null res)
(error "Stray ly-raw in %S" expr))
(setq res (list 'ly-raw (car expr)
(lispy--multiline-1
(cadr expr)
(car (memq (car expr) '(quote \` clojure-lambda))))))))
(setq expr nil))
((vectorp elt)
(push
(apply #'vector
(lispy--multiline-1
(mapcar #'identity elt)))
res)
(push '(ly-raw newline) res))
((equal elt '(ly-raw dot))
(when (equal (car res) '(ly-raw newline))
(pop res))
(push elt res))
((equal elt '(ly-raw clojure-comma))
;; two sexps without newlines, then a comma with a newline
(when (equal (car res) '(ly-raw newline))
(pop res))
(when (equal (cadr res) '(ly-raw newline))
(setq res
(cons (car res)
(cddr res))))
(push elt res)
(push '(ly-raw newline) res))
((and (not quoted) (memq elt lispy--multiline-take-3))
(push elt res)
;; name
(when expr
(push (pop expr) res))
;; value
(when expr
(if (memq elt lispy--multiline-take-3-arg)
(push (pop expr) res)
(push (car (lispy--multiline-1 (list (pop expr)))) res)))
(push '(ly-raw newline) res))
((and (not quoted) (memq elt lispy--multiline-take-2))
(push elt res)
(when (memq elt lispy--multiline-take-2-arg)
(push (pop expr) res)
(push '(ly-raw newline) res)))
((and (memq elt '(let let*))
expr
(or (memq major-mode lispy-clojure-modes)
(and
(listp (car expr))
(listp (cdar expr)))))
(push elt res)
(let ((body (pop expr)))
(push
(if (memq major-mode lispy-clojure-modes)
(apply #'vector
(lispy-interleave '(ly-raw newline)
(mapcar #'lispy--multiline-1 body) 2))
(lispy-interleave
'(ly-raw newline)
(mapcar
(lambda (x)
(if (and (listp x)
(not (eq (car x) 'ly-raw)))
(cons (car x)
(lispy--multiline-1 (cdr x)))
x))
body)))
res))
(push '(ly-raw newline) res))
((keywordp elt)
(push elt res))
((not (listp elt))
(push elt res)
(unless (and (numberp elt) (eq quoted 'clojure-lambda))
(push '(ly-raw newline) res)))
(t
(setq elt (lispy--multiline-1 elt))
(if (equal elt '(ly-raw newline))
(unless (equal elt (car res))
(push elt res))
(push elt res)
(push '(ly-raw newline) res)))))
(cond ((equal (car res) 'ly-raw)
res)
((equal (car res) '(ly-raw newline))
(if (and (cdr res)
(lispy--raw-comment-p (cadr res)))
(nreverse res)
(nreverse (cdr res))))
(t
(nreverse res)))))))
(defun lispy-alt-multiline (&optional silent)
"Spread current sexp over multiple lines.
When SILENT is non-nil, don't issue messages."
(interactive)
(unless (or (lispy-left-p)
(lispy-right-p))
(lispy--out-backward 1))
(let* ((bnd (lispy--bounds-dwim))
(str (lispy--string-dwim bnd))
(expr (lispy--read str))
(expr-o (lispy--oneline expr t))
(expr-m (lispy--multiline-1 expr-o))
(leftp (lispy--leftp)))
(cond ((equal expr expr-m)
(unless silent
(message "No change")))
((and (memq major-mode lispy-elisp-modes)
(not
(condition-case nil
(equal (read str)
(read (lispy--prin1-to-string
expr-m 0 major-mode)))
(error
(lispy-complain "Got an unreadable expr (probably overlay)")
t))))
(error "Got a bad transform: %S" expr-m))
(t
(delete-region (car bnd) (cdr bnd))
(lispy--insert expr-m)
(when leftp
(backward-list))))))
(defvar lispy-do-fill nil
"If t, `lispy-insert-1' will try to fill.")
(defun lispy-fill ()
"Fill current expression."
(interactive)
(if (or (lispy-left-p)
(lispy-right-p))
(let ((lispy-do-fill t))
(lispy--normalize-1))
(fill-paragraph)))
(defcustom lispy-move-after-commenting t
"When non-nil, adjust point to next sexp after commenting out a
sexp. If at last sexp in list, move out and backwards to
enclosing sexp."
:type 'boolean
:group 'lispy)
(defcustom lispy-comment-use-single-semicolon nil
"When non-nil, prefer single semicolons for comments at the
right of the source code (after lispy-right or at eol)."
:type 'boolean
:group 'lispy)
(defun lispy-comment (&optional arg)
"Comment ARG sexps."
(interactive "p")
(setq arg (or arg 1))
(if (and (> arg 1) (lispy--in-comment-p))
(let ((bnd (lispy--bounds-comment)))
(uncomment-region (car bnd) (cdr bnd)))
(lispy-dotimes arg
(let (bnd)
(cond ((region-active-p)
(comment-dwim nil)
(when (lispy--in-string-or-comment-p)
(lispy--out-backward 1)))
((lispy--in-string-or-comment-p)
(cond ((and (eq major-mode 'emacs-lisp-mode)
(lispy-after-string-p ";; "))
(delete-char -1)
(insert ";###autoload")
(forward-char 1))
((and lispy-comment-use-single-semicolon
(lispy-after-string-p "; "))
(delete-region
(point)
(progn
(skip-chars-backward "; \n")
(point)))
(insert " ;; "))
(t
(self-insert-command 1))))
((lispy-left-p)
(setq bnd (lispy--bounds-dwim))
(when lispy-move-after-commenting
(lispy-down 1))
(comment-region (car bnd) (cdr bnd))
(when lispy-move-after-commenting
(when (or (lispy--in-string-or-comment-p)
(looking-at ";"))
(lispy--out-backward 1))))
((lispy-right-p)
(if lispy-comment-use-single-semicolon
(progn
(unless (eolp)
(newline-and-indent)
(skip-chars-backward "\n\t "))
(comment-dwim nil)
(just-one-space))
(progn
(newline-and-indent)
(insert ";; ")
(unless (eolp)
(newline)
(lispy--reindent 1)
(skip-chars-backward "\n\t ")
(forward-char 1)))))
((eolp)
(comment-dwim nil)
(when lispy-comment-use-single-semicolon
(just-one-space)))
((looking-at " *[])}]")
(if lispy-comment-use-single-semicolon
(if (lispy-bolp)
(insert ";;\n")
(insert ";\n"))
(progn
(unless (lispy-bolp)
(insert "\n"))
(insert ";;\n")))
(when (lispy--out-forward 1)
(lispy--normalize-1))
(move-end-of-line 0)
(insert " "))
((lispy-bolp)
(let ((bnd (lispy--bounds-list)))
(cond ((null bnd)
(comment-region (point) (line-end-position)))
((<= (cdr bnd) (line-end-position))
(comment-region (point)
(1- (cdr bnd))))
(t
(let ((beg (point))
(ln-start (line-number-at-pos)))
(forward-sexp)
(while (and (= (line-number-at-pos) ln-start)
(not (eolp)))
(forward-sexp))
(comment-region beg (point))
(goto-char beg))))
(skip-chars-forward " ")))
((setq bnd (save-excursion
(and (lispy--out-forward 1)
(point))))
(let ((pt (point)))
(if (re-search-forward "\n" bnd t)
(if (= (count-matches lispy-left pt (point))
(count-matches lispy-right pt (point)))
(progn (comment-region pt (point))
(lispy-forward 1)
(lispy-backward 1))
(goto-char pt)
(re-search-forward lispy-left bnd t)
(backward-char 1)
(forward-list 1)
(comment-region pt (point))
(lispy-forward 1)
(lispy-backward 1))
(comment-region (point) (1- bnd))
(lispy--out-backward 1))))
(t
(self-insert-command 1)))))))
(defun lispy--quote-string (str &optional quote-newlines)
"Quote the quotes and backslashes in STR.
Quote the newlines if QUOTE-NEWLINES is t."
(setq str (replace-regexp-in-string "\\\\" "\\\\\\\\" str))
(setq str (replace-regexp-in-string "\"" "\\\\\"" str))
(if quote-newlines
(replace-regexp-in-string "\n" "\\\\n" str)
str))
(defun lispy-stringify (&optional arg)
"Transform current sexp into a string.
Quote newlines if ARG isn't 1."
(interactive "p")
(setq arg (or arg 1))
(let* ((bnd (lispy--bounds-dwim))
(pt (point))
(str-1 (buffer-substring-no-properties (car bnd) pt))
(str-2 (buffer-substring-no-properties pt (cdr bnd)))
(regionp (region-active-p))
(leftp (lispy--leftp))
deactivate-mark)
(when (and regionp leftp)
(exchange-point-and-mark))
(if (lispy--in-string-p)
(if regionp
(progn
(insert "\\\"")
(exchange-point-and-mark)
(insert "\\\"")
(backward-char 2)
(unless leftp
(exchange-point-and-mark)))
(lispy-complain "can't do anything useful here"))
(deactivate-mark)
(setq str-1 (lispy--quote-string str-1 (/= arg 1)))
(setq str-2 (lispy--quote-string str-2 (/= arg 1)))
(delete-region (car bnd) (cdr bnd))
(insert "\"" str-1)
(save-excursion (insert str-2 "\""))
(when regionp
(unless (looking-at "\"")
(backward-char 1))
(lispy-mark-symbol)
(if (and leftp (= (point) (region-end)))
(exchange-point-and-mark))))))
(defun lispy-unstringify ()
"Unquote string at point."
(interactive)
(if (region-active-p)
(if (lispy--string-markedp)
(let (deactivate-mark
(str (lispy--string-dwim))
(leftp (lispy--leftp)))
(delete-active-region)
(set-mark (point))
(insert (read str))
(when leftp
(lispy-different)))
(lispy-complain "the current region isn't a string"))
(let* ((bnd (lispy--bounds-string))
(str (lispy--string-dwim bnd))
(str-1 (concat (substring str 0 (- (point) (car bnd))) "\""))
(offset (length (read str-1))))
(delete-region (car bnd) (cdr bnd))
(save-excursion (insert (read str)))
(forward-char offset))))
(defvar lispy-teleport-global nil
"When non-nil, `lispy-teleport' will consider all open parens in window.
Otherwise, only parens within the current defun are considered.
When you press \"t\" in `lispy-teleport', this will be bound to t temporarily.")
(defmacro lispy-quit-and-run (&rest body)
"Quit the minibuffer and run BODY afterwards."
`(progn
(put 'quit 'error-message "")
(run-at-time nil nil
(lambda ()
(put 'quit 'error-message "Quit")
,@body))
(minibuffer-keyboard-quit)))
(defun lispy-teleport (arg)
"Move ARG sexps into a sexp determined by `lispy-ace-paren'."
(interactive "p")
(let ((beg (point))
end endp regionp
deactivate-mark)
(cond ((region-active-p)
(if (= (point) (region-end))
(progn
(setq end (region-beginning))
(setq endp t))
(setq end (region-end)))
(setq regionp t))
((lispy-left-p)
(unless (lispy-dotimes arg
(forward-list 1))
(error "Unexpected"))
(setq end (point)))
((lispy-right-p)
(setq endp t)
(unless (lispy-dotimes arg
(backward-list arg))
(error "Unexpected"))
(setq end (point)))
(t
(error "Unexpected")))
(let ((lispy-avy-keys (delete ?t lispy-avy-keys))
(avy-handler-function
(lambda (x)
(if (eq x ?t)
(progn
(avy--done)
(lispy-quit-and-run
(let ((lispy-teleport-global t))
(when regionp
(activate-mark))
(lispy-teleport arg))))
(avy-handler-default x)))))
(lispy-ace-paren
(when lispy-teleport-global
2)))
(forward-char 1)
(unless (looking-at "(")
(ignore-errors
(forward-sexp)))
(backward-char 1)
(lispy--teleport beg end endp regionp)))
;;* Locals: tags
(defun lispy-goto (&optional arg)
"Jump to symbol within files in current directory.
When ARG isn't nil, call `lispy-goto-projectile' instead."
(interactive "p")
(deactivate-mark)
(lispy--select-candidate
(mapcar #'lispy--format-tag-line
(cl-case arg
(1
(lispy--fetch-tags))
(2
(let ((lispy-force-reparse t))
(lispy--fetch-tags)))
(t
(lispy--fetch-tags-projectile))))
#'lispy--action-jump))
(defun lispy-goto-recursive ()
"Jump to symbol within files in current directory and its subdiretories."
(interactive)
(deactivate-mark)
(let ((candidates (lispy--fetch-tags-recursive)))
(lispy--select-candidate
(if (> (length candidates) 30000)
candidates
(mapcar #'lispy--format-tag-line candidates))
#'lispy--action-jump)))
(defun lispy-goto-local (&optional arg)
"Jump to symbol within current file.
When ARG is non-nil, force a reparse."
(interactive "P")
(deactivate-mark)
(let ((lispy-force-reparse arg))
(lispy--select-candidate
(mapcar #'lispy--format-tag-line
(lispy--fetch-tags (list (buffer-file-name))))
#'lispy--action-jump)))
(defun lispy-goto-elisp-commands (&optional arg)
"Jump to Elisp commands within current file.
When ARG is non-nil, force a reparse."
(interactive "P")
(deactivate-mark)
(let ((lispy-force-reparse arg))
(lispy--fetch-tags (list (buffer-file-name)))
(let ((struct (gethash (buffer-file-name) lispy-db)))
(lispy--select-candidate
(mapcar #'lispy--format-tag-line
(delq nil
(cl-mapcar
(lambda (tag pretty-tag)
(when (semantic-tag-get-attribute tag :user-visible-flag)
pretty-tag))
(lispy-dbfile-plain-tags struct)
(lispy-dbfile-tags struct))))
#'lispy--action-jump))))
(defun lispy-goto-projectile ()
"Jump to symbol within files in (`projectile-project-root')."
(interactive)
(deactivate-mark)
(lispy--goto 'lispy--fetch-tags-projectile))
(defun lispy-goto-def-down (arg)
"Jump to definition of ARGth element of current list."
(interactive "p")
(let* ((expr (read (lispy--string-dwim)))
(n (length expr)))
(if (>= arg n)
(error "Out of range: %s/%s" arg n)
(let ((elt (nth arg expr)))
(while (consp elt)
(if (eq (car elt) 'quote)