Personal emacs config
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

9493 lines
332 KiB

  1. ;;; lispy.el --- vi-like Paredit. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2014-2019 Oleh Krehel
  3. ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
  4. ;; URL: https://github.com/abo-abo/lispy
  5. ;; Version: 0.27.0
  6. ;; Keywords: lisp
  7. ;; This file is not part of GNU Emacs
  8. ;; This file is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 3, or (at your option)
  11. ;; any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; For a full copy of the GNU General Public License
  17. ;; see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;;
  20. ;; Due to the structure of Lisp syntax it's very rare for the
  21. ;; programmer to want to insert characters right before "(" or right
  22. ;; after ")". Thus unprefixed printable characters can be used to call
  23. ;; commands when the point is at one of these locations, which are
  24. ;; further referred to as special.
  25. ;;
  26. ;; Conveniently, when located at special position it's very clear to
  27. ;; which sexp the list-manipulating command will be applied to, what
  28. ;; the result be and where the point should end up afterwards. You
  29. ;; can enhance this effect with `show-paren-mode' or similar.
  30. ;;
  31. ;; Here's an illustration to this effect, with `lispy-clone' ("*"
  32. ;; represents the point):
  33. ;; |--------------------+-----+--------------------|
  34. ;; | before | key | after |
  35. ;; |--------------------+-----+--------------------|
  36. ;; | (looking-at "(")* | c | (looking-at "(") |
  37. ;; | | | (looking-at "(")* |
  38. ;; |--------------------+-----+--------------------|
  39. ;; | *(looking-at "(") | c | *(looking-at "(") |
  40. ;; | | | (looking-at "(") |
  41. ;; |--------------------+-----+--------------------|
  42. ;;
  43. ;; When special, the digit keys call `digit-argument', since most
  44. ;; `lispy' commands accept a numeric argument. For instance, "3c" is
  45. ;; equivalent to "ccc" (clone sexp 3 times), and "4j" is equivalent to
  46. ;; "jjjj" (move point 4 sexps down). Some useful applications are
  47. ;; "9l" and "9h" - they exit list forwards and backwards respectively
  48. ;; at most 9 times which makes them effectively equivalent to
  49. ;; `end-of-defun' and `beginning-of-defun'.
  50. ;;
  51. ;; To move the point into a special position, use:
  52. ;; "]" - calls `lispy-forward'
  53. ;; "[" - calls `lispy-backward'
  54. ;; "C-3" - calls `lispy-right' (exit current list forwards)
  55. ;; ")" - calls `lispy-right-nostring' (exit current list
  56. ;; forwards, but self-insert in strings and comments)
  57. ;;
  58. ;; These are the few Lispy commands that don't care whether the point
  59. ;; is special or not. Other such bindings are `DEL', `C-d', `C-k'.
  60. ;;
  61. ;; To get out of the special position, you can use any of the good-old
  62. ;; navigational commands such as `C-f' or `C-n'.
  63. ;; Additionally `SPC' will break out of special to get around the
  64. ;; situation when you have the point between open parens like this
  65. ;; "(|(" and want to start inserting. `SPC' will change the code to
  66. ;; this: "(| (".
  67. ;;
  68. ;; A lot of Lispy commands come in pairs: one reverses the other.
  69. ;; Some examples are:
  70. ;; |-----+--------------------------+------------+-------------------|
  71. ;; | key | command | key | command |
  72. ;; |-----+--------------------------+------------+-------------------|
  73. ;; | j | `lispy-down' | k | `lispy-up' |
  74. ;; | s | `lispy-move-down' | w | `lispy-move-up' |
  75. ;; | > | `lispy-slurp' | < | `lispy-barf' |
  76. ;; | c | `lispy-clone' | C-d or DEL | |
  77. ;; | C | `lispy-convolute' | C | reverses itself |
  78. ;; | d | `lispy-different' | d | reverses itself |
  79. ;; | M-j | `lispy-split' | + | `lispy-join' |
  80. ;; | O | `lispy-oneline' | M | `lispy-multiline' |
  81. ;; | S | `lispy-stringify' | C-u " | `lispy-quotes' |
  82. ;; | ; | `lispy-comment' | C-u ; | `lispy-comment' |
  83. ;; | xi | `lispy-to-ifs' | xc | `lispy-to-cond' |
  84. ;; | F | `lispy-follow' | D | `pop-tag-mark' |
  85. ;; |-----+--------------------------+------------+-------------------|
  86. ;;
  87. ;; Here's a list of commands for inserting pairs:
  88. ;; |-----+------------------------------------|
  89. ;; | key | command |
  90. ;; |-----+------------------------------------|
  91. ;; | ( | `lispy-parens' |
  92. ;; | { | `lispy-braces' |
  93. ;; | } | `lispy-brackets' |
  94. ;; | " | `lispy-quotes' |
  95. ;; |-----+------------------------------------|
  96. ;;
  97. ;; Here's a list of modified insertion commands that handle whitespace
  98. ;; in addition to self-inserting:
  99. ;; |-----+------------------------------------|
  100. ;; | key | command |
  101. ;; |-----+------------------------------------|
  102. ;; | SPC | `lispy-space' |
  103. ;; | : | `lispy-colon' |
  104. ;; | ^ | `lispy-hat' |
  105. ;; | ' | `lispy-tick' |
  106. ;; | ` | `lispy-backtick' |
  107. ;; | C-m | `lispy-newline-and-indent' |
  108. ;; |-----+------------------------------------|
  109. ;;
  110. ;; You can see the full list of bound commands with "F1 f lispy-mode".
  111. ;;
  112. ;; Most special commands will leave the point special after they're
  113. ;; done. This allows to chain them as well as apply them continuously
  114. ;; by holding the key. Some useful holdable keys are "jkf<>cws;".
  115. ;; Not so useful, but fun is "/": start it from "|(" position and hold
  116. ;; until all your Lisp code is turned into Python :).
  117. ;;
  118. ;; Some Clojure support depends on `cider'.
  119. ;; Some Scheme support depends on `geiser'.
  120. ;; Some Common Lisp support depends on `slime' or `sly'.
  121. ;; You can get them from MELPA.
  122. ;;
  123. ;; See http://abo-abo.github.io/lispy/ for a detailed documentation.
  124. ;;
  125. ;;; Code:
  126. ;;* Requires
  127. (eval-when-compile
  128. (require 'org)
  129. (require 'iedit)
  130. (require 'eldoc)
  131. (require 'ediff)
  132. (require 'ediff-util)
  133. (require 'semantic)
  134. (require 'semantic/db))
  135. (require 'mode-local)
  136. (require 'lispy-tags)
  137. (require 'help-fns)
  138. (require 'edebug)
  139. (require 'etags)
  140. (require 'outline)
  141. (require 'avy)
  142. (require 'newcomment)
  143. (require 'lispy-inline)
  144. (setq iedit-toggle-key-default nil)
  145. (require 'delsel)
  146. (require 'swiper)
  147. (require 'pcase)
  148. (require 'hydra)
  149. (defsubst lispy-looking-back (regexp)
  150. "Forward to (`looking-back' REGEXP)."
  151. (looking-back regexp (line-beginning-position)))
  152. ;;* Locals: extract block
  153. (defvar lispy-map-input-overlay nil
  154. "The input overlay for mapping transformations.")
  155. (defvar lispy-map-target-beg 1
  156. "The target start for mapping transformations.")
  157. (defvar lispy-map-target-len 1
  158. "The target end for mapping transformations.")
  159. (defvar-local lispy-outline-header ";;"
  160. "Store the buffer-local outline start.")
  161. (defvar lispy-map-format-function nil)
  162. ;;* Customization
  163. (defgroup lispy nil
  164. "List navigation and editing for the Lisp family."
  165. :group 'bindings
  166. :prefix "lispy-")
  167. (defvar lispy-left "[([{]"
  168. "Opening delimiter.")
  169. (defvar lispy-right "[])}]"
  170. "Closing delimiter.")
  171. (defvar lispy-outline "^;;\\(?:;[^#]\\|\\*+\\)"
  172. "Outline delimiter.")
  173. (defcustom lispy-no-space nil
  174. "When non-nil, don't insert a space before parens/brackets/braces/colons."
  175. :type 'boolean
  176. :group 'lispy)
  177. (make-variable-buffer-local 'lispy-no-space)
  178. (defcustom lispy-lax-eval t
  179. "When non-nil, fix \"unbound variable\" error by setting the it to nil.
  180. This is useful when hacking functions with &optional arguments.
  181. So evaling (setq mode (or mode major-mode)) will set mode to nil on
  182. the first eval, and to major-mode on the second eval."
  183. :type 'boolean
  184. :group 'lispy)
  185. (defcustom lispy-verbose t
  186. "If t, lispy will display some messages on error state.
  187. These messages are similar to \"Beginning of buffer\" error for
  188. `backward-char' and can safely be ignored."
  189. :type 'boolean
  190. :group 'lispy)
  191. (defcustom lispy-verbose-verbs t
  192. "If t, verbs produced by `lispy-defverb' will have a hint in the echo area.
  193. The hint will consist of the possible nouns that apply to the verb."
  194. :type 'boolean
  195. :group 'lispy)
  196. (defcustom lispy-close-quotes-at-end-p nil
  197. "If t, when pressing the `\"' at the end of a quoted string, it will move you past the end quote."
  198. :type 'boolean
  199. :group 'lispy)
  200. (defcustom lispy-helm-columns '(70 80)
  201. "Max lengths of tag and tag+filename when completing with `helm'."
  202. :group 'lispy
  203. :type '(list integer integer))
  204. (defcustom lispy-no-permanent-semantic nil
  205. "When t, `lispy' will not enable function `semantic-mode' when it's off."
  206. :type 'boolean
  207. :group 'lispy)
  208. (defcustom lispy-completion-method 'ivy
  209. "Method to select a candidate from a list of strings."
  210. :type '(choice
  211. (const :tag "Ivy" ivy)
  212. ;; sensible choice for many tags
  213. (const :tag "Helm" helm)
  214. ;; `ido-vertical-mode' is highly recommended here
  215. (const :tag "Ido" ido)
  216. ;; `icomplete-mode' and `icy-mode' will affect this
  217. (const :tag "Default" default)))
  218. (defcustom lispy-visit-method 'ffip
  219. "Method to switch to a file in the current project."
  220. :type '(choice
  221. (const :tag "Find File in Project" ffip)
  222. (const :tag "Projectile" projectile)))
  223. (defcustom lispy-avy-style-char 'pre
  224. "Method of displaying the overlays for a char during visual selection."
  225. :type '(choice
  226. (const :tag "Pre" pre)
  227. (const :tag "At" at)
  228. (const :tag "At full" at-full)
  229. (const :tag "Post" post)))
  230. (defcustom lispy-avy-style-paren 'at
  231. "Method of displaying the overlays for a paren during visual selection."
  232. :type '(choice
  233. (const :tag "Pre" pre)
  234. (const :tag "At" at)
  235. (const :tag "At full" at-full)
  236. (const :tag "Post" post)))
  237. (defcustom lispy-avy-style-symbol 'pre
  238. "Method of displaying the overlays for a symbol during visual selection."
  239. :type '(choice
  240. (const :tag "Pre" pre)
  241. (const :tag "At" at)
  242. (const :tag "At full" at-full)
  243. (const :tag "Post" post)))
  244. (defcustom lispy-avy-keys (number-sequence ?a ?z)
  245. "Keys for jumping."
  246. :type '(repeat :tag "Keys" (character :tag "char")))
  247. (defface lispy-command-name-face
  248. '((((class color) (background light))
  249. :background "#d8d8f7" :inherit font-lock-function-name-face)
  250. (((class color) (background dark))
  251. :background "#333333" :inherit font-lock-function-name-face))
  252. "Face for Elisp commands."
  253. :group 'lispy-faces)
  254. (defface lispy-cursor-face
  255. '((((class color) (background light))
  256. :background "#000000" :foreground "#ffffff")
  257. (((class color) (background dark))
  258. :background "#ffffff" :foreground "#000000"))
  259. "Face for `lispy-view-test'."
  260. :group 'lispy-faces)
  261. (defface lispy-test-face
  262. '((t (:inherit lispy-face-hint)))
  263. "Face for `lispy-view-test'."
  264. :group 'lispy-faces)
  265. (defvar lispy-mode-map (make-sparse-keymap))
  266. (defvar lispy-known-verbs nil
  267. "List of registered verbs.")
  268. (defvar lispy-ignore-whitespace nil
  269. "When set to t, function `lispy-right' will not clean up whitespace.")
  270. (defcustom lispy-compat '(edebug)
  271. "List of package compatibility options.
  272. Enabling them adds overhead, so make sure that you are actually
  273. using those packages."
  274. :type '(repeat
  275. (choice
  276. (const :tag "god-mode" god-mode)
  277. (const :tag "magit-blame-mode" magit-blame-mode)
  278. (const :tag "edebug" edebug)
  279. (const :tag "cider" cider)
  280. (const :tag "macrostep" macrostep))))
  281. (defvar-local lispy-old-outline-settings nil
  282. "Store the old values of `outline-regexp' and `outline-level'.
  283. `lispy-mode' overrides those while it's on.")
  284. (defcustom lispy-safe-delete nil
  285. "When non-nil, killing/deleting an active region keeps delimiters balanced.
  286. This applies to `lispy-delete', `lispy-kill-at-point', `lispy-paste', and
  287. `lispy-delete-backward'. This also applies to `lispy-yank' when
  288. `delete-selection-mode' is non-nil."
  289. :group 'lispy
  290. :type 'boolean)
  291. (defcustom lispy-safe-copy nil
  292. "When non-nil, `lispy-new-copy' won't copy unbalanced delimiters in a region."
  293. :group 'lispy
  294. :type 'boolean)
  295. (defcustom lispy-safe-paste nil
  296. "When non-nil, `lispy-paste' and `lispy-yank' will add missing delimiters."
  297. :group 'lispy
  298. :type 'boolean)
  299. (defcustom lispy-safe-threshold 1500
  300. "The max size of an active region that lispy will try to keep balanced.
  301. This only applies when `lispy-safe-delete', `lispy-safe-copy', and/or
  302. `lispy-safe-paste' are non-nil."
  303. :group 'lispy
  304. :type 'number)
  305. (defcustom lispy-safe-actions-ignore-strings t
  306. "When non-nil, don't try to act safely in strings.
  307. Any unmatched delimiters inside of strings will be copied or deleted. This only
  308. applies when `lispy-safe-delete', `lispy-safe-copy', and/or `lispy-safe-paste'
  309. are non-nil."
  310. :group 'lispy
  311. :type 'boolean)
  312. (defcustom lispy-safe-actions-ignore-comments t
  313. "When non-nil, don't try to act safely in comments.
  314. Any unmatched delimiters inside of comments will be copied or deleted. This only
  315. applies when `lispy-safe-delete', `lispy-safe-copy', and/or `lispy-safe-paste'
  316. are non-nil."
  317. :group 'lispy
  318. :type 'boolean)
  319. (defcustom lispy-safe-actions-no-pull-delimiters-into-comments nil
  320. "When non-nil, don't pull unmatched delimiters into comments when deleting.
  321. This prevents the accidental unbalancing of expressions from commenting out
  322. delimiters. This only applies when `lispy-safe-delete', `lispy-safe-copy',
  323. and/or `lispy-safe-paste' are non-nil."
  324. :group 'lispy
  325. :type 'boolean)
  326. (defcustom lispy-insert-space-after-wrap t
  327. "When non-nil, insert a space after the point when wrapping.
  328. This applies to the commands that use `lispy-pair'."
  329. :group 'lispy
  330. :type 'boolean)
  331. (defun lispy-dir-string< (a b)
  332. (if (string-match "/$" a)
  333. (if (string-match "/$" b)
  334. (string< a b)
  335. t)
  336. (if (string-match "/$" b)
  337. nil
  338. (string< a b))))
  339. (defun lispy--normalize-files (fs)
  340. (cl-sort
  341. (cl-set-difference
  342. fs
  343. '("./" "../") :test #'equal)
  344. #'lispy-dir-string<))
  345. (defun lispy--completion-common-len (str)
  346. (if (eq (get-text-property 0 'face str)
  347. 'completions-common-part)
  348. (next-property-change 0 str)
  349. 0))
  350. (defun lispy--complete-fname-1 (str pt)
  351. "Try to complete a partial file name in STR at PT.
  352. Depends on `default-directory'."
  353. (with-temp-buffer
  354. (insert str)
  355. (comint-mode)
  356. (let* ((com (comint-filename-completion))
  357. (cands
  358. (all-completions
  359. (buffer-substring-no-properties
  360. (nth 0 com)
  361. (nth 1 com))
  362. (nth 2 com))))
  363. (when com
  364. (list (- pt (lispy--completion-common-len (car cands)))
  365. pt
  366. (delete
  367. "../"
  368. (delete
  369. "./"
  370. (all-completions
  371. (buffer-substring-no-properties
  372. (nth 0 com)
  373. (nth 1 com))
  374. (nth 2 com)))))))))
  375. (defun lispy-complete-fname-at-point ()
  376. "Completion source for `completion-at-point-functions'."
  377. (when (lispy--in-string-p)
  378. (let ((ini-bnd (bounds-of-thing-at-point 'filename)))
  379. (if ini-bnd
  380. (lispy--complete-fname-1
  381. (buffer-substring-no-properties (car ini-bnd) (point))
  382. (point))
  383. (list (point) (point)
  384. (lispy--normalize-files
  385. (all-completions "" #'read-file-name-internal)))))))
  386. ;;;###autoload
  387. (define-minor-mode lispy-mode
  388. "Minor mode for navigating and editing LISP dialects.
  389. When `lispy-mode' is on, most unprefixed keys,
  390. i.e. [a-zA-Z+-./<>], conditionally call commands instead of
  391. self-inserting. The condition (called special further on) is one
  392. of:
  393. - the point is before \"(\"
  394. - the point is after \")\"
  395. - the region is active
  396. For instance, when special, \"j\" moves down one sexp, otherwise
  397. it inserts itself.
  398. When special, [0-9] call `digit-argument'.
  399. When `lispy-mode' is on, \"[\" and \"]\" move forward and
  400. backward through lists, which is useful to move into special.
  401. \\{lispy-mode-map}"
  402. :keymap lispy-mode-map
  403. :group 'lispy
  404. :lighter " LY"
  405. (if lispy-mode
  406. (progn
  407. (require 'eldoc)
  408. (eldoc-remove-command 'special-lispy-eval)
  409. (eldoc-remove-command 'special-lispy-x)
  410. (eldoc-add-command 'lispy-space)
  411. (setq lispy-old-outline-settings
  412. (cons outline-regexp outline-level))
  413. (setq-local outline-level 'lispy-outline-level)
  414. (cond ((eq major-mode 'latex-mode)
  415. (setq-local lispy-outline "^\\(?:%\\*+\\|\\\\\\(?:sub\\)?section{\\)")
  416. (setq lispy-outline-header "%")
  417. (setq-local outline-regexp "\\(?:%\\*+\\|\\\\\\(?:sub\\)?section{\\)"))
  418. ((eq major-mode 'clojure-mode)
  419. (require 'le-clojure)
  420. (setq completion-at-point-functions
  421. '(lispy-clojure-complete-at-point
  422. cider-complete-at-point))
  423. (setq-local outline-regexp (substring lispy-outline 1)))
  424. ((eq major-mode 'python-mode)
  425. (setq-local lispy-outline "^#\\*+")
  426. (setq lispy-outline-header "#")
  427. (setq-local outline-regexp "#\\*+")
  428. (setq-local outline-heading-end-regexp "\n"))
  429. (t
  430. (setq-local outline-regexp (substring lispy-outline 1))))
  431. (when (called-interactively-p 'any)
  432. (mapc #'lispy-raise-minor-mode
  433. (cons 'lispy-mode lispy-known-verbs))))
  434. (when lispy-old-outline-settings
  435. (setq outline-regexp (car lispy-old-outline-settings))
  436. (setq outline-level (cdr lispy-old-outline-settings))
  437. (setq lispy-old-outline-settings nil))))
  438. (defun lispy-raise-minor-mode (mode)
  439. "Make MODE the first on `minor-mode-map-alist'."
  440. (let ((x (assq mode minor-mode-map-alist)))
  441. (when x
  442. (setq minor-mode-map-alist
  443. (cons x (delq mode minor-mode-map-alist))))))
  444. ;;* Macros
  445. (defmacro lispy-dotimes (n &rest bodyform)
  446. "Execute N times the BODYFORM unless an error is signaled.
  447. Return nil if couldn't execute BODYFORM at least once.
  448. Otherwise return the amount of times executed."
  449. (declare (indent 1)
  450. (debug (form body)))
  451. `(let ((i 0))
  452. (catch 'result
  453. (condition-case e
  454. (progn
  455. (while (<= (cl-incf i) ,n)
  456. ,@bodyform)
  457. ,n)
  458. (error
  459. (when (eq (car e) 'buffer-read-only)
  460. (message "Buffer is read-only: %s" (current-buffer)))
  461. (cl-decf i)
  462. (and (> i 0) i))))))
  463. (defmacro lispy-save-excursion (&rest body)
  464. "More intuitive (`save-excursion' BODY)."
  465. (declare (indent 0))
  466. `(let ((out (save-excursion
  467. ,@body)))
  468. (when (lispy-bolp)
  469. (back-to-indentation))
  470. out))
  471. (defmacro lispy-from-left (&rest body)
  472. "Ensure that BODY is executed from start of list."
  473. (let ((at-start (cl-gensym "at-start")))
  474. `(let ((,at-start (lispy--leftp)))
  475. (unless ,at-start
  476. (lispy-different))
  477. (unwind-protect
  478. (lispy-save-excursion
  479. ,@body)
  480. (unless (eq ,at-start (lispy--leftp))
  481. (lispy-different))))))
  482. (defmacro lispy-flet (binding &rest body)
  483. "Temporarily override BINDING and execute BODY."
  484. (declare (indent 1))
  485. (let* ((name (car binding))
  486. (old (cl-gensym (symbol-name name))))
  487. `(let ((,old (symbol-function ',name)))
  488. (unwind-protect
  489. (progn
  490. (fset ',name (lambda ,@(cdr binding)))
  491. ,@body)
  492. (fset ',name ,old)))))
  493. (defmacro lispy-multipop (lst n)
  494. "Remove LST's first N elements and return them."
  495. `(if (<= (length ,lst) ,n)
  496. (prog1 ,lst
  497. (setq ,lst nil))
  498. (prog1 ,lst
  499. (setcdr
  500. (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
  501. nil))))
  502. (defvar lispy-site-directory (file-name-directory
  503. load-file-name)
  504. "The directory where all of the lispy files are located.")
  505. ;;* Verb related
  506. (defun lispy-disable-verbs-except (verb)
  507. "Disable all verbs except VERB."
  508. (mapc
  509. (lambda (v) (funcall v -1))
  510. (remq verb lispy-known-verbs)))
  511. (defun lispy-quit ()
  512. "Remove modifiers."
  513. (interactive)
  514. (lispy-disable-verbs-except nil))
  515. (defmacro lispy-defverb (name grammar)
  516. "Define the verb NAME.
  517. GRAMMAR is a list of nouns that work with this verb."
  518. (let* ((sym (intern (format "lispy-%s-mode" name)))
  519. (keymap (intern (format "lispy-%s-mode-map" name)))
  520. (doc (format "%s verb.\n\n \\{lispy-%s-mode-map}"
  521. (capitalize name) name))
  522. (lighter (format " [%s]" name))
  523. (verb (intern (format "lispy-%s-verb" name)))
  524. (msg (format "[%s]: %s" name
  525. (mapconcat #'car grammar " "))))
  526. `(progn
  527. (defvar ,sym nil
  528. ,(format "Non-nil if Lispy-%s mode is enabled.
  529. Use the command `%s' to change this variable."
  530. (capitalize name)
  531. sym))
  532. (make-variable-buffer-local ',sym)
  533. (defvar ,keymap (make-sparse-keymap))
  534. (defun ,sym (&optional arg)
  535. ,doc
  536. (interactive (list (or current-prefix-arg 'toggle)))
  537. (let ((last-message (current-message)))
  538. (setq ,sym (if (eq arg 'toggle)
  539. (not ,sym)
  540. (> (prefix-numeric-value arg)
  541. 0)))
  542. (cond (,sym (lispy-disable-verbs-except ',sym))
  543. (t nil))
  544. (if (called-interactively-p 'any)
  545. (unless (and (current-message)
  546. (not (equal last-message (current-message))))
  547. (if ,sym
  548. (when lispy-verbose-verbs
  549. (message ,msg))
  550. (message "")))))
  551. (force-mode-line-update))
  552. (mapc (lambda (x)
  553. (lispy-define-key
  554. ,keymap
  555. (car x) (cadr x)
  556. :disable ',sym))
  557. ',grammar)
  558. (unless (memq ',sym lispy-known-verbs)
  559. (push ',sym lispy-known-verbs))
  560. (defun ,verb ()
  561. (interactive)
  562. (if (bound-and-true-p ,sym)
  563. (,sym -1)
  564. (,sym 1)))
  565. (with-no-warnings
  566. (add-minor-mode ',sym ,lighter ,keymap nil nil)))))
  567. ;;* Globals: navigation
  568. (defsubst lispy-right-p ()
  569. "Return t if after variable `lispy-right'."
  570. (looking-back lispy-right
  571. (line-beginning-position)))
  572. (defsubst lispy-left-p ()
  573. "Return t if before variable `lispy-left'."
  574. (looking-at lispy-left))
  575. (defun lispy-forward (arg)
  576. "Move forward list ARG times or until error.
  577. Return t if moved at least once,
  578. otherwise call function `lispy-right' and return nil."
  579. (interactive "p")
  580. (when (= arg 0)
  581. (setq arg 2000))
  582. (lispy--exit-string)
  583. (let ((bnd (lispy--bounds-comment)))
  584. (when bnd
  585. (goto-char (1+ (cdr bnd)))))
  586. (let ((pt (point))
  587. (r (lispy-dotimes arg
  588. (when (= (point) (point-max))
  589. (error "Reached end of buffer"))
  590. (forward-list))))
  591. ;; `forward-list' returns true at and of buffer
  592. (if (or (null r)
  593. (= pt (point))
  594. (and (not (lispy-right-p))
  595. (progn
  596. (backward-list)
  597. (forward-list)
  598. (= pt (point)))))
  599. (prog1 nil
  600. (lispy--out-forward 1))
  601. (point))))
  602. (defun lispy-backward (arg)
  603. "Move backward list ARG times or until error.
  604. If couldn't move backward at least once, move up backward and return nil."
  605. (interactive "p")
  606. (when (= arg 0)
  607. (setq arg 2000))
  608. (lispy--exit-string)
  609. (let ((bnd (lispy--bounds-comment)))
  610. (when bnd
  611. (goto-char (car bnd))))
  612. (let ((pt (point))
  613. (r (lispy-dotimes arg
  614. (when (= (point) (point-min))
  615. (error "Reached beginning of buffer"))
  616. (backward-list))))
  617. ;; `backward-list' returns true at beginning of buffer
  618. (if (or (null r)
  619. (= pt (point))
  620. (and (not (lispy-left-p))
  621. (progn
  622. (forward-list)
  623. (backward-list)
  624. (= pt (point)))))
  625. (prog1 nil
  626. (condition-case nil
  627. (progn
  628. (lispy--out-forward 1)
  629. (backward-list))
  630. (error
  631. (progn
  632. (goto-char pt)
  633. (up-list -1)))))
  634. (point))))
  635. (defun lispy-right (arg)
  636. "Move outside list forwards ARG times.
  637. Return nil on failure, t otherwise."
  638. (interactive "p")
  639. (lispy--remember)
  640. (when (bound-and-true-p abbrev-mode)
  641. (ignore-errors (expand-abbrev)))
  642. (cond ((region-active-p)
  643. (lispy-mark-right arg))
  644. ((looking-at lispy-outline)
  645. (lispy-outline-right))
  646. (t
  647. (lispy--out-forward arg))))
  648. (defun lispy-right-nostring (arg)
  649. "Call `lispy--out-forward' with ARG unless in string or comment.
  650. Self-insert otherwise."
  651. (interactive "p")
  652. (if (or (lispy--in-string-or-comment-p)
  653. (looking-back "?\\\\"
  654. (line-beginning-position)))
  655. (self-insert-command arg)
  656. (lispy--out-forward arg)))
  657. (defun lispy-left (arg)
  658. "Move outside list forwards ARG times.
  659. Return nil on failure, t otherwise."
  660. (interactive "p")
  661. (lispy--remember)
  662. (cond ((region-active-p)
  663. (lispy-mark-left arg))
  664. ((looking-at lispy-outline)
  665. (lispy-outline-left))
  666. (t
  667. (or (lispy--out-backward arg)
  668. (ignore-errors
  669. (up-list -1))))))
  670. (defun lispy-out-forward-newline (arg)
  671. "Call `lispy--out-forward', then ARG times `newline-and-indent'."
  672. (interactive "p")
  673. (lispy--out-forward 1)
  674. (lispy-dotimes arg
  675. (newline-and-indent)))
  676. (defvar lispy-meol-point 1
  677. "Point where `lispy-move-end-of-line' should go when already at eol.")
  678. (defun lispy-move-end-of-line ()
  679. "Forward to `move-end-of-line' unless already at end of line.
  680. Then return to the point where it was called last.
  681. If this point is inside string, move outside string."
  682. (interactive)
  683. (let ((pt (point))
  684. bnd)
  685. (if (eq pt (line-end-position))
  686. (if (setq bnd (lispy--bounds-string))
  687. (goto-char (cdr bnd))
  688. (when (and (< lispy-meol-point pt)
  689. (>= lispy-meol-point (line-beginning-position)))
  690. (goto-char lispy-meol-point)
  691. (when (setq bnd (lispy--bounds-string))
  692. (goto-char (cdr bnd)))))
  693. (setq lispy-meol-point (point))
  694. (move-end-of-line 1))))
  695. (defun lispy-move-beginning-of-line ()
  696. "Forward to `move-beginning-of-line'.
  697. Reveal outlines."
  698. (interactive)
  699. (lispy--ensure-visible)
  700. (if (bolp)
  701. (back-to-indentation)
  702. (move-beginning-of-line 1)))
  703. (defun lispy--re-search-in-code (regexp direction &optional count)
  704. "Move to the next REGEXP in DIRECTION, COUNT times.
  705. DIRECTION is either 'forward or 'backward.
  706. Return the amount of successful moves, or nil otherwise."
  707. (setq count (or count 1))
  708. (let ((to-move (abs count))
  709. (advancer
  710. (if (eq direction 'forward)
  711. (if (> count 0)
  712. #'re-search-forward
  713. #'re-search-backward)
  714. (if (> count 0)
  715. #'re-search-backward
  716. #'re-search-forward)))
  717. (pt (point)))
  718. (if (and (eq direction 'forward) (> count 0))
  719. (when (looking-at regexp)
  720. (goto-char (match-end 0))))
  721. (while (and (> to-move 0)
  722. (funcall advancer regexp nil t))
  723. (unless (lispy--in-string-or-comment-p)
  724. (cl-decf to-move)))
  725. (if (= to-move (abs count))
  726. (progn
  727. (goto-char pt)
  728. nil)
  729. (if (eq direction 'forward)
  730. (goto-char (match-beginning 0)))
  731. (- count to-move))))
  732. ;;* Locals: navigation
  733. (defun lispy-flow (arg)
  734. "Move inside list ARG times.
  735. Don't enter strings or comments.
  736. Return nil if can't move."
  737. (interactive "p")
  738. (lispy--remember)
  739. (let ((pt (point))
  740. r)
  741. (cond
  742. ((and (lispy-bolp)
  743. (looking-at ";"))
  744. (setq r (lispy--re-search-in-code lispy-left 'forward arg)))
  745. ((lispy-left-p)
  746. (setq r (lispy--re-search-in-code lispy-left 'forward arg)))
  747. ((lispy-right-p)
  748. (backward-char)
  749. (when (setq r (lispy--re-search-in-code lispy-right 'backward arg))
  750. (forward-char))))
  751. (or r
  752. (progn
  753. (goto-char pt)
  754. nil))))
  755. (defun lispy-down (arg)
  756. "Move down ARG times inside current list."
  757. (interactive "p")
  758. (lispy--remember)
  759. (cond ((region-active-p)
  760. (let ((leftp (= (point) (region-beginning))))
  761. (when leftp
  762. (exchange-point-and-mark))
  763. (cond ((save-excursion
  764. (skip-chars-forward " \n")
  765. (eobp)))
  766. ((lispy--symbolp (lispy--string-dwim))
  767. (lispy-dotimes arg
  768. (when (lispy-slurp 1)
  769. (lispy-different)
  770. (lispy-barf 1)
  771. (lispy-different))))
  772. ((looking-at "[\n ]+\\(;\\)")
  773. (deactivate-mark)
  774. (goto-char (match-beginning 1))
  775. (lispy--mark (lispy--bounds-comment)))
  776. (t
  777. (lispy-dotimes arg
  778. (forward-sexp 1)
  779. (lispy-different)
  780. (if (lispy--in-comment-p)
  781. (progn
  782. (goto-char (1+ (cdr (lispy--bounds-comment))))
  783. (skip-chars-forward "\n"))
  784. (forward-sexp 2)
  785. (forward-sexp -1))
  786. (lispy-different))))
  787. (when leftp
  788. (exchange-point-and-mark))))
  789. ((lispy-left-p)
  790. (lispy-forward arg)
  791. (let ((pt (point))
  792. (lispy-ignore-whitespace t))
  793. (if (lispy-forward 1)
  794. (lispy-backward 1)
  795. (goto-char pt)
  796. (lispy-different))))
  797. ((lispy-right-p)
  798. (let ((pt (point)))
  799. (unless (lispy-forward arg)
  800. (goto-char pt))))
  801. ((or (looking-at lispy-outline)
  802. (and (bolp) (looking-at ";")))
  803. (let ((pt (point)))
  804. (lispy-dotimes arg
  805. (outline-next-visible-heading 1)
  806. (if (looking-at lispy-outline)
  807. (setq pt (point))
  808. (goto-char pt)
  809. (error "Last outline reached")))))
  810. (t
  811. (lispy-forward 1)
  812. (lispy-backward 1)))
  813. (lispy--ensure-visible))
  814. (defun lispy-up (arg)
  815. "Move up ARG times inside current list."
  816. (interactive "p")
  817. (lispy--remember)
  818. (cond ((region-active-p)
  819. (let ((leftp (= (point) (region-beginning))))
  820. (unless leftp
  821. (exchange-point-and-mark))
  822. (cond ((save-excursion
  823. (skip-chars-backward "\n ")
  824. (bobp)))
  825. ((looking-back "^ *\\(;\\)[^\n]*[\n ]*"
  826. (save-excursion
  827. (ignore-errors
  828. (backward-sexp 1))
  829. (point)))
  830. (deactivate-mark)
  831. (goto-char (match-beginning 1))
  832. (lispy--mark (lispy--bounds-comment))
  833. (exchange-point-and-mark))
  834. ((lispy--symbolp (lispy--string-dwim))
  835. (lispy-dotimes arg
  836. (when (lispy-slurp 1)
  837. (lispy-different)
  838. (lispy-barf 1)
  839. (lispy-different))))
  840. (t
  841. (lispy-dotimes arg
  842. (backward-sexp 1)
  843. (lispy-different)
  844. (if (lispy--in-comment-p)
  845. (progn
  846. (goto-char (1- (car (lispy--bounds-comment))))
  847. (skip-chars-backward "\n"))
  848. (backward-sexp 2)
  849. (backward-sexp -1))
  850. (lispy-different))))
  851. (unless leftp
  852. (exchange-point-and-mark))))
  853. ((lispy-left-p)
  854. (let ((pt (point)))
  855. (unless (lispy-backward arg)
  856. (goto-char pt))))
  857. ((lispy-right-p)
  858. (lispy-backward arg)
  859. (let ((pt (point)))
  860. (if (lispy-backward 1)
  861. (lispy-forward 1)
  862. (goto-char pt)
  863. (lispy-different))))
  864. ((or (looking-at lispy-outline)
  865. (and (bolp) (looking-at ";")))
  866. (let ((pt (point)))
  867. (lispy-dotimes arg
  868. (outline-previous-visible-heading 1)
  869. (if (looking-at lispy-outline)
  870. (setq pt (point))
  871. (goto-char pt)
  872. (error "First outline reached")))))
  873. (t
  874. (lispy-backward 1)
  875. (lispy-forward 1)))
  876. (lispy--ensure-visible))
  877. (defvar lispy-pos-ring (make-ring 100)
  878. "Ring for point and mark position history.")
  879. (defun lispy--remember ()
  880. "Store the current point and mark in history."
  881. (let* ((emptyp (zerop (ring-length lispy-pos-ring)))
  882. (top (unless emptyp
  883. (ring-ref lispy-pos-ring 0))))
  884. (if (region-active-p)
  885. (let* ((bnd (lispy--bounds-dwim))
  886. (bnd (cons
  887. (move-marker (make-marker) (car bnd))
  888. (move-marker (make-marker) (cdr bnd)))))
  889. (when (or emptyp
  890. (not (equal bnd top)))
  891. (ring-insert lispy-pos-ring bnd)))
  892. (when (or emptyp
  893. (not (equal (point-marker) top)))
  894. (ring-insert lispy-pos-ring (point-marker))))))
  895. (defun lispy-back (arg)
  896. "Move point to ARGth previous position.
  897. If position isn't special, move to previous or error."
  898. (interactive "p")
  899. (lispy-dotimes arg
  900. (if (zerop (ring-length lispy-pos-ring))
  901. (lispy-complain "At beginning of point history")
  902. (let ((pt (ring-remove lispy-pos-ring 0)))
  903. ;; After deleting some text, markers that point to it converge
  904. ;; to one point
  905. (while (and (not (zerop (ring-length lispy-pos-ring)))
  906. (equal (ring-ref lispy-pos-ring 0)
  907. pt))
  908. (ring-remove lispy-pos-ring 0))
  909. (if (consp pt)
  910. (lispy--mark pt)
  911. (deactivate-mark)
  912. (goto-char pt))))))
  913. (defun lispy-knight-down ()
  914. "Make a knight-like move: down and right."
  915. (interactive)
  916. (cond ((lispy-right-p)
  917. (lispy-different))
  918. ((lispy-left-p))
  919. (t (lispy-backward 1)))
  920. (let ((pt (point))
  921. (bnd (save-excursion
  922. (lispy-beginning-of-defun)
  923. (lispy--bounds-list))))
  924. (catch 'done
  925. (while t
  926. (forward-line)
  927. (cond ((>= (point) (cdr bnd))
  928. (goto-char pt)
  929. (throw 'done nil))
  930. ((looking-at (concat "\\s-*" lispy-left))
  931. (goto-char (1- (match-end 0)))
  932. (throw 'done t)))))))
  933. (defun lispy-knight-up ()
  934. "Make a knight-like move: up and right."
  935. (interactive)
  936. (cond ((lispy-right-p)
  937. (lispy-different))
  938. ((lispy-left-p))
  939. (t (lispy-backward 1)))
  940. (let ((pt (point))
  941. (bnd (save-excursion
  942. (lispy-beginning-of-defun)
  943. (lispy--bounds-list))))
  944. (catch 'done
  945. (while t
  946. (beginning-of-line 0)
  947. (cond ((< (point) (car bnd))
  948. (goto-char pt)
  949. (throw 'done nil))
  950. ((looking-at (concat "\\s-*" lispy-left))
  951. (goto-char (1- (match-end 0)))
  952. (throw 'done t)))))))
  953. (defun lispy-different ()
  954. "Switch to the different side of current sexp."
  955. (interactive)
  956. (cond ((and (region-active-p)
  957. (not (= (region-beginning) (region-end))))
  958. (exchange-point-and-mark))
  959. ((lispy-right-p)
  960. (backward-list))
  961. ((lispy-left-p)
  962. (forward-list))
  963. (t
  964. (user-error "Unexpected"))))
  965. ;;* Globals: kill, yank, delete, mark, copy
  966. (defun lispy-kill ()
  967. "Kill line, keeping parens consistent."
  968. (interactive)
  969. (let (bnd)
  970. (cond ((or (lispy--in-comment-p)
  971. (and (looking-at " *;")
  972. (save-excursion
  973. (goto-char (match-end 0))
  974. (lispy--in-comment-p))))
  975. (kill-line))
  976. ((and (setq bnd (lispy--bounds-string))
  977. (or
  978. (not (eq (point) (car bnd)))
  979. (> (count-lines (car bnd) (cdr bnd)) 1)))
  980. (if (> (cdr bnd) (line-end-position))
  981. (if (eq (point) (car bnd))
  982. (kill-region (car bnd) (cdr bnd))
  983. (kill-line))
  984. (kill-region (point) (1- (cdr bnd)))))
  985. ((looking-at " *\n")
  986. (kill-region
  987. (match-beginning 0)
  988. (match-end 0))
  989. (lispy--indent-for-tab))
  990. ((and (looking-at lispy-right) (looking-back lispy-left
  991. (line-beginning-position)))
  992. (delete-char 1)
  993. (backward-delete-char 1))
  994. ((lispy-left-p)
  995. (if (progn
  996. (setq bnd (lispy--bounds-list))
  997. (> (count-lines (car bnd) (cdr bnd)) 1))
  998. (kill-region (car bnd)
  999. (cdr bnd))
  1000. (narrow-to-region (car bnd) (line-end-position))
  1001. (let ((pt (point)))
  1002. (while (and (ignore-errors
  1003. (forward-list))
  1004. (> (point) pt))
  1005. (setq pt (point)))
  1006. (when (looking-at "[\t ]*;[^\n]*$")
  1007. (setq pt (match-end 0)))
  1008. (goto-char (point-min))
  1009. (widen)
  1010. (kill-region (point) pt))))
  1011. (t
  1012. (let ((beg (point))
  1013. (end (line-end-position))
  1014. bnd)
  1015. (while (and (< (point) end)
  1016. (ignore-errors
  1017. (forward-sexp 1)
  1018. (skip-chars-forward " ")
  1019. t))
  1020. (when (setq bnd (lispy--bounds-comment))
  1021. (goto-char (cdr bnd))))
  1022. (skip-chars-forward " \t")
  1023. (kill-region beg (point)))))))
  1024. (defun lispy-kill-word (arg)
  1025. "Kill ARG words, keeping parens consistent."
  1026. (interactive "p")
  1027. (if (< arg 0)
  1028. (lispy-backward-kill-word (- arg))
  1029. (let (bnd)
  1030. (lispy-dotimes arg
  1031. (while (not (or (eobp)
  1032. (memq (char-syntax (char-after))
  1033. '(?w ?_))))
  1034. (forward-char 1))
  1035. (unless (lispy-bolp)
  1036. (delete-horizontal-space))
  1037. (if (setq bnd (lispy--bounds-string))
  1038. (save-restriction
  1039. (narrow-to-region (1+ (car bnd)) (1- (cdr bnd)))
  1040. (kill-word 1)
  1041. (widen))
  1042. (kill-word 1))))))
  1043. (defun lispy-backward-kill-word (arg)
  1044. "Kill ARG words backward, keeping parens consistent."
  1045. (interactive "p")
  1046. (let (bnd
  1047. (pt (point))
  1048. skipped)
  1049. (lispy-dotimes arg
  1050. (setq skipped (skip-chars-backward " \n"))
  1051. (if (memq (char-syntax (char-before))
  1052. '(?w ?_))
  1053. (if (lispy-looking-back "\\_<\\s_+")
  1054. (delete-region (match-beginning 0)
  1055. (match-end 0))
  1056. (backward-word 1)
  1057. (kill-region (point) pt)
  1058. (when (and (lispy--in-string-p)
  1059. (not (lispy-looking-back "\\\\\\\\"))
  1060. (lispy-looking-back "\\\\"))
  1061. (delete-char -1)))
  1062. (delete-region (point) pt)
  1063. (unless (or (zerop skipped)
  1064. (looking-at " \\|$"))
  1065. (insert " ")
  1066. (backward-char))
  1067. (while (not (or (bobp)
  1068. (memq (char-syntax (char-before))
  1069. '(?w ?_))))
  1070. (backward-char 1))
  1071. (if (setq bnd (lispy--bounds-string))
  1072. (progn
  1073. (save-restriction
  1074. (if (and (looking-at "\\s-+\"")
  1075. (eq (match-end 0) (cdr bnd)))
  1076. (goto-char (1- (cdr bnd)))
  1077. (when (and (> pt (car bnd))
  1078. (< pt (cdr bnd)))
  1079. (goto-char pt)))
  1080. (narrow-to-region (1+ (car bnd)) (point))
  1081. (kill-region (progn
  1082. (forward-word -1)
  1083. (when (and (not (lispy-looking-back "\\\\\\\\"))
  1084. (lispy-looking-back "\\\\"))
  1085. (backward-char))
  1086. (point))
  1087. (point-max))
  1088. (widen)))
  1089. (backward-kill-word 1))))))
  1090. (defun lispy-kill-sentence ()
  1091. "Kill until the end of current string or list."
  1092. (interactive)
  1093. (let ((bnd (lispy--bounds-dwim)))
  1094. (if (or (lispy-left-p) (looking-at "\""))
  1095. (kill-region (car bnd) (cdr bnd))
  1096. (setq bnd (or (lispy--bounds-string)
  1097. (lispy--bounds-list)))
  1098. (kill-region (point) (1- (cdr bnd))))))
  1099. (defun lispy-yank ()
  1100. "Like regular `yank', but quotes body when called from \"|\"."
  1101. (interactive)
  1102. (setq this-command 'yank)
  1103. (let* ((text (lispy--maybe-safe-current-kill)))
  1104. (cond
  1105. ((and (region-active-p)
  1106. (bound-and-true-p delete-selection-mode))
  1107. (lispy--maybe-safe-delete-region (region-beginning) (region-end))
  1108. (insert-for-yank text))
  1109. ((and (eq (char-after) ?\")
  1110. (eq (char-before) ?\"))
  1111. (insert-for-yank (replace-regexp-in-string "\"" "\\\\\""
  1112. text)))
  1113. (t
  1114. (push-mark (point))
  1115. (insert-for-yank text)))))
  1116. (defun lispy-buffer-kill-ring-save ()
  1117. "Save the current buffer string for writing a test."
  1118. (interactive)
  1119. (insert "|")
  1120. (kill-new (format "%S"
  1121. (buffer-substring-no-properties
  1122. (point-min) (point-max))))
  1123. (delete-char -1))
  1124. (defvar lispy-delete-sexp-from-within nil
  1125. "When cursor is adjacent to an opening or closing pair,
  1126. `lispy-delete' or `lispy-delete-backward' toward the delimiter
  1127. will kill the whole sexp (string or list).")
  1128. (define-obsolete-variable-alias
  1129. 'lispy-delete-atom-from-within
  1130. 'lispy-delete-sexp-from-within
  1131. "2018-04-15")
  1132. (defun lispy-delete (arg)
  1133. "Delete ARG sexps."
  1134. (interactive "p")
  1135. (let (bnd)
  1136. (cond ((< arg 0)
  1137. (lispy-delete-backward (- arg)))
  1138. ((region-active-p)
  1139. (lispy--maybe-safe-delete-region (region-beginning) (region-end)))
  1140. ((setq bnd (lispy--bounds-string))
  1141. (cond ((eq (1+ (point)) (cdr bnd))
  1142. (goto-char (car bnd))
  1143. (when lispy-delete-sexp-from-within
  1144. (lispy-delete arg)))
  1145. ((looking-at "\\\\\"")
  1146. (if (eq (+ (point) 2) (cdr bnd))
  1147. (goto-char (car bnd))
  1148. (delete-char 2)))
  1149. ((and (looking-at "\"")
  1150. (lispy-looking-back "\\\\"))
  1151. (backward-char 1)
  1152. (delete-char 2))
  1153. ((lispy--delete-pair-in-string "\\\\\\\\(" "\\\\\\\\)"))
  1154. ((looking-at "\\\\\\\\")
  1155. (delete-char 2))
  1156. ((and (looking-at "\\\\")
  1157. (lispy-looking-back "\\\\"))
  1158. (backward-char 1)
  1159. (delete-char 2))
  1160. ((eq (point) (car bnd))
  1161. (delete-region (car bnd)
  1162. (cdr bnd))
  1163. (let ((pt (point)))
  1164. (skip-chars-forward " ")
  1165. (delete-region pt (point))))
  1166. ((save-excursion
  1167. (forward-char 1)
  1168. (lispy--in-string-or-comment-p))
  1169. (delete-char arg))
  1170. (t
  1171. (lispy--exit-string))))
  1172. ((lispy--in-comment-p)
  1173. (if (lispy-bolp)
  1174. (let ((bnd (lispy--bounds-comment)))
  1175. (delete-region (car bnd) (cdr bnd)))
  1176. (delete-char arg)))
  1177. ((looking-at lispy-right)
  1178. (lispy-left 1)
  1179. (when lispy-delete-sexp-from-within
  1180. (lispy-delete arg)))
  1181. ((lispy-left-p)
  1182. (lispy--delete-leading-garbage)
  1183. (lispy-dotimes arg
  1184. (lispy--delete)))
  1185. ((eolp)
  1186. (delete-char 1)
  1187. (let ((pt (point)))
  1188. (skip-chars-forward " ")
  1189. (delete-region pt (point))
  1190. (unless (or (eolp)
  1191. (bolp)
  1192. (lispy-bolp)
  1193. (eq (char-before) ?\ ))
  1194. (insert " "))))
  1195. (t
  1196. (delete-char arg)))))
  1197. (defun lispy--delete-leading-garbage ()
  1198. "Delete any syntax before an opening delimiter such as '.
  1199. Delete backwards to the closest whitespace char or opening delimiter or to the
  1200. beginning of the line."
  1201. (let ((pt (point)))
  1202. (re-search-backward (concat "[[:space:]]" "\\|"
  1203. lispy-left "\\|"
  1204. "^"))
  1205. (goto-char (match-end 0))
  1206. (delete-region (point) pt)))
  1207. (defun lispy--delete-whitespace-backward ()
  1208. "Delete spaces backward."
  1209. (let ((pt (point)))
  1210. (skip-chars-backward " ")
  1211. (delete-region (point) pt)))
  1212. (defvar lispy-delete-backward-recenter -20
  1213. "When cursor is near top of screen when calling
  1214. `lispy-delete-backward', recenter cursor with arg.")
  1215. (defun lispy-delete-backward (arg)
  1216. "From \")|\", delete ARG sexps backwards.
  1217. Otherwise (`backward-delete-char-untabify' ARG)."
  1218. (interactive "p")
  1219. (let (bnd)
  1220. (cond ((< arg 0)
  1221. (lispy-delete (- arg)))
  1222. ((use-region-p)
  1223. (lispy--maybe-safe-delete-region (region-beginning)
  1224. (region-end)))
  1225. ((bobp))
  1226. ((and (setq bnd (lispy--bounds-string))
  1227. (not (eq (point) (car bnd))))
  1228. (cond ((eq (- (point) (car bnd)) 1)
  1229. (goto-char (cdr bnd))
  1230. (if lispy-delete-sexp-from-within
  1231. (lispy-delete-backward arg)))
  1232. ((or (looking-back "\\\\\\\\(" (car bnd))
  1233. (looking-back "\\\\\\\\)" (car bnd)))
  1234. (let ((pt (point)))
  1235. (goto-char (match-beginning 0))
  1236. (unless (lispy--delete-pair-in-string
  1237. "\\\\\\\\(" "\\\\\\\\)")
  1238. (goto-char pt)
  1239. (backward-delete-char-untabify arg))))
  1240. ((looking-back "[^\\]\\\\[^\\]" (car bnd))
  1241. (backward-delete-char 2))
  1242. (t
  1243. (backward-delete-char-untabify arg))))
  1244. ((looking-at lispy-outline)
  1245. (if (lispy-looking-back (concat lispy-outline ".*\n"))
  1246. (delete-region
  1247. (match-beginning 0)
  1248. (match-end 0))
  1249. (delete-char -1)))
  1250. ((lispy--in-comment-p)
  1251. (cond ((lispy-looking-back "^ +")
  1252. (delete-region (max (1- (match-beginning 0))
  1253. (point-min))
  1254. (match-end 0))
  1255. (lispy--indent-for-tab))
  1256. ((and (looking-at "$") (lispy-looking-back "; +"))
  1257. (let ((pt (point)))
  1258. (skip-chars-backward " ;")
  1259. (delete-region (point) pt)
  1260. (if (lispy-looking-back "^")
  1261. (lispy--indent-for-tab)
  1262. (let ((p (point)))
  1263. (lispy--out-forward 1)
  1264. (lispy--normalize-1)
  1265. (goto-char p)))))
  1266. (t
  1267. (backward-delete-char-untabify arg))))
  1268. ((lispy-looking-back "\\\\.")
  1269. (backward-delete-char-untabify arg))
  1270. ((and (lispy-looking-back (concat lispy-right " "))
  1271. (looking-at " *$"))
  1272. (backward-delete-char-untabify arg))
  1273. ((or (and (lispy-right-p)
  1274. (or (memq major-mode lispy-clojure-modes)
  1275. (not (lispy-looking-back "[\\?]."))))
  1276. (and (lispy-looking-back (concat lispy-right " "))
  1277. (or (lispy-left-p) (looking-at "\""))))
  1278. (let ((pt (point)))
  1279. (lispy-backward arg)
  1280. (unless (lispy-right-p)
  1281. (lispy--skip-delimiter-preceding-syntax-backward))
  1282. (skip-chars-backward " \t")
  1283. (while (plist-get (text-properties-at (point)) 'read-only)
  1284. (forward-char))
  1285. (delete-region (point) pt)
  1286. (unless (or (looking-at " ")
  1287. (lispy-bolp)
  1288. (and (lispy-right-p)
  1289. (not (or (lispy-left-p)
  1290. (looking-at "\""))))
  1291. (lispy-looking-back lispy-left)
  1292. ;; REPL prompt, e.g. `ielm'
  1293. (lispy-after-string-p "> "))
  1294. (just-one-space))
  1295. (setq pt (point))
  1296. (if (and
  1297. (not (lispy-bolp))
  1298. (not (lispy-left-p))
  1299. (progn
  1300. (skip-chars-backward " \t\n")
  1301. (lispy-right-p)))
  1302. (delete-region (point) pt)
  1303. (goto-char pt)
  1304. (lispy--indent-for-tab))))
  1305. ((and (lispy-looking-back lispy-left)
  1306. (not (lispy-looking-back "[\\?].")))
  1307. (lispy--out-forward 1)
  1308. (lispy-delete-backward 1))
  1309. ((eq (char-before) ?\")
  1310. (backward-char 1)
  1311. (let ((bnd (lispy--bounds-string)))
  1312. (delete-region (car bnd)
  1313. (cdr bnd))
  1314. (lispy--delete-whitespace-backward)
  1315. (unless (looking-at " ")
  1316. (insert " "))
  1317. (lispy--indent-for-tab)))
  1318. ((and (lispy-after-string-p "\" ")
  1319. (not (looking-at lispy-right)))
  1320. (let ((pt (point)))
  1321. (backward-char 2)
  1322. (delete-region (car (lispy--bounds-string)) pt))
  1323. (lispy--delete-whitespace-backward)
  1324. (unless (lispy-looking-back lispy-left)
  1325. (just-one-space))
  1326. (lispy--indent-for-tab))
  1327. ((lispy-bolp)
  1328. (delete-region
  1329. (line-beginning-position)
  1330. (point))
  1331. (unless (bobp)
  1332. (if (and (not (eolp))
  1333. (save-excursion
  1334. (backward-char 1)
  1335. (lispy--in-comment-p)))
  1336. (progn
  1337. (backward-char 1)
  1338. (let ((bnd (lispy--bounds-comment)))
  1339. (delete-region (car bnd) (cdr bnd)))
  1340. (delete-char 1))
  1341. (backward-delete-char 1)
  1342. (unless (or (eolp)
  1343. (looking-at lispy-right)
  1344. (lispy-looking-back lispy-left))
  1345. (just-one-space)))
  1346. (lispy--indent-for-tab)))
  1347. ((lispy-looking-back "[^ ] +")
  1348. (delete-region (+ (match-beginning 0) 2) (point)))
  1349. (t
  1350. (backward-delete-char-untabify arg))))
  1351. (when (and (buffer-file-name)
  1352. (< (- (line-number-at-pos (point))
  1353. (line-number-at-pos (window-start)))
  1354. 5)
  1355. lispy-delete-backward-recenter)
  1356. (ignore-errors
  1357. (recenter lispy-delete-backward-recenter)))
  1358. (when (and (lispy-left-p)
  1359. (not (lispy--in-string-or-comment-p)))
  1360. (indent-sexp)))
  1361. (defun lispy-mark ()
  1362. "Mark the quoted string or the list that includes the point.
  1363. Extend region when it's aleardy active."
  1364. (interactive)
  1365. (let ((bounds (or (lispy--bounds-comment)
  1366. (lispy--bounds-string)
  1367. (lispy--bounds-list))))
  1368. (when bounds
  1369. (lispy--mark bounds))))
  1370. (defun lispy-mark-list (arg)
  1371. "Mark list from special position.
  1372. When ARG is more than 1, mark ARGth element."
  1373. (interactive "p")
  1374. (when (called-interactively-p 'interactive)
  1375. (lispy--remember))
  1376. (cond ((> arg 1)
  1377. (lispy-mark-car)
  1378. (lispy-down (1- arg)))
  1379. ((= arg 0)
  1380. (let ((bnd (lispy--bounds-dwim)))
  1381. (lispy--mark
  1382. (cons (+ (car bnd) (if (eq (char-after (car bnd)) ?\#) 2 1))
  1383. (1- (cdr bnd))))))
  1384. ((region-active-p)
  1385. (deactivate-mark)
  1386. (if (lispy--in-comment-p)
  1387. (progn
  1388. (beginning-of-line)
  1389. (skip-chars-forward " "))
  1390. (skip-chars-forward ",@'`")))
  1391. ((lispy-left-p)
  1392. (lispy--mark
  1393. (lispy--bounds-dwim)))
  1394. ((lispy-right-p)
  1395. (lispy--mark
  1396. (lispy--bounds-dwim))
  1397. (lispy-different))
  1398. ((and (lispy-bolp) (looking-at ";"))
  1399. (lispy--mark (lispy--bounds-comment))))
  1400. (setq this-command 'lispy-mark-list))
  1401. (defvar-local lispy-bind-var-in-progress nil
  1402. "When t, `lispy-mark-symbol' will exit `iedit'.")
  1403. (defun lispy-mark-symbol ()
  1404. "Mark current symbol."
  1405. (interactive)
  1406. (let (bnd)
  1407. (cond (lispy-bind-var-in-progress
  1408. (lispy-map-done)
  1409. (setq lispy-bind-var-in-progress nil)
  1410. (forward-sexp 2)
  1411. (lispy-mark-symbol))
  1412. ((lispy--in-comment-p)
  1413. (if (and (looking-at "\\(?:\\w\\|\\s_\\)*'")
  1414. (setq bnd (match-end 0))
  1415. (looking-back "`\\(?:\\w\\|\\s_\\)*"
  1416. (line-beginning-position)))
  1417. (progn
  1418. (goto-char (match-beginning 0))
  1419. (set-mark (point))
  1420. (goto-char bnd))
  1421. (lispy--mark (lispy--bounds-comment))))
  1422. ((and
  1423. (not (region-active-p))
  1424. (setq bnd (lispy--bounds-string))
  1425. (= (1+ (point))
  1426. (cdr bnd)))
  1427. (lispy--mark bnd))
  1428. ((and (lispy-after-string-p "\"")
  1429. (not (lispy--in-string-or-comment-p)))
  1430. (set-mark-command nil)
  1431. (forward-sexp -1)
  1432. (exchange-point-and-mark))
  1433. ((looking-at " *[[({]")
  1434. (if (and (lispy-looking-back "\\sw\\|\\s_")
  1435. (not (region-active-p)))
  1436. (progn
  1437. (set-mark-command nil)
  1438. (forward-sexp -1)
  1439. (exchange-point-and-mark))
  1440. (let ((pt (point)))
  1441. (skip-chars-forward "(){}[] \"\n")
  1442. (set-mark-command nil)
  1443. (if (looking-at "\\sw\\|\\s_")
  1444. (forward-sexp)
  1445. (condition-case nil
  1446. (progn
  1447. (re-search-forward "[][(){} \n]")
  1448. (while (lispy--in-string-or-comment-p)
  1449. (re-search-forward "[() \n]"))
  1450. (backward-char 1))
  1451. (error
  1452. (message "No further symbols found")
  1453. (deactivate-mark)
  1454. (goto-char pt)))))))
  1455. ((region-active-p)
  1456. (let ((bnd (lispy--bounds-string)))
  1457. (condition-case nil
  1458. (progn
  1459. (forward-sexp)
  1460. (when (and bnd (> (point) (cdr bnd)))
  1461. (goto-char (cdr bnd))
  1462. (error "`forward-sexp' went through string bounds")))
  1463. (error
  1464. (deactivate-mark)
  1465. (re-search-forward "\\sw\\|\\s_")
  1466. (forward-char -1)
  1467. (set-mark-command nil)
  1468. (forward-sexp)))))
  1469. ((lispy-right-p)
  1470. (skip-chars-backward "}]) \n")
  1471. (set-mark-command nil)
  1472. (re-search-backward "[][{}() \n]")
  1473. (while (lispy--in-string-or-comment-p)
  1474. (re-search-backward "[() \n]"))
  1475. (forward-char 1))
  1476. ((looking-at lispy-right)
  1477. (lispy--mark
  1478. (save-excursion
  1479. (backward-char 1)
  1480. (lispy--bounds-dwim))))
  1481. (t
  1482. (lispy--mark (lispy--bounds-dwim))))))
  1483. (defun lispy-kill-at-point ()
  1484. "Kill the quoted string or the list that includes the point."
  1485. (interactive)
  1486. (if (region-active-p)
  1487. (lispy--maybe-safe-kill-region (region-beginning)
  1488. (region-end))
  1489. (let ((bounds (or (lispy--bounds-comment)
  1490. (lispy--bounds-string)
  1491. (lispy--bounds-list))))
  1492. (if buffer-read-only
  1493. (kill-new (buffer-substring
  1494. (car bounds) (cdr bounds)))
  1495. (kill-region (car bounds) (cdr bounds))))))
  1496. (defun lispy-new-copy ()
  1497. "Copy marked region or sexp to kill ring."
  1498. (interactive)
  1499. (let ((str (if (region-active-p)
  1500. (lispy--maybe-safe-region (region-beginning)
  1501. (region-end))
  1502. (lispy--string-dwim))))
  1503. (unless (equal str (ignore-errors
  1504. (current-kill 0)))
  1505. (kill-new str))))
  1506. ;;* Globals: pairs
  1507. (defvar lispy-parens-only-left-in-string-or-comment t
  1508. "Whether \"(\" should insert only the left paren in strings and comments.")
  1509. (defun lispy-pair (left right preceding-syntax-alist)
  1510. "Return (lambda (arg)(interactive \"P\")...) using LEFT RIGHT.
  1511. PRECEDING-SYNTAX-ALIST should be an alist of `major-mode' to a list of regexps.
  1512. The regexps correspond to valid syntax that can precede LEFT in each major mode.
  1513. When this function is called:
  1514. - with region active:
  1515. Wrap region with LEFT RIGHT.
  1516. - with region active and arg 1:
  1517. Wrap region with LEFT RIGHT and put the point after LEFT followed by a space.
  1518. - with arg nil:
  1519. Insert LEFT RIGHT.
  1520. - with arg negative:
  1521. Wrap as many sexps as possible until the end of the line with LEFT RIGHT.
  1522. - with arg 0:
  1523. Wrap as many sexps as possible with LEFT RIGHT.
  1524. - with the universal arg:
  1525. Wrap one sexp with LEFT RIGHT.
  1526. - with arg positive:
  1527. Wrap that number of sexps with LEFT RIGHT or as many as possible."
  1528. `(lambda (arg)
  1529. (interactive "P")
  1530. (cond ((not arg))
  1531. ((listp arg)
  1532. (setq arg 1))
  1533. (t
  1534. (setq arg (prefix-numeric-value arg))))
  1535. (cond ((region-active-p)
  1536. (lispy--surround-region ,left ,right)
  1537. (when (and (lispy-looking-back lispy-left)
  1538. (or (lispy-left-p)
  1539. (> (or arg 0) 0)))
  1540. (insert " "))
  1541. (backward-char 1))
  1542. ((and (lispy--in-string-p)
  1543. (lispy-looking-back "\\\\\\\\"))
  1544. (insert ,left "\\\\" ,right)
  1545. (backward-char 3))
  1546. ((lispy--in-string-or-comment-p)
  1547. (if (and lispy-parens-only-left-in-string-or-comment
  1548. (string= ,left "(")
  1549. (= ?\( (aref (this-command-keys-vector) 0)))
  1550. (insert "(")
  1551. (insert ,left ,right)
  1552. (backward-char 1)))
  1553. ((lispy-after-string-p "?\\")
  1554. (insert ,left))
  1555. ((not arg)
  1556. (lispy--indent-for-tab)
  1557. (lispy--delimiter-space-unless ,preceding-syntax-alist)
  1558. (insert ,left ,right)
  1559. (unless (or (eolp)
  1560. (lispy--in-string-p)
  1561. (looking-at "\n\\|)\\|}\\|\\]"))
  1562. (just-one-space)
  1563. (backward-char 1))
  1564. (when (looking-at ,(regexp-quote left))
  1565. (insert " ")
  1566. (backward-char))
  1567. (backward-char))
  1568. (t
  1569. ;; don't jump backwards or out of a list when not at a sexp
  1570. (unless (lispy--not-at-sexp-p ,preceding-syntax-alist)
  1571. (when (lispy--bounds-dwim)
  1572. (goto-char (car (lispy--bounds-dwim)))))
  1573. (lispy--indent-for-tab)
  1574. (insert ,left ,right)
  1575. (save-excursion
  1576. (lispy-slurp arg))
  1577. (when (or (looking-at lispy-right)
  1578. (and (eolp)
  1579. (looking-back lispy-right (1- (point)))))
  1580. ;; failed to wrap anything
  1581. (backward-char))
  1582. (when (and lispy-insert-space-after-wrap
  1583. (not (lispy--in-empty-list-p ,preceding-syntax-alist))
  1584. (not (eolp)))
  1585. (just-one-space)
  1586. (backward-char))))))
  1587. (defvar lispy-parens-preceding-syntax-alist
  1588. '((lisp-mode . ("[#`',.@]+" "#[0-9]*" "#[.,Ss+-]" "#[0-9]+[=Aa]"))
  1589. (emacs-lisp-mode . ("[#`',@]+" "#s" "#[0-9]+="))
  1590. (clojure-mode . ("[`'~@]+" "#" "#\\?@?"))
  1591. (clojurescript-mode . ("[`'~@]+" "#" "#\\?@?"))
  1592. (clojurec-mode . ("[`'~@]+" "#" "#\\?@?"))
  1593. (cider-repl-mode . ("[`'~@]+" "#" "#\\?@?"))
  1594. (cider-clojure-interaction-mode . ("[`'~@]+" "#" "#\\?@?"))
  1595. (scheme-mode . ("[#`',@]+" "#hash"))
  1596. (t . ("[`',@]+")))
  1597. "An alist of `major-mode' to a list of regexps.
  1598. Each regexp describes valid syntax that can precede an opening paren in that
  1599. major mode. These regexps are used to determine whether to insert a space for
  1600. `lispy-parens'.")
  1601. (defvar lispy-brackets-preceding-syntax-alist
  1602. '((clojure-mode . ("[`']" "#[A-z.]*"))
  1603. (clojurescript-mode . ("[`']" "#[A-z.]*"))
  1604. (clojurec-mode . ("[`']" "#[A-z.]*"))
  1605. (cider-repl-mode . ("[`']" "#[A-z.]*"))
  1606. (cider-clojure-interaction-mode . ("[`']" "#[A-z.]*"))
  1607. (scheme-mode . ("[#`',@]+" "#hash"))
  1608. (t . nil))
  1609. "An alist of `major-mode' to a list of regexps.
  1610. Each regexp describes valid syntax that can precede an opening bracket in that
  1611. major mode. These regexps are used to determine whether to insert a space for
  1612. `lispy-brackets'.")
  1613. (defvar lispy-braces-preceding-syntax-alist
  1614. '((clojure-mode . ("[`'^]" "#[:]*[A-z.:]*"))
  1615. (clojurescript-mode . ("[`'^]" "#[:]*[A-z.:]*"))
  1616. (clojurec-mode . ("[`'^]" "#[:]*[A-z.:]*"))
  1617. (cider-repl-mode . ("[`'^]" "#[:]*[A-z.:]*"))
  1618. (cider-clojure-interaction-mode . ("[`'^]" "#[:]*[A-z.:]*"))
  1619. (t . nil))
  1620. "An alist of `major-mode' to a list of regexps.
  1621. Each regexp describes valid syntax that can precede an opening brace in that
  1622. major mode. These regexps are used to determine whether to insert a space for
  1623. `lispy-braces'.")
  1624. (defalias 'lispy-parens
  1625. (lispy-pair "(" ")" 'lispy-parens-preceding-syntax-alist)
  1626. "`lispy-pair' with ().")
  1627. (defalias 'lispy-brackets
  1628. (lispy-pair "[" "]" 'lispy-brackets-preceding-syntax-alist)
  1629. "`lispy-pair' with [].")
  1630. (defalias 'lispy-braces
  1631. (lispy-pair "{" "}" 'lispy-braces-preceding-syntax-alist)
  1632. "`lispy-pair' with {}.")
  1633. (defun lispy-quotes (arg)
  1634. "Insert a pair of quotes around the point.
  1635. When the region is active, wrap it in quotes instead.
  1636. When inside string, if ARG is nil quotes are quoted,
  1637. otherwise the whole string is unquoted."
  1638. (interactive "P")
  1639. (let (bnd)
  1640. (cond ((region-active-p)
  1641. (if arg
  1642. (lispy-unstringify)
  1643. (lispy-stringify)))
  1644. ((and (setq bnd (lispy--bounds-string))
  1645. (not (= (point) (car bnd))))
  1646. (if arg
  1647. (lispy-unstringify)
  1648. (if (and lispy-close-quotes-at-end-p (looking-at "\""))
  1649. (forward-char 1)
  1650. (progn (insert "\\\"\\\""))
  1651. (backward-char 2))))
  1652. (arg
  1653. (lispy-stringify))
  1654. ((lispy-after-string-p "?\\")
  1655. (self-insert-command 1))
  1656. (t
  1657. (lispy--space-unless "^\\|\\s-\\|\\s(\\|[#]")
  1658. (insert "\"\"")
  1659. (unless (looking-at "\n\\|)\\|}\\|\\]\\|$")
  1660. (just-one-space)
  1661. (backward-char 1))
  1662. (backward-char)))))
  1663. (defun lispy-parens-down ()
  1664. "Exit the current sexp, and start a new sexp below."
  1665. (interactive)
  1666. (condition-case nil
  1667. (progn
  1668. (lispy--out-forward 1)
  1669. (if (looking-at "\n *\\()\\)")
  1670. (progn
  1671. (goto-char (match-beginning 1))
  1672. (insert "()")
  1673. (lispy--indent-for-tab)
  1674. (backward-char))
  1675. (insert "\n()")
  1676. (lispy--indent-for-tab)
  1677. (backward-char)))
  1678. (error (indent-new-comment-line))))
  1679. ;;* Globals: insertion
  1680. (defun lispy-space (arg)
  1681. "Insert one space, with position depending on ARG.
  1682. If ARG is 2, amend the current list with a space from current side.
  1683. If ARG is 3, switch to the different side beforehand.
  1684. If jammed between parens, \"(|(\" unjam: \"(| (\". If after an opening delimiter
  1685. and before a space (after wrapping a sexp, for example), do the opposite and
  1686. delete the extra space, \"(| foo)\" to \"(|foo)\"."
  1687. (interactive "p")
  1688. (cond ((bound-and-true-p edebug-active)
  1689. (edebug-step-mode))
  1690. ((region-active-p)
  1691. (goto-char (region-end))
  1692. (deactivate-mark)
  1693. (insert " "))
  1694. ((lispy--in-string-or-comment-p)
  1695. (call-interactively 'self-insert-command))
  1696. ((eq arg 4)
  1697. (when (lispy--leftp)
  1698. (lispy-different))
  1699. (backward-char)
  1700. (unless (lispy-bolp)
  1701. (newline-and-indent)))
  1702. ((or (eq arg 2)
  1703. (when (eq arg 3)
  1704. (lispy-different)
  1705. t))
  1706. (if (lispy-left-p)
  1707. (progn
  1708. (forward-char)
  1709. (just-one-space)
  1710. (backward-char))
  1711. (backward-char)
  1712. (just-one-space)))
  1713. ((and (lispy-looking-back lispy-left)
  1714. (not (eq ?\\ (char-before (match-beginning 0)))))
  1715. (if (looking-at "[[:space:]]")
  1716. (delete-region (point)
  1717. (progn
  1718. (skip-chars-forward "[:space:]")
  1719. (point)))
  1720. (call-interactively 'self-insert-command)
  1721. (backward-char)))
  1722. (t
  1723. (call-interactively 'self-insert-command)
  1724. (when (and (lispy-left-p)
  1725. (lispy-looking-back "[[({] "))
  1726. (backward-char)))))
  1727. (defvar lispy-colon-p t
  1728. "If true (the default), then add a space before inserting a
  1729. colon following `lispy-colon-no-space-regex'. To disable this
  1730. behavior, set this variable to nil.")
  1731. (defvar lispy-colon-no-space-regex
  1732. '((lisp-mode . "\\s-\\|[:^?#]\\|ql\\|\\(?:\\s([[:word:]-]*\\)"))
  1733. "Overrides REGEX that `lispy-colon' will consider for `major-mode'.
  1734. `lispy-colon' will insert \" :\" instead of \":\" unless
  1735. `lispy-no-space' is t or `looking-back' REGEX.")
  1736. (defun lispy-colon ()
  1737. "Insert :."
  1738. (interactive)
  1739. (when lispy-colon-p
  1740. (lispy--space-unless
  1741. (or (cdr (assoc major-mode lispy-colon-no-space-regex))
  1742. "\\s-\\|\\s(\\|[#:^?]")))
  1743. (insert ":"))
  1744. (defun lispy-hat ()
  1745. "Insert ^."
  1746. (interactive)
  1747. (lispy--space-unless "\\s-\\|\\s(\\|[:?]\\|\\\\")
  1748. (insert "^"))
  1749. (defun lispy-at ()
  1750. (interactive)
  1751. (lispy--space-unless "\\s-\\|\\s(\\|[:?]\\|\\\\\\|~\\|,")
  1752. (insert "@"))
  1753. (defun lispy-tick (arg)
  1754. "Insert ' ARG times.
  1755. When the region is active and marks a string, unquote it.
  1756. Otherwise, when the region is active, toggle ' at the start of the region."
  1757. (interactive "p")
  1758. (cond ((lispy--string-markedp)
  1759. (lispy-unstringify))
  1760. ((region-active-p)
  1761. (lispy-toggle-char ?\'))
  1762. (t
  1763. (lispy--space-unless "\\s-\\|\\s(\\|[~#:?'`]\\|\\\\")
  1764. (self-insert-command arg))))
  1765. (defun lispy-underscore (&optional arg)
  1766. "Insert _ ARG times.
  1767. For Clojure modes, toggle #_ sexp comment."
  1768. (interactive "p")
  1769. (setq arg (or arg 1))
  1770. (if (memq major-mode lispy-clojure-modes)
  1771. (let ((leftp (lispy--leftp)))
  1772. (unless leftp
  1773. (lispy-different))
  1774. (if (lispy-after-string-p "#_")
  1775. (delete-char -2)
  1776. (insert "#_"))
  1777. (unless leftp
  1778. (lispy-different)))
  1779. (self-insert-command arg)))
  1780. (defun lispy-backtick ()
  1781. "Insert `."
  1782. (interactive)
  1783. (if (region-active-p)
  1784. (lispy--surround-region "`" "'")
  1785. (lispy--space-unless "\\s-\\|\\s(\\|[:?`']\\|\\\\")
  1786. (insert "`")))
  1787. (defun lispy-tilde (arg)
  1788. "Insert ~ ARG times.
  1789. When the region is active, toggle a ~ at the start of the region."
  1790. (interactive "p")
  1791. (if (region-active-p)
  1792. (lispy-toggle-char ?~)
  1793. (self-insert-command arg)))
  1794. (defun lispy-toggle-char (char)
  1795. "Toggle CHAR at the start of the region."
  1796. (let ((bnd (lispy--bounds-dwim))
  1797. deactivate-mark)
  1798. (save-excursion
  1799. (goto-char (car bnd))
  1800. (if (eq (char-after) char)
  1801. (delete-char 1)
  1802. (insert char)))))
  1803. (defun lispy-hash ()
  1804. "Insert #."
  1805. (interactive)
  1806. (if (and (or (memq major-mode lispy-clojure-modes)
  1807. (memq major-mode '(nrepl-repl-mode
  1808. cider-clojure-interaction-mode)))
  1809. (lispy-looking-back "\\sw #"))
  1810. (progn
  1811. (backward-delete-char 2)
  1812. (insert "#"))
  1813. (lispy--space-unless "\\s-\\|\\s(\\|[#:?'`,]\\\\?")
  1814. (insert "#")))
  1815. (declare-function cider-eval-print-last-sexp "ext:cider-eval")
  1816. (declare-function cider-repl-newline-and-indent "ext:cider-repl")
  1817. (declare-function ielm-return "ielm")
  1818. (declare-function mode-local-bind "mode-local")
  1819. (defun lispy-newline-and-indent ()
  1820. "Insert newline."
  1821. (interactive)
  1822. (cond ((eq major-mode 'lisp-interaction-mode)
  1823. (setq this-command 'eval-last-sexp)
  1824. (eval-print-last-sexp))
  1825. ((eq major-mode 'cider-clojure-interaction-mode)
  1826. (setq this-command 'cider-eval-print-last-sexp)
  1827. (cider-eval-print-last-sexp))
  1828. ((eq major-mode 'cider-repl-mode)
  1829. (setq this-command 'cider-repl-newline-and-indent)
  1830. (cider-repl-newline-and-indent))
  1831. ((eq major-mode 'inferior-emacs-lisp-mode)
  1832. (lispy-newline-and-indent-plain))
  1833. ((lispy-left-p)
  1834. (skip-chars-backward ",@'`#")
  1835. (newline-and-indent)
  1836. (skip-chars-forward ",@'`#")
  1837. (indent-sexp))
  1838. (t
  1839. (lispy-newline-and-indent-plain))))
  1840. (declare-function cider-repl-return "ext:cider-repl")
  1841. (declare-function slime-repl-return "ext:slime-repl")
  1842. (declare-function sly-mrepl-return "ext:sly-mrepl")
  1843. (defun lispy-newline-and-indent-plain ()
  1844. "When in minibuffer, exit it. Otherwise forward to `newline-and-indent'."
  1845. (interactive)
  1846. (if (minibufferp)
  1847. (exit-minibuffer)
  1848. (cl-case major-mode
  1849. (cider-repl-mode
  1850. (cider-repl-return))
  1851. (slime-repl-mode
  1852. (slime-repl-return))
  1853. (sly-mrepl-mode
  1854. (sly-mrepl-return))
  1855. (comint-mode
  1856. (comint-send-input))
  1857. (python-mode
  1858. (newline-and-indent))
  1859. (inferior-emacs-lisp-mode
  1860. (setq this-command 'ielm-return)
  1861. (ielm-return))
  1862. (t
  1863. (if (and (not (lispy--in-string-or-comment-p))
  1864. (if (memq major-mode lispy-clojure-modes)
  1865. (lispy-looking-back "[^#`'@~][#`'@~]+")
  1866. (lispy-looking-back "[^#`',@|][#`',@]+")))
  1867. (save-excursion
  1868. (goto-char (match-beginning 0))
  1869. (newline-and-indent))
  1870. (newline-and-indent))
  1871. (let ((lispy-ignore-whitespace t))
  1872. (save-excursion
  1873. (lispy--out-backward 1)
  1874. (unless (< 50000
  1875. (- (save-excursion (forward-list 1))
  1876. (point)))
  1877. (indent-sexp))))))))
  1878. (defun lispy-open-line (arg)
  1879. "Add ARG lines after the current expression.
  1880. When ARG is nagative, add them above instead"
  1881. (interactive "p")
  1882. (save-excursion
  1883. (cond ((lispy-left-p)
  1884. (forward-list))
  1885. ((lispy-right-p))
  1886. (t
  1887. (lispy--out-forward 1)))
  1888. (if (> arg 0)
  1889. (newline arg)
  1890. (forward-list -1)
  1891. (newline (- arg))
  1892. (lispy--indent-for-tab))))
  1893. (defun lispy-meta-return ()
  1894. "Insert a new heading."
  1895. (interactive)
  1896. (let ((pt (point)))
  1897. (cond ((lispy--in-comment-p)
  1898. (end-of-line)
  1899. (newline))
  1900. ((and (lispy-bolp)
  1901. (looking-at " *$"))
  1902. (delete-region
  1903. (line-beginning-position)
  1904. (line-end-position)))
  1905. (t
  1906. (lispy-beginning-of-defun)
  1907. (if (save-excursion
  1908. (forward-list 1)
  1909. (= (point) pt))
  1910. (progn
  1911. (forward-list 1)
  1912. (newline))
  1913. (newline)
  1914. (backward-char 1)))))
  1915. (insert lispy-outline-header
  1916. (make-string (max (lispy-outline-level) 1)
  1917. ?\*)
  1918. " ")
  1919. (beginning-of-line))
  1920. (defun lispy-alt-line (&optional N)
  1921. "Do a context-aware exit, then `newline-and-indent', N times.
  1922. Exit branches:
  1923. - When in the minibuffer, exit the minibuffer.
  1924. - When in a string, exit the string.
  1925. - When \")|\", do nothing.
  1926. - When \" |)\", exit the list and normalize it.
  1927. - When \"|(\", move to the other side of the list.
  1928. - When there's a \")\" on the current line before the point, move there.
  1929. - Otherwise, move to the end of the line.
  1930. This should generally be useful when generating new code.
  1931. If you find yourself with:
  1932. (foo (bar (baz 1 2 \"3|\")))
  1933. calling this function consecutively, you will get a chance to add arguments
  1934. to all the functions, while maintaining the parens in a pretty state."
  1935. (interactive "p")
  1936. (setq N (or N 1))
  1937. (when (bound-and-true-p abbrev-mode)
  1938. (expand-abbrev))
  1939. (let (bnd)
  1940. (lispy-dotimes N
  1941. (cond ((> (minibuffer-depth) 0)
  1942. (exit-minibuffer))
  1943. ((when (setq bnd (lispy--bounds-string))
  1944. (if (> (cdr bnd) (line-end-position))
  1945. (goto-char (cdr bnd))
  1946. (goto-char (cdr bnd))
  1947. nil)))
  1948. ((lispy-right-p))
  1949. ((looking-at lispy-right)
  1950. (when (or (eq (char-before) ?\ )
  1951. (bolp))
  1952. (lispy-right 1)))
  1953. ((lispy-left-p)
  1954. (lispy-different))
  1955. ((lispy-looking-back "^ +")
  1956. (if (re-search-forward lispy-right (line-end-position) t)
  1957. (backward-char 1)
  1958. (move-end-of-line 1)))
  1959. ((lispy--in-comment-p))
  1960. (t
  1961. (when bnd
  1962. (goto-char (cdr bnd)))
  1963. (let ((end (min (line-end-position)
  1964. (cdr (lispy--bounds-list)))))
  1965. (while (< (point) (1- end))
  1966. (forward-sexp)))))
  1967. (newline-and-indent))))
  1968. ;;* Globals: miscellanea
  1969. (defun lispy-string-oneline ()
  1970. "Convert current string to one line."
  1971. (interactive)
  1972. (when (eq (char-before) ?\")
  1973. (backward-char 1))
  1974. (let (bnd str)
  1975. (setq str (lispy--string-dwim (setq bnd (lispy--bounds-string))))
  1976. (delete-region (car bnd) (cdr bnd))
  1977. (insert (replace-regexp-in-string "\n" "\\\\n" str))))
  1978. (defun lispy-iedit (&optional arg)
  1979. "Wrap around `iedit'."
  1980. (interactive "P")
  1981. (require 'iedit)
  1982. (if iedit-mode
  1983. (iedit-mode nil)
  1984. (when (lispy-left-p)
  1985. (forward-char 1))
  1986. (if arg
  1987. (iedit-mode 0)
  1988. (iedit-mode))))
  1989. ;;* Locals: navigation
  1990. ;;** Occur
  1991. (defcustom lispy-occur-backend 'ivy
  1992. "Method to navigate to a line with `lispy-occur'."
  1993. :type '(choice
  1994. (const :tag "Ivy" ivy)
  1995. (const :tag "Helm" helm)))
  1996. (defvar lispy--occur-beg 1
  1997. "Start position of the top level sexp during `lispy-occur'.")
  1998. (defvar lispy--occur-end 1
  1999. "End position of the top level sexp during `lispy-occur'.")
  2000. (defun lispy--occur-candidates (&optional bnd)
  2001. "Return the candidates for `lispy-occur'."
  2002. (setq bnd (or bnd (save-excursion
  2003. (unless (and (bolp)
  2004. (lispy-left-p))
  2005. (beginning-of-defun))
  2006. (lispy--bounds-dwim))))
  2007. (let ((line-number -1)
  2008. candidates)
  2009. (setq lispy--occur-beg (car bnd))
  2010. (setq lispy--occur-end (cdr bnd))
  2011. (save-excursion
  2012. (goto-char lispy--occur-beg)
  2013. (while (< (point) lispy--occur-end)
  2014. (push (format "%-3d %s"
  2015. (cl-incf line-number)
  2016. (buffer-substring
  2017. (line-beginning-position)
  2018. (line-end-position)))
  2019. candidates)
  2020. (forward-line 1)))
  2021. (nreverse candidates)))
  2022. (defun lispy--occur-preselect ()
  2023. "Initial candidate regex for `lispy-occur'."
  2024. (format "^%d"
  2025. (-
  2026. (line-number-at-pos (point))
  2027. (line-number-at-pos lispy--occur-beg))))
  2028. (defvar helm-input)
  2029. (declare-function helm "ext:helm")
  2030. (defun lispy-occur-action-goto-paren (x)
  2031. "Goto line X for `lispy-occur'."
  2032. (setq x (read x))
  2033. (goto-char lispy--occur-beg)
  2034. (let ((input (if (eq lispy-occur-backend 'helm)
  2035. helm-input
  2036. ivy-text))
  2037. str-or-comment)
  2038. (cond ((string= input "")
  2039. (forward-line x)
  2040. (back-to-indentation)
  2041. (when (re-search-forward lispy-left (line-end-position) t)
  2042. (goto-char (match-beginning 0))))
  2043. ((setq str-or-comment
  2044. (progn
  2045. (forward-line x)
  2046. (re-search-forward (ivy--regex input)
  2047. (line-end-position) t)
  2048. (lispy--in-string-or-comment-p)))
  2049. (goto-char str-or-comment))
  2050. ((re-search-backward lispy-left (line-beginning-position) t)
  2051. (goto-char (match-beginning 0)))
  2052. ((re-search-forward lispy-left (line-end-position) t)
  2053. (goto-char (match-beginning 0)))
  2054. (t
  2055. (back-to-indentation)))))
  2056. (defun lispy-occur-action-goto-end (x)
  2057. "Goto line X for `lispy-occur'."
  2058. (setq x (read x))
  2059. (goto-char lispy--occur-beg)
  2060. (forward-line x)
  2061. (re-search-forward (ivy--regex ivy-text) (line-end-position) t))
  2062. (defun lispy-occur-action-goto-beg (x)
  2063. "Goto line X for `lispy-occur'."
  2064. (when (lispy-occur-action-goto-end x)
  2065. (goto-char (match-beginning 0))))
  2066. (defun lispy-occur-action-mc (_x)
  2067. "Make a fake cursor for each `lispy-occur' candidate."
  2068. (let ((cands (nreverse ivy--old-cands))
  2069. cand)
  2070. (while (setq cand (pop cands))
  2071. (goto-char lispy--occur-beg)
  2072. (forward-line (read cand))
  2073. (re-search-forward (ivy--regex ivy-text) (line-end-position) t)
  2074. (when cands
  2075. (mc/create-fake-cursor-at-point))))
  2076. (multiple-cursors-mode 1))
  2077. (ivy-set-actions
  2078. 'lispy-occur
  2079. '(("m" lispy-occur-action-mc "multiple-cursors")
  2080. ("j" lispy-occur-action-goto-beg "goto start")
  2081. ("k" lispy-occur-action-goto-end "goto end")))
  2082. (defvar ivy-last)
  2083. (declare-function ivy-state-window "ext:ivy")
  2084. (defun lispy-occur ()
  2085. "Select a line within current top level sexp.
  2086. See `lispy-occur-backend' for the selection back end."
  2087. (interactive)
  2088. (swiper--init)
  2089. (cond ((eq lispy-occur-backend 'helm)
  2090. (require 'helm)
  2091. (add-hook 'helm-move-selection-after-hook
  2092. #'lispy--occur-update-input-helm)
  2093. (add-hook 'helm-update-hook
  2094. #'lispy--occur-update-input-helm)
  2095. (unwind-protect
  2096. (helm :sources
  2097. `((name . "this defun")
  2098. (candidates . ,(lispy--occur-candidates))
  2099. (action . lispy-occur-action-goto-paren)
  2100. (match-strict .
  2101. (lambda (x)
  2102. (ignore-errors
  2103. (string-match
  2104. (ivy--regex helm-input) x)))))
  2105. :preselect (lispy--occur-preselect)
  2106. :buffer "*lispy-occur*")
  2107. (swiper--cleanup)
  2108. (remove-hook 'helm-move-selection-after-hook
  2109. #'lispy--occur-update-input-helm)
  2110. (remove-hook 'helm-update-hook
  2111. #'lispy--occur-update-input-helm)))
  2112. ((eq lispy-occur-backend 'ivy)
  2113. (unwind-protect
  2114. (ivy-read "pattern: "
  2115. (lispy--occur-candidates)
  2116. :preselect (lispy--occur-preselect)
  2117. :require-match t
  2118. :update-fn (lambda ()
  2119. (lispy--occur-update-input
  2120. ivy-text
  2121. (ivy-state-current ivy-last)))
  2122. :action #'lispy-occur-action-goto-paren
  2123. :caller 'lispy-occur)
  2124. (swiper--cleanup)
  2125. (when (null ivy-exit)
  2126. (goto-char swiper--opoint))))
  2127. (t
  2128. (error "Bad `lispy-occur-backend': %S" lispy-occur-backend))))
  2129. (defun lispy--occur-update-input-helm ()
  2130. "Update selection for `lispy-occur' using `helm' back end."
  2131. (lispy--occur-update-input
  2132. helm-input
  2133. (buffer-substring-no-properties
  2134. (line-beginning-position)
  2135. (line-end-position))))
  2136. (defun lispy--occur-update-input (input str)
  2137. "Update selection for `ivy-occur'.
  2138. INPUT is the current input text.
  2139. STR is the full current candidate."
  2140. (swiper--cleanup)
  2141. (let ((re (ivy--regex input))
  2142. (num (if (string-match "^[0-9]+" str)
  2143. (string-to-number (match-string 0 str))
  2144. 0)))
  2145. (with-selected-window (ivy-state-window ivy-last)
  2146. (goto-char lispy--occur-beg)
  2147. (when (cl-plusp num)
  2148. (forward-line num)
  2149. (unless (<= (point) lispy--occur-end)
  2150. (recenter)))
  2151. (let ((ov (make-overlay (line-beginning-position)
  2152. (1+ (line-end-position)))))
  2153. (overlay-put ov 'face 'swiper-line-face)
  2154. (overlay-put ov 'window (ivy-state-window ivy-last))
  2155. (push ov swiper--overlays))
  2156. (re-search-forward re (line-end-position) t)
  2157. (swiper--add-overlays
  2158. re
  2159. lispy--occur-beg
  2160. lispy--occur-end))))
  2161. ;;* Locals: Paredit transformations
  2162. (defun lispy--sub-slurp-forward (arg)
  2163. "Grow current marked symbol by ARG words forwards.
  2164. Return the amount of successful grow steps, nil instead of zero."
  2165. (when (looking-at "\\s_")
  2166. (let ((end (cdr (bounds-of-thing-at-point 'symbol)))
  2167. prev)
  2168. (lispy-dotimes arg
  2169. (setq prev (point))
  2170. (forward-word 1)
  2171. (when (> (point) end)
  2172. (goto-char prev)
  2173. (throw 'result (1- i)))))))
  2174. (defun lispy--sub-slurp-backward (arg)
  2175. "Grow current marked symbol by ARG backwards.
  2176. Return the amount of successful grow steps, nil instead of zero."
  2177. (when (lispy-looking-back "\\s_")
  2178. (let ((beg (car (bounds-of-thing-at-point 'symbol)))
  2179. prev)
  2180. (lispy-dotimes arg
  2181. (setq prev (point))
  2182. (backward-word 1)
  2183. (when (< (point) beg)
  2184. (goto-char prev)
  2185. (throw 'result (1- i)))))))
  2186. (defun lispy-slurp (arg)
  2187. "Grow current sexp by ARG sexps.
  2188. If ARG is zero, grow as far as possible. If ARG is -1, grow until the end or
  2189. beginning of the line. If it is not possible to slurp to the end of the line,
  2190. slurp as far as possible within the line. If before a multi-line list, slurp to
  2191. the end of the line where that list ends."
  2192. (interactive "p")
  2193. (if (region-active-p)
  2194. (if (= (point) (region-end))
  2195. (cond ((= arg 0)
  2196. (while (and (lispy-dotimes 1 (forward-sexp 1))
  2197. (not (looking-at "\\'")))))
  2198. ((= arg -1)
  2199. (while (and (not (looking-at (concat lispy-right "*$")))
  2200. (lispy-dotimes 1 (forward-sexp 1)))))
  2201. ((or (looking-at "\\s_")
  2202. (save-excursion
  2203. (goto-char (region-beginning))
  2204. (and (not (lispy-left-p))
  2205. (lispy-looking-back "\\s_"))))
  2206. (lispy--sub-slurp-forward arg))
  2207. ((looking-at "[\n ]+;")
  2208. (goto-char (match-end 0))
  2209. (goto-char (cdr (lispy--bounds-comment))))
  2210. (t
  2211. (lispy-dotimes arg
  2212. (forward-sexp 1))))
  2213. (cond ((= arg 0)
  2214. (while (and (lispy-dotimes 1 (forward-sexp -1))
  2215. (not (looking-at "\\`")))))
  2216. ((= arg -1)
  2217. (while (and (not (lispy-looking-back "^[[:space:]]*"))
  2218. (lispy-dotimes 1 (forward-sexp -1)))))
  2219. ((or (and (not (lispy-left-p))
  2220. (lispy-looking-back "\\s_"))
  2221. (save-excursion
  2222. (goto-char (region-end))
  2223. (looking-at "\\s_")))
  2224. (lispy--sub-slurp-backward arg))
  2225. ((save-excursion
  2226. (skip-chars-backward " \n")
  2227. (lispy--in-comment-p))
  2228. (skip-chars-backward " \n")
  2229. (goto-char (car (lispy--bounds-comment))))
  2230. (t
  2231. (lispy-dotimes arg
  2232. (forward-sexp -1)))))
  2233. (if (lispy-right-p)
  2234. (cond ((= arg 0)
  2235. (let ((last-pos (point)))
  2236. (while (and (lispy-dotimes 1
  2237. (lispy--slurp-forward)
  2238. (lispy--reindent))
  2239. (not (= (point) last-pos)))
  2240. (setq last-pos (point)))))
  2241. ((= arg -1)
  2242. (while (and (not (looking-at (concat "\\("
  2243. lispy-right
  2244. "\\|$\\)")))
  2245. (lispy-dotimes 1
  2246. (lispy--slurp-forward)))))
  2247. (t
  2248. (lispy-dotimes arg
  2249. (lispy--slurp-forward))))
  2250. (if (lispy-left-p)
  2251. (cond ((= arg 0)
  2252. ;; lispy--slurp-backward errors when reaching another delimiter
  2253. (while (and (lispy-dotimes 1
  2254. (lispy--slurp-backward))
  2255. (not (lispy-looking-back "\\`")))))
  2256. ((= arg -1)
  2257. (while (and (not (lispy-looking-back "^[[:space:]]*"))
  2258. (lispy-dotimes 1
  2259. (lispy--slurp-backward)))))
  2260. (t
  2261. (lispy-dotimes arg
  2262. (lispy--slurp-backward))))))
  2263. (lispy--reindent)))
  2264. (defun lispy-down-slurp ()
  2265. "Move current sexp or region into the next sexp."
  2266. (interactive)
  2267. (let ((bnd (lispy--bounds-dwim))
  2268. (leftp (lispy--leftp))
  2269. (regionp (region-active-p))
  2270. (bolp (bolp))
  2271. deactivate-mark)
  2272. (when (lispy-left-p)
  2273. (forward-sexp))
  2274. (let ((pt (save-excursion
  2275. (when (lispy-forward 1)
  2276. (lispy-backward 1)
  2277. (point)))))
  2278. (when pt
  2279. (goto-char pt)
  2280. (lispy--teleport (car bnd) (cdr bnd) (not leftp) regionp)
  2281. (save-excursion
  2282. (backward-char 1)
  2283. (when (lispy-looking-back (concat lispy-right " +"))
  2284. (just-one-space))
  2285. (when (and bolp (lispy-looking-back "^ +"))
  2286. (delete-region (match-beginning 0)
  2287. (match-end 0)))
  2288. (indent-sexp))))))
  2289. (defun lispy-up-slurp ()
  2290. "Move current sexp or region into the previous sexp.
  2291. If the point is by itself on a line or followed only by right delimiters, slurp
  2292. the point into the previous list. This can be of thought as indenting the code
  2293. to the next level and adjusting the parentheses accordingly."
  2294. (interactive)
  2295. (let* ((empty-line-p (lispy--empty-line-p))
  2296. (list-start (when (eq empty-line-p 'right)
  2297. (save-excursion
  2298. (re-search-forward lispy-right)
  2299. (lispy-different)
  2300. (point))))
  2301. (failp (when list-start
  2302. (= list-start
  2303. (save-excursion
  2304. (re-search-backward lispy-left)
  2305. (point)))))
  2306. (bnd (if empty-line-p
  2307. (cons (point) (point))
  2308. (lispy--bounds-dwim)))
  2309. (regionp (region-active-p))
  2310. (endp (or (lispy-right-p)
  2311. (and (region-active-p) (= (point) (region-end)))))
  2312. p-beg p-end
  2313. (deactivate-mark nil)
  2314. bsize)
  2315. (deactivate-mark)
  2316. (goto-char (car bnd))
  2317. (if (or failp
  2318. (not (lispy-backward 1)))
  2319. (progn
  2320. (lispy-complain "No list above to slurp into")
  2321. (if regionp
  2322. (lispy--mark bnd)
  2323. (goto-char
  2324. (if endp
  2325. (cdr bnd)
  2326. (car bnd)))))
  2327. (setq p-beg (point))
  2328. (forward-list)
  2329. (setq p-end (point))
  2330. (goto-char (car bnd))
  2331. (setq bsize (buffer-size))
  2332. (lispy-save-excursion
  2333. (goto-char (cdr bnd))
  2334. (insert (char-before p-end))
  2335. (goto-char p-end)
  2336. (backward-delete-char 1)
  2337. (goto-char p-beg)
  2338. (indent-sexp))
  2339. (setq bnd (cons (point)
  2340. (+ (point)
  2341. (- (cdr bnd) (car bnd))
  2342. (- (buffer-size)
  2343. bsize
  2344. (- (point) (car bnd))
  2345. 1))))
  2346. (when regionp
  2347. (lispy--mark bnd))
  2348. (if endp
  2349. (goto-char (cdr bnd))
  2350. (if (region-active-p)
  2351. (lispy-different)
  2352. (goto-char (car bnd)))))))
  2353. (defun lispy-indent-adjust-parens (arg)
  2354. "Indent the line if it is incorrectly indented or act as `lispy-up-slurp'.
  2355. If indenting does not adjust indentation or move the point, call
  2356. `lispy-up-slurp' ARG times."
  2357. (interactive "p")
  2358. (let ((tick (buffer-chars-modified-tick))
  2359. (pt (point))
  2360. (bnd (when (region-active-p)
  2361. (cons (region-beginning)
  2362. (region-end)))))
  2363. (indent-for-tab-command)
  2364. (when (and (= tick (buffer-chars-modified-tick))
  2365. (= pt (point)))
  2366. (if bnd
  2367. (lispy--mark bnd)
  2368. (unless (lispy--empty-line-p)
  2369. (set-mark (point))
  2370. (lispy-slurp -1)))
  2371. (dotimes (_ arg)
  2372. (lispy-up-slurp))
  2373. (when (and (not bnd)
  2374. (region-active-p))
  2375. (ignore-errors (lispy-different))
  2376. (deactivate-mark)))))
  2377. (defun lispy--backward-sexp-or-comment ()
  2378. "When in comment, move to the comment start.
  2379. Otherwise, move to the previous sexp."
  2380. (if (lispy--in-comment-p)
  2381. (goto-char (car (lispy--bounds-comment)))
  2382. (forward-sexp -1))
  2383. (skip-chars-backward " \n"))
  2384. (defun lispy--forward-sexp-or-comment ()
  2385. "When before comment, move to the comment end.
  2386. Otherwise, move to the next sexp."
  2387. (if (save-excursion
  2388. (skip-chars-forward " \n")
  2389. (lispy--in-comment-p))
  2390. (progn
  2391. (skip-chars-forward " \n")
  2392. (goto-char (cdr (lispy--bounds-comment))))
  2393. (forward-sexp 1)))
  2394. (defun lispy-barf (arg)
  2395. "Shrink current sexp or region by ARG sexps."
  2396. (interactive "p")
  2397. (cond ((region-active-p)
  2398. (let* ((bnd (lispy--bounds-dwim))
  2399. (str (lispy--string-dwim bnd))
  2400. (one-symbolp (lispy--symbolp str)))
  2401. (if (= (point) (region-end))
  2402. (cond (one-symbolp
  2403. (lispy-dotimes arg
  2404. (if (re-search-backward "\\sw\\s_+" (region-beginning) t)
  2405. (forward-char 1)
  2406. (throw 'result i))))
  2407. ((lispy--in-comment-p)
  2408. (goto-char (car (lispy--bounds-comment)))
  2409. (if (= (point) (region-beginning))
  2410. (goto-char (cdr (lispy--bounds-comment)))
  2411. (skip-chars-backward " \n")))
  2412. (t
  2413. (cl-incf arg)
  2414. (lispy-dotimes arg
  2415. (lispy--backward-sexp-or-comment))
  2416. (when (< (point) (car bnd))
  2417. (goto-char (car bnd)))
  2418. (lispy--forward-sexp-or-comment)))
  2419. (cond (one-symbolp
  2420. (lispy-dotimes arg
  2421. (if (re-search-forward "\\s_+\\sw" (region-end) t)
  2422. (backward-char 1)
  2423. (throw 'result i))))
  2424. ((lispy--in-comment-p)
  2425. (goto-char (cdr (lispy--bounds-comment)))
  2426. (if (= (region-beginning) (region-end))
  2427. (goto-char (car bnd))
  2428. (skip-chars-forward " \n")))
  2429. (t
  2430. (save-restriction
  2431. (narrow-to-region (point-min)
  2432. (region-end))
  2433. (cl-incf arg)
  2434. (lispy-dotimes arg
  2435. (lispy--forward-sexp-or-comment))
  2436. (if (lispy--in-comment-p)
  2437. (goto-char (car (lispy--bounds-comment)))
  2438. (forward-sexp -1))
  2439. (widen)))))))
  2440. ((looking-at "()"))
  2441. ((lispy-right-p)
  2442. (lispy-dotimes arg
  2443. (lispy--barf-backward)))
  2444. ((lispy-left-p)
  2445. (lispy-dotimes arg
  2446. (lispy--barf-forward)))))
  2447. (defun lispy-slurp-or-barf-right (arg)
  2448. "Barfs or slurps current sexp so that visually, the delimiter at point moves to the right.
  2449. When cursor is at lispy-right, will slurp ARG sexps forwards.
  2450. ((a)| b c) -> ((a b)| c)
  2451. When lispy-left, will barf ARG sexps forwards.
  2452. (|(a b) c) -> (a |(b) c)"
  2453. (interactive "p")
  2454. (if (region-active-p)
  2455. (if (= (point) (region-end))
  2456. (lispy-slurp arg)
  2457. (lispy-barf arg))
  2458. (if (lispy-right-p)
  2459. (lispy-slurp arg)
  2460. (lispy-barf arg))))
  2461. (defun lispy-slurp-or-barf-left (arg)
  2462. "Barfs or slurps current sexp so that visually, the delimiter at point moves to the left.
  2463. When cursor is at lispy-right, will barf ARG sexps backwards.
  2464. (a (b c)|) -> (a (b)| c)
  2465. When lispy-left, will slurp ARG sexps forwards.
  2466. (a |(b) c) -> (|(a b) c)"
  2467. (interactive "p")
  2468. (if (region-active-p)
  2469. (if (= (point) (region-beginning))
  2470. (lispy-slurp arg)
  2471. (lispy-barf arg))
  2472. (if (lispy-left-p)
  2473. (lispy-slurp arg)
  2474. (lispy-barf arg))))
  2475. (defun lispy-splice (arg)
  2476. "Splice ARG sexps into containing list."
  2477. (interactive "p")
  2478. (lispy-dotimes arg
  2479. (let ((bnd (lispy--bounds-dwim))
  2480. (deactivate-mark nil))
  2481. (cond ((region-active-p)
  2482. (save-excursion
  2483. (goto-char (cdr bnd))
  2484. (re-search-backward lispy-right)
  2485. (delete-region (point) (cdr bnd)))
  2486. (save-excursion
  2487. (goto-char (car bnd))
  2488. (re-search-forward lispy-left)
  2489. (delete-region (car bnd) (point))))
  2490. ((lispy-splice-let))
  2491. ((lispy-left-p)
  2492. (save-excursion
  2493. (goto-char (cdr bnd))
  2494. (delete-char -1))
  2495. (lispy--delete-leading-garbage)
  2496. (delete-char 1)
  2497. (lispy-forward 1)
  2498. (lispy-backward 1))
  2499. ((lispy-right-p)
  2500. (setq bnd (lispy--bounds-dwim))
  2501. (delete-char -1)
  2502. (goto-char (car bnd))
  2503. (let ((pt (point)))
  2504. (re-search-forward lispy-left nil t)
  2505. (delete-region pt (point)))
  2506. (lispy-backward 1)
  2507. (forward-list))
  2508. (t
  2509. (setq bnd (lispy--bounds-list))
  2510. (save-excursion
  2511. (goto-char (cdr bnd))
  2512. (delete-char -1))
  2513. (save-excursion
  2514. (goto-char (car bnd))
  2515. (delete-char 1)))))))
  2516. (defun lispy-find (item tree)
  2517. (cond ((null tree)
  2518. nil)
  2519. ((consp tree)
  2520. (or (lispy-find item (car tree))
  2521. (lispy-find item (cdr tree))))
  2522. (t
  2523. (eq item tree))))
  2524. (defun lispy-splice-let ()
  2525. "Join the current `let' into the parent `let'."
  2526. (when (save-excursion
  2527. (and (looking-at "(let")
  2528. (lispy--out-backward 1)
  2529. (looking-at "(let")))
  2530. (if (memq major-mode lispy-clojure-modes)
  2531. (lispy-splice-let-clojure)
  2532. (let ((child-binds (save-excursion
  2533. (lispy-flow 2)
  2534. (lispy--read (lispy--string-dwim))))
  2535. (parent-binds
  2536. (mapcar (lambda (x) (if (consp x) (car x) x))
  2537. (save-excursion
  2538. (lispy-up 1)
  2539. (lispy--read (lispy--string-dwim)))))
  2540. (end (save-excursion
  2541. (lispy-flow 2)
  2542. (point)))
  2543. (beg (save-excursion
  2544. (lispy-up 1)
  2545. (lispy-different)
  2546. (1- (point)))))
  2547. (save-excursion
  2548. (forward-list)
  2549. (delete-char -1))
  2550. (delete-region beg end)
  2551. (newline-and-indent)
  2552. (lispy-left 2)
  2553. (when (cl-find-if (lambda (v) (lispy-find v child-binds))
  2554. parent-binds)
  2555. (cond
  2556. ((looking-at "(let\\*"))
  2557. ((looking-at "(\\(let\\)")
  2558. (replace-match "(let*")
  2559. (lispy--out-backward 1)
  2560. (indent-sexp))
  2561. (t
  2562. (error "unexpected"))))
  2563. (lispy--normalize-1))
  2564. t)))
  2565. (defun lispy-splice-let-clojure ()
  2566. "Join the current Clojure `let' form into the parent `let'."
  2567. (let ((end (save-excursion
  2568. (lispy-flow 1)
  2569. (1+ (point))))
  2570. (beg (save-excursion
  2571. (lispy-up 1)
  2572. (lispy-different)
  2573. (1- (point)))))
  2574. (save-excursion
  2575. (forward-list)
  2576. (delete-char -1))
  2577. (delete-region beg end)
  2578. (insert "\n")
  2579. (lispy--out-backward 2)
  2580. (lispy--normalize-1)
  2581. t))
  2582. (defun lispy-barf-to-point (arg)
  2583. "Barf to the closest sexp before the point.
  2584. When ARG is non-nil, barf from the left."
  2585. (interactive "P")
  2586. (if (and (not arg)
  2587. (looking-at lispy-right))
  2588. (forward-char)
  2589. (unless (or (not (cadr (syntax-ppss)))
  2590. (let ((str (lispy--bounds-string)))
  2591. (and str
  2592. (not (= (car str) (point))))))
  2593. (let ((line-number (line-number-at-pos))
  2594. split-moved-point-down)
  2595. (lispy-split)
  2596. (when (and arg
  2597. (not (= (line-number-at-pos) line-number)))
  2598. (setq split-moved-point-down t))
  2599. (lispy--normalize-1)
  2600. (cond (arg
  2601. (save-excursion
  2602. (lispy-up 1)
  2603. (lispy-splice 1))
  2604. (when split-moved-point-down
  2605. (lispy-delete-backward 1)))
  2606. (t
  2607. (save-excursion
  2608. (lispy-splice 1))
  2609. (join-line)
  2610. (when (looking-at " $")
  2611. (delete-char 1))))
  2612. (lispy--reindent 1)))))
  2613. (defun lispy-reverse ()
  2614. "Reverse the current list or region selection."
  2615. (interactive)
  2616. (let* ((leftp (lispy--leftp))
  2617. (bnd (lispy--bounds-dwim))
  2618. (expr (lispy--read (format "(%s)" (lispy--string-dwim bnd))))
  2619. (deactivate-mark nil))
  2620. (delete-region (car bnd) (cdr bnd))
  2621. (if (eq (length expr) 1)
  2622. (lispy--insert (nreverse (car expr)))
  2623. (lispy--insert (nreverse expr))
  2624. (lispy-splice 1))
  2625. (when leftp
  2626. (lispy-different))))
  2627. (defun lispy-raise (arg)
  2628. "Use current sexp or region as replacement for its parent.
  2629. Do so ARG times."
  2630. (interactive "p")
  2631. (lispy-dotimes arg
  2632. (let ((regionp (region-active-p))
  2633. (leftp (lispy--leftp))
  2634. (deactivate-mark nil)
  2635. bnd1 bnd2)
  2636. ;; re-indent first
  2637. (lispy-save-excursion (lispy--out-forward 1))
  2638. (unless leftp
  2639. (lispy-different))
  2640. (setq bnd1 (lispy--bounds-dwim))
  2641. (deactivate-mark)
  2642. (lispy--out-forward 1)
  2643. (setq bnd2 (lispy--bounds-dwim))
  2644. (delete-region (cdr bnd2) (cdr bnd1))
  2645. (delete-region (car bnd2) (car bnd1))
  2646. (if regionp
  2647. (progn
  2648. (indent-region (car bnd2) (point))
  2649. (lispy--mark (cons (car bnd2) (point))))
  2650. (lispy-from-left
  2651. (indent-sexp)))
  2652. (unless (eq leftp (lispy--leftp))
  2653. (lispy-different)))))
  2654. (defun lispy-raise-some ()
  2655. "Use current sexps as replacement for their parent.
  2656. The outcome when ahead of sexps is different from when behind."
  2657. (interactive)
  2658. (let ((pt (point)))
  2659. (cond ((region-active-p))
  2660. ((lispy-left-p)
  2661. (if (null (lispy--out-forward 1))
  2662. (progn
  2663. (goto-char pt)
  2664. (lispy-complain "Not enough depth to raise"))
  2665. (backward-char 1)
  2666. (set-mark (point))
  2667. (goto-char pt)))
  2668. ((lispy-right-p)
  2669. (if (null (lispy--out-forward 1))
  2670. (progn
  2671. (goto-char pt)
  2672. (lispy-complain "Not enough depth to raise"))
  2673. (backward-list)
  2674. (forward-char 1)
  2675. (set-mark (point))
  2676. (goto-char pt)))
  2677. (t
  2678. (error "Unexpected")))
  2679. (lispy-raise 1)
  2680. (deactivate-mark)))
  2681. (defun lispy-convolute (arg)
  2682. "Replace (...(,,,|( with (,,,(...|( where ... and ,,, is arbitrary code.
  2683. When ARG is more than 1, pull ARGth expression to enclose current sexp."
  2684. (interactive "p")
  2685. (let ((deactivate-mark nil))
  2686. (if (and (save-excursion
  2687. (lispy--out-forward (1+ arg)))
  2688. (save-excursion
  2689. (lispy--out-backward (1+ arg))))
  2690. (let (beg end)
  2691. (lispy-from-left
  2692. (setq beg (point))
  2693. (setq end (lispy--out-backward arg))
  2694. (lispy--out-backward 1)
  2695. (lispy--swap-regions (cons beg end)
  2696. (cons (point) (point)))
  2697. (lispy--reindent arg))
  2698. (lispy-from-left
  2699. (lispy-different)
  2700. (setq beg (point))
  2701. (setq end (lispy--out-forward arg))
  2702. (lispy--out-forward 1)
  2703. (lispy--swap-regions (cons beg end)
  2704. (cons (point) (point)))
  2705. (ignore-errors
  2706. (lispy-different))
  2707. (lispy--reindent (1+ arg))))
  2708. (error "Not enough depth to convolute"))))
  2709. (defun lispy-convolute-left ()
  2710. "Convolute and move left.
  2711. Useful for propagating `let' bindings."
  2712. (interactive)
  2713. (if (region-active-p)
  2714. (progn
  2715. (lispy-convolute 1)
  2716. (lispy-left 1))
  2717. (user-error "region must be active")))
  2718. (defvar lispy-repeat--command nil
  2719. "Command to use with `lispy-repeat'.")
  2720. (defvar lispy-repeat--prefix-arg nil
  2721. "Prefix arg to use with `lispy-repeat'.")
  2722. (defun lispy-repeat ()
  2723. "Repeat last command with last prefix arg."
  2724. (interactive)
  2725. (unless (memq last-command
  2726. '(special-lispy-repeat lispy-repeat))
  2727. (setq lispy-repeat--command last-command)
  2728. (setq lispy-repeat--prefix-arg
  2729. (or last-prefix-arg 1)))
  2730. (setq current-prefix-arg lispy-repeat--prefix-arg)
  2731. (funcall lispy-repeat--command))
  2732. (defun lispy-join ()
  2733. "Join sexps."
  2734. (interactive)
  2735. (let ((pt (point))
  2736. bnd)
  2737. (cond ((lispy-right-p)
  2738. (when (lispy-forward 1)
  2739. (backward-list)
  2740. (delete-char 1)
  2741. (goto-char pt)
  2742. (backward-delete-char 1)
  2743. (lispy--out-forward 1)
  2744. (lispy--reindent 1)))
  2745. ((lispy-left-p)
  2746. (when (lispy-backward 1)
  2747. (forward-list)
  2748. (backward-delete-char 1)
  2749. (goto-char (1- pt))
  2750. (delete-char 1)
  2751. (lispy-save-excursion
  2752. (forward-char 1)
  2753. (lispy-left 2)
  2754. (lispy--normalize-1))))
  2755. ((and (setq bnd (lispy--bounds-string))
  2756. (or (save-excursion
  2757. (goto-char (car bnd))
  2758. (skip-chars-backward " \t\n")
  2759. (when (eq (char-before) ?\")
  2760. (delete-region (1- (point))
  2761. (1+ (car bnd)))
  2762. t))
  2763. (save-excursion
  2764. (goto-char (cdr bnd))
  2765. (skip-chars-forward " \t\n")
  2766. (when (looking-at "\"")
  2767. (delete-region (1- (cdr bnd))
  2768. (1+ (point)))
  2769. t))))))))
  2770. (defun lispy-split ()
  2771. "Split sexps."
  2772. (interactive)
  2773. (let (bnd
  2774. char-left
  2775. char-right)
  2776. (cond ((lispy--in-comment-p)
  2777. (indent-new-comment-line))
  2778. ((and (setq bnd (lispy--bounds-string))
  2779. (not (= (point) (car bnd))))
  2780. (insert "\"\"")
  2781. (when (eolp)
  2782. (delete-char 1))
  2783. (backward-char)
  2784. (newline-and-indent))
  2785. (t
  2786. (when (save-excursion
  2787. (prog1 (lispy--out-forward 1)
  2788. (setq char-right (char-before))
  2789. (forward-list -1)
  2790. (setq char-left (char-after))))
  2791. (insert (string char-right char-left))
  2792. (backward-char 2)
  2793. (lispy-right 1))
  2794. (newline-and-indent)
  2795. (when (lispy-left-p)
  2796. (indent-sexp))))))
  2797. ;;* Locals: more transformations
  2798. (defun lispy-move-up (arg)
  2799. "Move current expression up ARG times. Don't exit parent list.
  2800. Also works from inside the list."
  2801. (interactive "p")
  2802. (if (or (lispy-left-p)
  2803. (lispy-right-p)
  2804. (region-active-p)
  2805. (looking-at lispy-outline))
  2806. (lispy--move-up-special arg)
  2807. (let ((offset (-
  2808. (point)
  2809. (progn
  2810. (lispy--out-backward 1)
  2811. (point)))))
  2812. (lispy--move-up-special arg)
  2813. (forward-char offset))))
  2814. (defun lispy-move-down (arg)
  2815. "Move current expression down ARG times. Don't exit parent list.
  2816. Also works from inside the list."
  2817. (interactive "p")
  2818. (if (or (lispy-left-p)
  2819. (lispy-right-p)
  2820. (region-active-p)
  2821. (looking-at lispy-outline))
  2822. (lispy--move-down-special arg)
  2823. (let ((offset (-
  2824. (point)
  2825. (progn
  2826. (lispy--out-backward 1)
  2827. (point)))))
  2828. (lispy--move-down-special arg)
  2829. (forward-char offset))))
  2830. (defun lispy--move-up-region (arg)
  2831. "Swap the marked region ARG positions up.
  2832. Precondition: the region is active and the point is at `region-beginning'."
  2833. (cond
  2834. ((and (looking-at "\\_<")
  2835. (save-excursion
  2836. (goto-char (region-end))
  2837. (looking-at "-"))))
  2838. ((lispy-after-string-p "-")
  2839. (let ((bnd1 (lispy--bounds-dwim))
  2840. bnd2)
  2841. (lispy-up arg)
  2842. (setq bnd2 (lispy--bounds-dwim))
  2843. (lispy--swap-regions bnd1 bnd2)
  2844. (setq deactivate-mark nil)
  2845. (set-mark (point))
  2846. (forward-char (- (cdr bnd1) (car bnd1)))))
  2847. ((= arg 1)
  2848. (let ((bnd1 (lispy--bounds-dwim))
  2849. (bnd0 (save-excursion
  2850. (deactivate-mark)
  2851. (if (ignore-errors (up-list) t)
  2852. (lispy--bounds-dwim)
  2853. (cons (point-min) (point-max)))))
  2854. bnd2)
  2855. (goto-char (car bnd1))
  2856. (if (re-search-backward "[^ \t\n`'#({[]" (car bnd0) t)
  2857. (progn
  2858. (deactivate-mark)
  2859. (if (lispy--in-comment-p)
  2860. (setq bnd2 (lispy--bounds-comment))
  2861. (when (eq (char-after) ?\")
  2862. (forward-char)
  2863. (backward-sexp))
  2864. (when (memq (char-after) '(?\) ?\] ?\}))
  2865. (forward-char))
  2866. (setq bnd2 (lispy--bounds-dwim)))
  2867. (lispy--swap-regions bnd1 bnd2)
  2868. (setq deactivate-mark nil)
  2869. (goto-char (car bnd2))
  2870. (set-mark (point))
  2871. (forward-char (- (cdr bnd1) (car bnd1))))
  2872. (setq deactivate-mark nil)
  2873. (lispy--mark bnd1)))
  2874. (exchange-point-and-mark))
  2875. (t
  2876. (let ((bnd1 (lispy--bounds-dwim)))
  2877. (lispy-up arg)
  2878. (lispy--mark
  2879. (car
  2880. (lispy--swap-regions
  2881. bnd1 (lispy--bounds-dwim)))))
  2882. (exchange-point-and-mark))))
  2883. (defun lispy--move-up-special (arg)
  2884. "Move current expression up ARG times. Don't exit parent list."
  2885. (let ((at-start (lispy--leftp)))
  2886. (unless (or at-start (looking-at lispy-outline))
  2887. (lispy-different))
  2888. (cond ((region-active-p)
  2889. (lispy--move-up-region arg))
  2890. ((looking-at lispy-outline)
  2891. (lispy-move-outline-up arg))
  2892. (t
  2893. (lispy--mark (lispy--bounds-dwim))
  2894. (lispy-move-up arg)
  2895. (deactivate-mark)
  2896. (lispy-different)))
  2897. (unless at-start (lispy-different))))
  2898. (declare-function zo-up "zoutline")
  2899. (defun lispy-move-outline-up (arg)
  2900. (interactive)
  2901. (require 'zoutline)
  2902. (lispy-dotimes arg
  2903. (let ((lvl1 (lispy-outline-level))
  2904. (lvl2 (save-excursion
  2905. (backward-char)
  2906. (lispy-outline-level))))
  2907. (when (<= lvl1 lvl2)
  2908. (let ((bnd1 (lispy--bounds-outline))
  2909. (bnd2 (progn
  2910. (zo-up 1)
  2911. (lispy--bounds-outline))))
  2912. (if (or (equal bnd1 bnd2)
  2913. (and (eq (car bnd2) (point-min))
  2914. (not (save-excursion
  2915. (goto-char (point-min))
  2916. (looking-at lispy-outline)))))
  2917. (goto-char (car bnd1))
  2918. (lispy--swap-regions bnd1 bnd2)
  2919. (goto-char (car bnd2))))))))
  2920. (defun lispy--move-down-region (arg)
  2921. "Swap the marked region ARG positions down.
  2922. Precondition: the region is active and the point is at `region-beginning'."
  2923. (cond
  2924. ((and (lispy-after-string-p "-")
  2925. (save-excursion
  2926. (goto-char (region-end))
  2927. (looking-at "\\_>"))))
  2928. ((save-excursion
  2929. (goto-char (region-end))
  2930. (looking-at "-"))
  2931. (let ((bnd1 (lispy--bounds-dwim))
  2932. bnd2)
  2933. (lispy-down arg)
  2934. (setq bnd2 (lispy--bounds-dwim))
  2935. (lispy--swap-regions bnd1 bnd2)
  2936. (goto-char (cdr bnd2))
  2937. (setq deactivate-mark nil)
  2938. (set-mark (point))
  2939. (forward-char (- (car bnd1) (cdr bnd1)))))
  2940. ((= arg 1)
  2941. (let ((bnd1 (lispy--bounds-dwim))
  2942. (bnd0 (save-excursion
  2943. (deactivate-mark)
  2944. (if (ignore-errors (up-list) t)
  2945. (lispy--bounds-dwim)
  2946. (cons (point-min) (point-max)))))
  2947. bnd2)
  2948. (goto-char (cdr bnd1))
  2949. (if (re-search-forward "[^ \t\n]" (max (1- (cdr bnd0))
  2950. (point)) t)
  2951. (progn
  2952. (deactivate-mark)
  2953. (if (lispy--in-comment-p)
  2954. (setq bnd2 (lispy--bounds-comment))
  2955. (when (memq (char-before) '(?\( ?\" ?\[ ?\{))
  2956. (backward-char))
  2957. (setq bnd2 (lispy--bounds-dwim)))
  2958. (lispy--swap-regions bnd1 bnd2)
  2959. (setq deactivate-mark nil)
  2960. (goto-char (cdr bnd2))
  2961. (set-mark (point))
  2962. (backward-char (- (cdr bnd1) (car bnd1))))
  2963. (lispy--mark bnd1)
  2964. (exchange-point-and-mark))))
  2965. (t
  2966. (let ((bnd1 (lispy--bounds-dwim)))
  2967. (lispy-down arg)
  2968. (lispy--mark
  2969. (cdr
  2970. (lispy--swap-regions
  2971. bnd1 (lispy--bounds-dwim))))
  2972. (lispy-different)))))
  2973. (defun lispy--move-down-special (arg)
  2974. "Move current expression down ARG times. Don't exit parent list."
  2975. (let ((at-start (lispy--leftp)))
  2976. (unless (or at-start (looking-at lispy-outline))
  2977. (lispy-different))
  2978. (cond ((region-active-p)
  2979. (lispy--move-down-region arg))
  2980. ((looking-at lispy-outline)
  2981. (lispy-dotimes arg
  2982. (let ((bnd1 (lispy--bounds-outline))
  2983. bnd2)
  2984. (goto-char (1+ (cdr bnd1)))
  2985. (if (and (setq bnd2 (lispy--bounds-outline))
  2986. (not (equal bnd1 bnd2)))
  2987. (progn
  2988. (lispy--swap-regions bnd1 bnd2)
  2989. (forward-char (1+ (- (cdr bnd2) (car bnd2)))))
  2990. (goto-char (car bnd1))))))
  2991. (t
  2992. (lispy--mark (lispy--bounds-dwim))
  2993. (lispy-move-down arg)
  2994. (deactivate-mark)
  2995. (lispy-different)))
  2996. (unless at-start (lispy-different))))
  2997. (defun lispy-move-left (arg)
  2998. "Move region left ARG times."
  2999. (interactive "p")
  3000. (lispy-dotimes arg
  3001. (when (save-excursion (ignore-errors (up-list) t))
  3002. (let* ((regionp (region-active-p))
  3003. (leftp (lispy--leftp))
  3004. (bnd (lispy--bounds-dwim))
  3005. (str (lispy--string-dwim bnd))
  3006. pt)
  3007. (delete-region (car bnd) (cdr bnd))
  3008. (cond ((looking-at " *;"))
  3009. ((and (looking-at "\n")
  3010. (lispy-bolp))
  3011. (delete-region
  3012. (line-beginning-position)
  3013. (1+ (point))))
  3014. ((looking-at "\\([\n ]+\\)[^\n ;]")
  3015. (delete-region (match-beginning 1)
  3016. (match-end 1))))
  3017. (deactivate-mark)
  3018. (lispy--out-backward 1)
  3019. (setq pt (point))
  3020. (insert str)
  3021. (newline-and-indent)
  3022. (skip-chars-backward " \n")
  3023. (indent-region pt (point))
  3024. (if regionp
  3025. (progn
  3026. (setq deactivate-mark nil)
  3027. (set-mark pt)
  3028. (when leftp
  3029. (exchange-point-and-mark)))
  3030. (when leftp
  3031. (lispy-different)))))))
  3032. (defun lispy-move-right (arg)
  3033. "Move region right ARG times."
  3034. (interactive "p")
  3035. (lispy-dotimes arg
  3036. (when (save-excursion (ignore-errors (up-list) t))
  3037. (let* ((regionp (region-active-p))
  3038. (leftp (lispy--leftp))
  3039. (bnd (lispy--bounds-dwim))
  3040. (str (lispy--string-dwim bnd))
  3041. pt)
  3042. (delete-region (car bnd) (cdr bnd))
  3043. (cond ((looking-at " *;"))
  3044. ((and (looking-at "\n")
  3045. (lispy-bolp))
  3046. (delete-region
  3047. (line-beginning-position)
  3048. (1+ (point))))
  3049. ((looking-at "\\([\n ]+\\)[^\n ;]")
  3050. (delete-region (match-beginning 1)
  3051. (match-end 1))))
  3052. (lispy--out-backward 1)
  3053. (deactivate-mark)
  3054. (lispy-different)
  3055. (newline-and-indent)
  3056. (setq pt (point))
  3057. (insert str)
  3058. (indent-region pt (point))
  3059. (if regionp
  3060. (progn
  3061. (setq deactivate-mark nil)
  3062. (set-mark pt)
  3063. (when leftp
  3064. (exchange-point-and-mark)))
  3065. (when leftp
  3066. (lispy-different)))))))
  3067. (defun lispy-dedent-adjust-parens (arg)
  3068. "Move region or all the following sexps in the current list right.
  3069. This can be of thought as dedenting the code to the previous level and adjusting
  3070. the parentheses accordingly."
  3071. (interactive "p")
  3072. (let ((line-type (lispy--empty-line-p)))
  3073. (cond ((eq line-type 'right)
  3074. (unless (looking-at lispy-right)
  3075. (re-search-forward lispy-right)
  3076. (backward-char))
  3077. (lispy-dotimes arg
  3078. (when (looking-at "$")
  3079. (error "No longer in sexp"))
  3080. (unless (save-excursion
  3081. (forward-line -1)
  3082. (end-of-line)
  3083. (lispy--in-comment-p))
  3084. (lispy-delete-backward 1))
  3085. (forward-char)
  3086. (newline-and-indent)))
  3087. ((region-active-p)
  3088. (lispy-move-right arg))
  3089. ((not line-type)
  3090. (set-mark (point))
  3091. (lispy-slurp 0)
  3092. (lispy-move-right arg)
  3093. (lispy-different)
  3094. (deactivate-mark)))))
  3095. (defun lispy-clone (arg)
  3096. "Clone sexp ARG times.
  3097. When the sexp is top level, insert an additional newline."
  3098. (interactive "p")
  3099. (let* ((bnd (lispy--bounds-dwim))
  3100. (str (lispy--string-dwim bnd))
  3101. (pt (point)))
  3102. (cond ((region-active-p)
  3103. (lispy-dotimes arg
  3104. (cl-labels
  3105. ((doit ()
  3106. (let (deactivate-mark)
  3107. (save-excursion
  3108. (newline)
  3109. (insert str)
  3110. (lispy--indent-for-tab)))))
  3111. (if (= (point) (region-end))
  3112. (doit)
  3113. (exchange-point-and-mark)
  3114. (doit)
  3115. (exchange-point-and-mark)))))
  3116. ((lispy-left-p)
  3117. (goto-char (car bnd))
  3118. (cond ((and (bolp) (looking-at "(defun"))
  3119. (lispy-dotimes arg
  3120. (insert str)
  3121. (newline)
  3122. (newline))
  3123. (goto-char pt))
  3124. ((and (bolp)
  3125. (save-excursion
  3126. (goto-char (cdr bnd))
  3127. (looking-at "\n;; =>")))
  3128. (lispy-dotimes arg
  3129. (insert str)
  3130. (newline-and-indent)
  3131. (lispy-move-down 1)))
  3132. (t
  3133. (lispy-dotimes arg
  3134. (insert str)
  3135. (newline-and-indent))
  3136. (goto-char pt))))
  3137. ((lispy-right-p)
  3138. (if (save-excursion
  3139. (backward-list)
  3140. (and (bolp) (looking-at "(defun")))
  3141. (lispy-dotimes arg
  3142. (newline)
  3143. (newline-and-indent)
  3144. (insert str))
  3145. (lispy-dotimes arg
  3146. (newline-and-indent)
  3147. (insert str))))
  3148. (t
  3149. (error "Unexpected")))))
  3150. (defvar lispy--oneline-comments nil
  3151. "Collect comments for `lispy--oneline'.")
  3152. (defun lispy-mapcan-tree (func expr)
  3153. "Reduce with FUNC all lists in EXPR."
  3154. (cond ((null expr)
  3155. nil)
  3156. ((and (vectorp expr) (> (length expr) 0))
  3157. (apply #'vector
  3158. (funcall func
  3159. (lispy-mapcan-tree func (aref expr 0))
  3160. (lispy-mapcan-tree
  3161. func
  3162. (cdr
  3163. (mapcar #'identity expr))))))
  3164. ((listp expr)
  3165. (funcall func
  3166. (lispy-mapcan-tree func (car expr))
  3167. (lispy-mapcan-tree func (cdr expr))))
  3168. (t
  3169. expr)))
  3170. (defun lispy--oneline (expr &optional ignore-comments)
  3171. "Remove newlines from EXPR.
  3172. When IGNORE-COMMENTS is not nil, don't remove comments.
  3173. Instead keep them, with a newline after each comment."
  3174. (lispy-mapcan-tree
  3175. (lambda (x y)
  3176. (cond ((equal x '(ly-raw newline))
  3177. y)
  3178. ((lispy--raw-comment-p x)
  3179. (if (null ignore-comments)
  3180. (progn
  3181. (push x lispy--oneline-comments)
  3182. y)
  3183. (if (equal (car y) '(ly-raw newline))
  3184. (cons x y)
  3185. `(,x (ly-raw newline) ,@y))))
  3186. ((and (lispy--raw-string-p x)
  3187. (null ignore-comments))
  3188. (cons `(ly-raw string ,(replace-regexp-in-string "\n" "\\\\n" (cl-caddr x)))
  3189. y))
  3190. (t
  3191. (cons x y))))
  3192. expr))
  3193. (defun lispy-oneline ()
  3194. "Squeeze current sexp into one line.
  3195. Comments will be moved ahead of sexp."
  3196. (interactive)
  3197. (if (lispy--in-comment-p)
  3198. (let* ((bnd (lispy--bounds-comment))
  3199. (str (lispy--string-dwim bnd)))
  3200. (delete-region (car bnd) (cdr bnd))
  3201. (insert ";; "
  3202. (mapconcat #'identity
  3203. (split-string str "[ \n]*;;[ \n]*" t)
  3204. " "))
  3205. (beginning-of-line)
  3206. (back-to-indentation))
  3207. (unless (or (lispy-left-p)
  3208. (lispy-right-p))
  3209. (lispy--out-backward 1))
  3210. (let* ((bnd (lispy--bounds-dwim))
  3211. (str (lispy--string-dwim bnd))
  3212. (from-left (lispy-left-p))
  3213. expr)
  3214. (delete-region (car bnd) (cdr bnd))
  3215. (when (region-active-p)
  3216. (deactivate-mark))
  3217. (setq lispy--oneline-comments nil)
  3218. (if (setq expr (ignore-errors
  3219. (lispy--oneline
  3220. (lispy--read str))))
  3221. (progn
  3222. (mapc (lambda (x)
  3223. (lispy--insert x)
  3224. (newline))
  3225. lispy--oneline-comments)
  3226. (lispy--insert expr))
  3227. (let ((no-comment "")
  3228. comments)
  3229. (cl-loop for s in (split-string str "\n" t)
  3230. do (if (string-match "^ *\\(;\\)" s)
  3231. (push (substring s (match-beginning 1)) comments)
  3232. (setq no-comment (concat no-comment "\n" s))))
  3233. (when comments
  3234. (insert (mapconcat #'identity comments "\n") "\n"))
  3235. (insert (substring
  3236. (replace-regexp-in-string "\n *" " " no-comment) 1))))
  3237. (when from-left
  3238. (backward-list)))))
  3239. (defun lispy-multiline (&optional arg)
  3240. "Spread current sexp over multiple lines.
  3241. When ARG is `fill', do nothing for short expressions."
  3242. (interactive "p")
  3243. (unless (or (lispy-left-p)
  3244. (lispy-right-p))
  3245. (lispy--out-backward 1))
  3246. (lispy-from-left
  3247. (let* ((bnd (lispy--bounds-list))
  3248. (str (lispy--string-dwim bnd))
  3249. (plain-expr (read str))
  3250. (expr (lispy--read str))
  3251. res)
  3252. (unless (and (eq arg 'fill)
  3253. (< (length str) 80))
  3254. (unless (listp plain-expr)
  3255. (setq plain-expr nil))
  3256. (if (or (cl-some #'listp plain-expr)
  3257. (member '(ly-raw newline) expr))
  3258. (let ((pt (point)))
  3259. (lispy-forward 1)
  3260. (while (and (lispy-flow 1) (> (point) pt))
  3261. (unless (looking-at "\]\\|)\\|\n")
  3262. (when (looking-at " *")
  3263. (replace-match "\n")
  3264. (backward-char 1))))
  3265. (goto-char pt)
  3266. (indent-sexp))
  3267. (delete-region (car bnd) (cdr bnd))
  3268. (setq res
  3269. (butlast
  3270. (cl-mapcan (lambda (y)
  3271. (if (memq y '(ly-raw clojure-map clojure-set))
  3272. (list y)
  3273. (list y '(ly-raw newline))))
  3274. (lispy--read str))))
  3275. (when (vectorp expr)
  3276. (setq res (apply #'vector res)))
  3277. (lispy--insert res))))))
  3278. (defvar-local lispy--multiline-take-3
  3279. '(defvar defun defmacro defcustom defgroup defvar-local declare-function
  3280. define-key nth throw define-error defadvice defhydra defsubst)
  3281. "List of constructs for which the first 3 elements are on the first line.")
  3282. (setq-mode-local
  3283. clojure-mode
  3284. lispy--multiline-take-3 '())
  3285. (defvar lispy--multiline-take-3-arg
  3286. '(defun defmacro declare-function define-error defadvice defhydra defsubst)
  3287. "List of constructs for which the first 3 elements are on the first line.
  3288. The third one is assumed to be the arglist and will not be changed.")
  3289. (defvar-local lispy--multiline-take-2
  3290. '(defface define-minor-mode
  3291. condition-case while incf car
  3292. cdr > >= < <= /= = eq equal incf
  3293. decf cl-incf cl-decf catch
  3294. require provide setq cons when
  3295. if unless interactive assq delq
  3296. assoc declare lambda remq
  3297. make-variable-buffer-local
  3298. bound-and-true-p
  3299. called-interactively-p
  3300. lispy-dotimes cond case cl-case
  3301. defalias 1+ 1- dotimes dolist boundp fboundp macrop
  3302. null consp oddp zerop plusp minusp kbd
  3303. not pop listp or and)
  3304. "List of constructs for which the first 2 elements are on the first line.")
  3305. (setq-mode-local
  3306. clojure-mode
  3307. lispy--multiline-take-2 '(loop recur for fn def defn ns if -> ->>
  3308. + +' - -' * *' / > >= < <= = ==
  3309. or and not
  3310. assoc! assoc assoc-in concat))
  3311. (defvar lispy--multiline-take-2-arg '(declare lambda
  3312. make-variable-buffer-local
  3313. bound-and-true-p
  3314. called-interactively-p
  3315. lispy-dotimes dotimes)
  3316. "List of constructs for which the first 2 elements are on the first line.
  3317. The second one will not be changed.")
  3318. (defun lispy-interleave (x lst &optional step)
  3319. "Insert X in between each element of LST.
  3320. Don't insert X when it's already there.
  3321. When STEP is non-nil, insert in between each STEP elements instead."
  3322. (setq step (or step 1))
  3323. (let ((res (nreverse (lispy-multipop lst step)))
  3324. item)
  3325. (while lst
  3326. (unless (equal (car res) x)
  3327. (push x res))
  3328. (unless (equal (car res)
  3329. (car (setq item (lispy-multipop lst step))))
  3330. (setq res (nconc (nreverse item) res))))
  3331. (nreverse res)))
  3332. (defcustom lispy-multiline-threshold 32
  3333. "Don't multiline expresssions shorter than this when printed as a string."
  3334. :type 'integer)
  3335. (defun lispy--translate-newlines (str)
  3336. "Replace quoted newlines with real ones in STR."
  3337. (with-temp-buffer
  3338. (insert str)
  3339. (goto-char (point-min))
  3340. (while (re-search-forward "\\\\n" nil t)
  3341. (unless (= ?\\
  3342. (char-before (- (point) 2)))
  3343. (replace-match "\n" nil t)))
  3344. (buffer-string)))
  3345. (defun lispy--multiline-1 (expr &optional quoted)
  3346. "Transform a one-line EXPR into a multi-line.
  3347. When QUOTED is not nil, assume that EXPR is quoted and ignore some rules."
  3348. (cond ((vectorp expr)
  3349. (apply #'vector
  3350. (lispy--multiline-1
  3351. (mapcar #'identity expr))))
  3352. ((not (listp expr))
  3353. expr)
  3354. ((and lispy-multiline-threshold
  3355. (< (length (lispy--prin1-to-string
  3356. expr 0 'emacs-lisp-mode))
  3357. lispy-multiline-threshold))
  3358. expr)
  3359. (t
  3360. (let ((res nil)
  3361. elt)
  3362. (while expr
  3363. (setq elt (pop expr))
  3364. (cond
  3365. ((eq elt 'ly-raw)
  3366. (cl-case (car expr)
  3367. (empty
  3368. (setq res '(ly-raw empty)))
  3369. (raw
  3370. (setq res (cons elt expr)))
  3371. (dot
  3372. (setq res (cons elt expr)))
  3373. (newline
  3374. (setq res '(ly-raw newline)))
  3375. (comment
  3376. (setq res (cons elt expr)))
  3377. (string
  3378. (setq res
  3379. `(ly-raw string
  3380. ,(lispy--translate-newlines
  3381. (cadr expr)))))
  3382. (t (unless (= (length expr) 2)
  3383. (error "Unexpected expr: %S" expr))
  3384. (unless (null res)
  3385. (error "Stray ly-raw in %S" expr))
  3386. (setq res (list 'ly-raw (car expr)
  3387. (lispy--multiline-1
  3388. (cadr expr)
  3389. (car (memq (car expr) '(quote \` clojure-lambda))))))))
  3390. (setq expr nil))
  3391. ((vectorp elt)
  3392. (push
  3393. (apply #'vector
  3394. (lispy--multiline-1
  3395. (mapcar #'identity elt)))
  3396. res)
  3397. (push '(ly-raw newline) res))
  3398. ((equal elt '(ly-raw dot))
  3399. (when (equal (car res) '(ly-raw newline))
  3400. (pop res))
  3401. (push elt res))
  3402. ((equal elt '(ly-raw clojure-comma))
  3403. ;; two sexps without newlines, then a comma with a newline
  3404. (when (equal (car res) '(ly-raw newline))
  3405. (pop res))
  3406. (when (equal (cadr res) '(ly-raw newline))
  3407. (setq res
  3408. (cons (car res)
  3409. (cddr res))))
  3410. (push elt res)
  3411. (push '(ly-raw newline) res))
  3412. ((and (not quoted) (memq elt lispy--multiline-take-3))
  3413. (push elt res)
  3414. ;; name
  3415. (when expr
  3416. (push (pop expr) res))
  3417. ;; value
  3418. (when expr
  3419. (if (memq elt lispy--multiline-take-3-arg)
  3420. (push (pop expr) res)
  3421. (push (car (lispy--multiline-1 (list (pop expr)))) res)))
  3422. (push '(ly-raw newline) res))
  3423. ((and (not quoted) (memq elt lispy--multiline-take-2))
  3424. (push elt res)
  3425. (when (memq elt lispy--multiline-take-2-arg)
  3426. (push (pop expr) res)
  3427. (push '(ly-raw newline) res)))
  3428. ((and (memq elt '(let let*))
  3429. expr
  3430. (or (memq major-mode lispy-clojure-modes)
  3431. (and
  3432. (listp (car expr))
  3433. (listp (cdar expr)))))
  3434. (push elt res)
  3435. (let ((body (pop expr)))
  3436. (push
  3437. (if (memq major-mode lispy-clojure-modes)
  3438. (apply #'vector
  3439. (lispy-interleave '(ly-raw newline)
  3440. (mapcar #'lispy--multiline-1 body) 2))
  3441. (lispy-interleave
  3442. '(ly-raw newline)
  3443. (mapcar
  3444. (lambda (x)
  3445. (if (and (listp x)
  3446. (not (eq (car x) 'ly-raw)))
  3447. (cons (car x)
  3448. (lispy--multiline-1 (cdr x)))
  3449. x))
  3450. body)))
  3451. res))
  3452. (push '(ly-raw newline) res))
  3453. ((keywordp elt)
  3454. (push elt res))
  3455. ((not (listp elt))
  3456. (push elt res)
  3457. (unless (and (numberp elt) (eq quoted 'clojure-lambda))
  3458. (push '(ly-raw newline) res)))
  3459. (t
  3460. (setq elt (lispy--multiline-1 elt))
  3461. (if (equal elt '(ly-raw newline))
  3462. (unless (equal elt (car res))
  3463. (push elt res))
  3464. (push elt res)
  3465. (push '(ly-raw newline) res)))))
  3466. (cond ((equal (car res) 'ly-raw)
  3467. res)
  3468. ((equal (car res) '(ly-raw newline))
  3469. (if (and (cdr res)
  3470. (lispy--raw-comment-p (cadr res)))
  3471. (nreverse res)
  3472. (nreverse (cdr res))))
  3473. (t
  3474. (nreverse res)))))))
  3475. (defun lispy-alt-multiline (&optional silent)
  3476. "Spread current sexp over multiple lines.
  3477. When SILENT is non-nil, don't issue messages."
  3478. (interactive)
  3479. (unless (or (lispy-left-p)
  3480. (lispy-right-p))
  3481. (lispy--out-backward 1))
  3482. (let* ((bnd (lispy--bounds-dwim))
  3483. (str (lispy--string-dwim bnd))
  3484. (expr (lispy--read str))
  3485. (expr-o (lispy--oneline expr t))
  3486. (expr-m (lispy--multiline-1 expr-o))
  3487. (leftp (lispy--leftp)))
  3488. (cond ((equal expr expr-m)
  3489. (unless silent
  3490. (message "No change")))
  3491. ((and (memq major-mode lispy-elisp-modes)
  3492. (not
  3493. (condition-case nil
  3494. (equal (read str)
  3495. (read (lispy--prin1-to-string
  3496. expr-m 0 major-mode)))
  3497. (error
  3498. (lispy-complain "Got an unreadable expr (probably overlay)")
  3499. t))))
  3500. (error "Got a bad transform: %S" expr-m))
  3501. (t
  3502. (delete-region (car bnd) (cdr bnd))
  3503. (lispy--insert expr-m)
  3504. (when leftp
  3505. (backward-list))))))
  3506. (defvar lispy-do-fill nil
  3507. "If t, `lispy-insert-1' will try to fill.")
  3508. (defun lispy-fill ()
  3509. "Fill current expression."
  3510. (interactive)
  3511. (if (or (lispy-left-p)
  3512. (lispy-right-p))
  3513. (let ((lispy-do-fill t))
  3514. (lispy--normalize-1))
  3515. (fill-paragraph)))
  3516. (defcustom lispy-move-after-commenting t
  3517. "When non-nil, adjust point to next sexp after commenting out a
  3518. sexp. If at last sexp in list, move out and backwards to
  3519. enclosing sexp."
  3520. :type 'boolean
  3521. :group 'lispy)
  3522. (defcustom lispy-comment-use-single-semicolon nil
  3523. "When non-nil, prefer single semicolons for comments at the
  3524. right of the source code (after lispy-right or at eol)."
  3525. :type 'boolean
  3526. :group 'lispy)
  3527. (defun lispy-comment (&optional arg)
  3528. "Comment ARG sexps."
  3529. (interactive "p")
  3530. (setq arg (or arg 1))
  3531. (if (and (> arg 1) (lispy--in-comment-p))
  3532. (let ((bnd (lispy--bounds-comment)))
  3533. (uncomment-region (car bnd) (cdr bnd)))
  3534. (lispy-dotimes arg
  3535. (let (bnd)
  3536. (cond ((region-active-p)
  3537. (comment-dwim nil)
  3538. (when (lispy--in-string-or-comment-p)
  3539. (lispy--out-backward 1)))
  3540. ((lispy--in-string-or-comment-p)
  3541. (cond ((and (eq major-mode 'emacs-lisp-mode)
  3542. (lispy-after-string-p ";;; "))
  3543. (delete-char -1)
  3544. (insert "###autoload")
  3545. (forward-char 1))
  3546. ((lispy-after-string-p ";; ")
  3547. (backward-char 1)
  3548. (insert ";")
  3549. (forward-char 1))
  3550. ((and lispy-comment-use-single-semicolon
  3551. (lispy-after-string-p "; "))
  3552. (delete-region
  3553. (point)
  3554. (progn
  3555. (skip-chars-backward "; \n")
  3556. (point)))
  3557. (insert " ;; "))
  3558. (t
  3559. (self-insert-command 1))))
  3560. ((memq (char-before) '(?\\ ?\#))
  3561. (self-insert-command 1))
  3562. ((lispy-left-p)
  3563. (setq bnd (lispy--bounds-dwim))
  3564. (when lispy-move-after-commenting
  3565. (lispy-down 1))
  3566. (comment-region (car bnd) (cdr bnd))
  3567. (when lispy-move-after-commenting
  3568. (when (or (lispy--in-string-or-comment-p)
  3569. (looking-at ";"))
  3570. (lispy--out-backward 1))))
  3571. ((lispy-right-p)
  3572. (if lispy-comment-use-single-semicolon
  3573. (progn
  3574. (unless (eolp)
  3575. (newline-and-indent)
  3576. (skip-chars-backward "\n\t "))
  3577. (comment-dwim nil)
  3578. (just-one-space))
  3579. (progn
  3580. (newline-and-indent)
  3581. (insert ";; ")
  3582. (unless (eolp)
  3583. (newline)
  3584. (lispy--reindent 1)
  3585. (skip-chars-backward "\n\t ")
  3586. (forward-char 1)))))
  3587. ((eolp)
  3588. (comment-dwim nil)
  3589. (when lispy-comment-use-single-semicolon
  3590. (just-one-space)))
  3591. ((looking-at " *[])}]")
  3592. (if lispy-comment-use-single-semicolon
  3593. (if (lispy-bolp)
  3594. (insert ";;\n")
  3595. (insert ";\n"))
  3596. (progn
  3597. (unless (lispy-bolp)
  3598. (insert "\n"))
  3599. (insert ";;\n")))
  3600. (when (lispy--out-forward 1)
  3601. (lispy--normalize-1))
  3602. (move-end-of-line 0)
  3603. (insert " "))
  3604. ((lispy-bolp)
  3605. (let ((bnd (lispy--bounds-list)))
  3606. (cond ((null bnd)
  3607. (comment-region (point) (line-end-position)))
  3608. ((<= (cdr bnd) (line-end-position))
  3609. (comment-region (point)
  3610. (1- (cdr bnd))))
  3611. (t
  3612. (let ((beg (point))
  3613. (ln-start (line-number-at-pos)))
  3614. (forward-sexp)
  3615. (while (and (= (line-number-at-pos) ln-start)
  3616. (not (eolp)))
  3617. (forward-sexp))
  3618. (comment-region beg (point))
  3619. (goto-char beg))))
  3620. (skip-chars-forward " ")))
  3621. ((setq bnd (save-excursion
  3622. (and (lispy--out-forward 1)
  3623. (point))))
  3624. (let ((pt (point)))
  3625. (if (re-search-forward "\n" bnd t)
  3626. (if (= (count-matches lispy-left pt (point))
  3627. (count-matches lispy-right pt (point)))
  3628. (progn (comment-region pt (point))
  3629. (lispy-forward 1)
  3630. (lispy-backward 1))
  3631. (goto-char pt)
  3632. (re-search-forward lispy-left bnd t)
  3633. (backward-char 1)
  3634. (forward-list 1)
  3635. (comment-region pt (point))
  3636. (lispy-forward 1)
  3637. (lispy-backward 1))
  3638. (comment-region (point) (1- bnd))
  3639. (lispy--out-backward 1))))
  3640. (t
  3641. (self-insert-command 1)))))))
  3642. (defun lispy--quote-string (str &optional quote-newlines)
  3643. "Quote the quotes and backslashes in STR.
  3644. Quote the newlines if QUOTE-NEWLINES is t."
  3645. (setq str (replace-regexp-in-string "\\\\" "\\\\\\\\" str))
  3646. (setq str (replace-regexp-in-string "\"" "\\\\\"" str))
  3647. (if quote-newlines
  3648. (replace-regexp-in-string "\n" "\\\\n" str)
  3649. str))
  3650. (defun lispy-stringify (&optional arg)
  3651. "Transform current sexp into a string.
  3652. Quote newlines if ARG isn't 1."
  3653. (interactive "p")
  3654. (setq arg (or arg 1))
  3655. (let* ((bnd (lispy--bounds-dwim))
  3656. (pt (point))
  3657. (str-1 (buffer-substring-no-properties (car bnd) pt))
  3658. (str-2 (buffer-substring-no-properties pt (cdr bnd)))
  3659. (regionp (region-active-p))
  3660. (leftp (lispy--leftp))
  3661. deactivate-mark)
  3662. (when (and regionp leftp)
  3663. (exchange-point-and-mark))
  3664. (if (lispy--in-string-p)
  3665. (if regionp
  3666. (progn
  3667. (insert "\\\"")
  3668. (exchange-point-and-mark)
  3669. (insert "\\\"")
  3670. (backward-char 2)
  3671. (unless leftp
  3672. (exchange-point-and-mark)))
  3673. (lispy-complain "can't do anything useful here"))
  3674. (deactivate-mark)
  3675. (setq str-1 (lispy--quote-string str-1 (/= arg 1)))
  3676. (setq str-2 (lispy--quote-string str-2 (/= arg 1)))
  3677. (delete-region (car bnd) (cdr bnd))
  3678. (insert "\"" str-1)
  3679. (save-excursion (insert str-2 "\""))
  3680. (when regionp
  3681. (unless (looking-at "\"")
  3682. (backward-char 1))
  3683. (lispy-mark-symbol)
  3684. (if (and leftp (= (point) (region-end)))
  3685. (exchange-point-and-mark))))))
  3686. (defun lispy-stringify-oneline ()
  3687. "Call `lispy-stringify' with a non-1 argument to quote newlines."
  3688. (interactive)
  3689. (lispy-stringify 0))
  3690. (defun lispy-unstringify ()
  3691. "Unquote string at point."
  3692. (interactive)
  3693. (if (region-active-p)
  3694. (if (lispy--string-markedp)
  3695. (let (deactivate-mark
  3696. (str (lispy--string-dwim))
  3697. (leftp (lispy--leftp)))
  3698. (delete-active-region)
  3699. (set-mark (point))
  3700. (insert (read str))
  3701. (when leftp
  3702. (lispy-different)))
  3703. (lispy-complain "the current region isn't a string"))
  3704. (let* ((bnd (lispy--bounds-string))
  3705. (str (lispy--string-dwim bnd))
  3706. (str-1 (concat (substring str 0 (- (point) (car bnd))) "\""))
  3707. (offset (length (read str-1))))
  3708. (delete-region (car bnd) (cdr bnd))
  3709. (save-excursion (insert (read str)))
  3710. (forward-char offset))))
  3711. (defvar lispy-teleport-global nil
  3712. "When non-nil, `lispy-teleport' will consider all open parens in window.
  3713. Otherwise, only parens within the current defun are considered.
  3714. When you press \"t\" in `lispy-teleport', this will be bound to t temporarily.")
  3715. (defmacro lispy-quit-and-run (&rest body)
  3716. "Quit the minibuffer and run BODY afterwards."
  3717. `(progn
  3718. (put 'quit 'error-message "")
  3719. (run-at-time nil nil
  3720. (lambda ()
  3721. (put 'quit 'error-message "Quit")
  3722. ,@body))
  3723. (minibuffer-keyboard-quit)))
  3724. (defun lispy-teleport (arg)
  3725. "Move ARG sexps into a sexp determined by `lispy-ace-paren'."
  3726. (interactive "p")
  3727. (let ((beg (save-excursion
  3728. (skip-chars-backward "'")
  3729. (point)))
  3730. end endp regionp
  3731. deactivate-mark)
  3732. (cond ((region-active-p)
  3733. (if (= (point) (region-end))
  3734. (progn
  3735. (setq end (region-beginning))
  3736. (setq endp t))
  3737. (setq end (region-end)))
  3738. (setq regionp t))
  3739. ((lispy-left-p)
  3740. (save-excursion
  3741. (unless (lispy-dotimes arg
  3742. (forward-list 1))
  3743. (error "Unexpected"))
  3744. (setq end (point))))
  3745. ((lispy-right-p)
  3746. (save-excursion
  3747. (setq endp t)
  3748. (unless (lispy-dotimes arg
  3749. (backward-list arg))
  3750. (error "Unexpected"))
  3751. (setq end (point))))
  3752. (t
  3753. (error "Unexpected")))
  3754. (let* ((lispy-avy-keys (delete ?t lispy-avy-keys))
  3755. (avy-handler-function
  3756. (lambda (x)
  3757. (if (eq x ?t)
  3758. (progn
  3759. (avy--done)
  3760. (lispy-quit-and-run
  3761. (let ((lispy-teleport-global t))
  3762. (when regionp
  3763. (activate-mark))
  3764. (lispy-teleport arg))))
  3765. (avy-handler-default x))))
  3766. (res (lispy-ace-paren
  3767. (when lispy-teleport-global
  3768. 2))))
  3769. (cond ((eq res t)
  3770. (when regionp
  3771. (lispy--mark (cons end beg))))
  3772. (t
  3773. (forward-char 1)
  3774. (unless (looking-at "(")
  3775. (ignore-errors
  3776. (forward-sexp)))
  3777. (backward-char 1)
  3778. (lispy--teleport beg end endp regionp))))))
  3779. ;;* Locals: tags
  3780. (defun lispy-goto (&optional arg)
  3781. "Jump to symbol within files in current directory.
  3782. When ARG isn't nil, call `lispy-goto-projectile' instead."
  3783. (interactive "p")
  3784. (deactivate-mark)
  3785. (let ((lispy-force-reparse (eq arg 2))
  3786. (fun (if (memq arg '(1 2))
  3787. #'lispy--fetch-tags
  3788. #'lispy--fetch-tags-projectile)))
  3789. (lispy--goto fun)))
  3790. (defun lispy-goto-recursive ()
  3791. "Jump to symbol within files in current directory and its subdiretories."
  3792. (interactive)
  3793. (deactivate-mark)
  3794. (let ((candidates (lispy--fetch-tags-recursive)))
  3795. (lispy--select-candidate
  3796. (if (> (length candidates) 30000)
  3797. candidates
  3798. (mapcar #'lispy--format-tag-line candidates))
  3799. #'lispy--action-jump)))
  3800. (defun lispy-goto-local (&optional arg)
  3801. "Jump to symbol within current file.
  3802. When ARG is non-nil, force a reparse."
  3803. (interactive "P")
  3804. (deactivate-mark)
  3805. (let ((lispy-force-reparse arg))
  3806. (lispy--select-candidate
  3807. (mapcar #'lispy--format-tag-line
  3808. (lispy--fetch-tags (list (buffer-file-name))))
  3809. #'lispy--action-jump)))
  3810. (defun lispy-goto-elisp-commands (&optional arg)
  3811. "Jump to Elisp commands within current file.
  3812. When ARG is non-nil, force a reparse."
  3813. (interactive "P")
  3814. (deactivate-mark)
  3815. (let ((lispy-force-reparse arg))
  3816. (lispy--fetch-tags (list (buffer-file-name)))
  3817. (let ((struct (gethash (buffer-file-name) lispy-db)))
  3818. (lispy--select-candidate
  3819. (mapcar #'lispy--format-tag-line
  3820. (delq nil
  3821. (cl-mapcar
  3822. (lambda (tag pretty-tag)
  3823. (when (semantic-tag-get-attribute tag :user-visible-flag)
  3824. pretty-tag))
  3825. (lispy-dbfile-plain-tags struct)
  3826. (lispy-dbfile-tags struct))))
  3827. #'lispy--action-jump))))
  3828. (defun lispy-goto-projectile ()
  3829. "Jump to symbol within files in (`projectile-project-root')."
  3830. (interactive)
  3831. (deactivate-mark)
  3832. (lispy--goto 'lispy--fetch-tags-projectile))
  3833. (defun lispy-goto-def-down (arg)
  3834. "Jump to definition of ARGth element of current list."
  3835. (interactive "p")
  3836. (let* ((expr (read (lispy--string-dwim)))
  3837. (n (length expr)))
  3838. (if (>= arg n)
  3839. (error "Out of range: %s/%s" arg n)
  3840. (let ((elt (nth arg expr)))
  3841. (while (consp elt)
  3842. (if (eq (car elt) 'quote)
  3843. (setq elt (cadr elt))
  3844. (setq elt (car elt))))
  3845. (if elt
  3846. (lispy-goto-symbol elt)
  3847. (error "No symbol found"))))))
  3848. (defun lispy-goto-def-ace (arg)
  3849. "Jump to definition of selected element of current sexp.
  3850. Sexp is obtained by exiting list ARG times."
  3851. (interactive "p")
  3852. (lispy-ace-symbol arg)
  3853. (call-interactively 'lispy-goto-symbol))
  3854. (when (version< emacs-version "25.1")
  3855. (eval-after-load 'etags
  3856. '(add-to-list 'byte-compile-not-obsolete-vars 'find-tag-marker-ring)))
  3857. (defvar lispy-goto-symbol-alist
  3858. '((clojure-mode lispy-goto-symbol-clojure le-clojure)
  3859. (clojurescript-mode lispy-goto-symbol-clojurescript le-clojure)
  3860. (scheme-mode lispy-goto-symbol-scheme le-scheme)
  3861. (lisp-mode lispy-goto-symbol-lisp le-lisp)
  3862. (python-mode lispy-goto-symbol-python le-python))
  3863. "An alist of `major-mode' to function for jumping to symbol.
  3864. Each element is: (MAJOR-MODE FUNC &optional LIB).
  3865. FUNC should take a string argument - a symbol to jump to.
  3866. When LIB is non-nil, `require' it prior to calling FUNC.")
  3867. (defun lispy-goto-symbol (symbol)
  3868. "Go to definition of SYMBOL.
  3869. SYMBOL is a string."
  3870. (interactive (list (or (thing-at-point 'symbol t)
  3871. (lispy--current-function))))
  3872. (deactivate-mark)
  3873. (with-no-warnings
  3874. (ring-insert find-tag-marker-ring (point-marker)))
  3875. (if (memq major-mode lispy-elisp-modes)
  3876. (lispy-goto-symbol-elisp symbol)
  3877. (let ((handler (cdr (assoc major-mode lispy-goto-symbol-alist)))
  3878. lib)
  3879. (if (null handler)
  3880. (error "no handler for %S in `lispy-goto-symbol-alist'" major-mode)
  3881. (when (setq lib (cadr handler))
  3882. (require lib))
  3883. (funcall (car handler) symbol))))
  3884. ;; in case it's hidden in an outline
  3885. (lispy--ensure-visible))
  3886. (defun lispy-goto-symbol-elisp (symbol)
  3887. "Goto definition of an Elisp SYMBOL."
  3888. (let (rsymbol)
  3889. (if (null (setq symbol (intern-soft symbol)))
  3890. (error "symbol not interned")
  3891. (cond ((and current-prefix-arg (boundp symbol))
  3892. (find-variable symbol))
  3893. ((fboundp symbol)
  3894. (condition-case nil
  3895. (find-function symbol)
  3896. (error
  3897. (goto-char (point-min))
  3898. (if (re-search-forward (format "^(def.*%S" symbol) nil t)
  3899. (move-beginning-of-line 1)
  3900. (lispy-complain
  3901. (format "Don't know where `%S' is defined" symbol))
  3902. (pop-tag-mark)))))
  3903. ((boundp symbol)
  3904. (find-variable symbol))
  3905. ((or (featurep symbol)
  3906. (locate-library
  3907. (prin1-to-string symbol)))
  3908. (find-library (prin1-to-string symbol)))
  3909. ((setq rsymbol
  3910. (cl-find-if
  3911. `(lambda (x)
  3912. (equal (car x)
  3913. ,(symbol-name symbol)))
  3914. (lispy--fetch-this-file-tags)))
  3915. (goto-char (aref (nth 4 rsymbol) 0)))
  3916. (t
  3917. (error "Couldn't find definition of %s"
  3918. symbol))))))
  3919. ;;* Locals: dialect-related
  3920. (defcustom lispy-eval-display-style 'message
  3921. "Choose a function to display the eval result."
  3922. :type '(choice
  3923. (const :tag "message" message)
  3924. (const :tag "overlay" overlay)))
  3925. (defvar cider-eval-result-duration)
  3926. (defvar lispy-eval-alist
  3927. '((python-mode lispy-eval-python le-python)
  3928. (julia-mode lispy-eval-julia le-julia)
  3929. (clojure-mode lispy-eval-clojure le-clojure)))
  3930. (defvar lispy-eval-error nil
  3931. "The eval function may set this when there's an error.")
  3932. (declare-function cider--display-interactive-eval-result "ext:cider-overlays")
  3933. (defun lispy-eval (arg)
  3934. "Eval last sexp.
  3935. When ARG is 2, insert the result as a comment."
  3936. (interactive "p")
  3937. (cond ((eq arg 2)
  3938. (lispy-eval-and-comment))
  3939. ((and (looking-at lispy-outline)
  3940. (looking-at lispy-outline-header))
  3941. (lispy-eval-outline))
  3942. (t
  3943. (let ((handler (cdr (assoc major-mode lispy-eval-alist)))
  3944. result)
  3945. (if handler
  3946. (progn
  3947. (when (cadr handler)
  3948. (require (cadr handler)))
  3949. (setq result (funcall (car handler) (eq arg 3))))
  3950. (setq result (lispy--eval-default)))
  3951. (cond ((eq lispy-eval-display-style 'message)
  3952. (lispy-message result))
  3953. ((or (fboundp 'cider--display-interactive-eval-result)
  3954. (require 'cider nil t))
  3955. (cider--display-interactive-eval-result result
  3956. (cdr (lispy--bounds-dwim))))
  3957. (t
  3958. (error "Please install CIDER 0.10 to display overlay")))))))
  3959. (defun lispy--eval-default ()
  3960. (save-excursion
  3961. (unless (or (lispy-right-p) (region-active-p))
  3962. (lispy-forward 1))
  3963. (replace-regexp-in-string
  3964. "%" "%%" (lispy--eval (lispy--string-dwim)))))
  3965. (defun lispy-forward-outline ()
  3966. (let ((pt (point)))
  3967. (outline-next-heading)
  3968. (if (looking-at lispy-outline)
  3969. (when (> (point) pt)
  3970. (point))
  3971. (goto-char pt)
  3972. nil)))
  3973. (defun lispy-eval-current-outline ()
  3974. (interactive)
  3975. (save-excursion
  3976. (outline-back-to-heading)
  3977. (lispy-eval-outline)
  3978. (let ((inhibit-message t))
  3979. (save-buffer))))
  3980. (defun lispy-add-outline-title ()
  3981. (save-excursion
  3982. (lispy-outline-prev 1)
  3983. (let ((comment (if (eq major-mode 'python-mode)
  3984. "#"
  3985. ";;")))
  3986. (if (looking-at (format "\\(%s\\*+ ?:$\\)" comment))
  3987. (match-string-no-properties 1)
  3988. (concat comment (make-string (1+ (funcall outline-level)) ?*) " :")))))
  3989. (defun lispy-insert-outline-below ()
  3990. (interactive)
  3991. "Add an unnamed notebook outline at point."
  3992. (cond
  3993. ((and (bolp) (eolp)))
  3994. ((lispy-outline-next 1)
  3995. (insert "\n\n")
  3996. (backward-char 2))
  3997. (t
  3998. (goto-char (point-max))
  3999. (unless (bolp)
  4000. (insert "\n"))))
  4001. (let ((start (point))
  4002. (title (lispy-add-outline-title)))
  4003. (skip-chars-backward "\n")
  4004. (delete-region (point) start)
  4005. (insert "\n\n" title "\n")
  4006. (let ((inhibit-message t))
  4007. (save-buffer))))
  4008. (defun lispy-insert-outline-left ()
  4009. (interactive)
  4010. "Add a named notebook outline at point."
  4011. (lispy-insert-outline-below)
  4012. (delete-char -4)
  4013. (insert " "))
  4014. (defun lispy-eval-outline ()
  4015. "Evaluate the current outline and its children.
  4016. Return the result of the last evaluation as a string."
  4017. (let ((lvl (lispy-outline-level))
  4018. ans)
  4019. (lispy--remember)
  4020. (setq ans (lispy-eval-single-outline))
  4021. (while (and (lispy-forward-outline)
  4022. (> (funcall outline-level) lvl))
  4023. (setq ans (lispy-eval-single-outline)))
  4024. ans))
  4025. (defun lispy--eval-bounds-outline ()
  4026. (let* ((beg (1+ (line-end-position)))
  4027. bnd
  4028. (end
  4029. (save-excursion
  4030. (forward-char)
  4031. (if (re-search-forward (concat "^" outline-regexp) nil t)
  4032. (progn
  4033. (goto-char (match-beginning 0)))
  4034. (goto-char (point-max)))
  4035. (skip-chars-backward "\n")
  4036. (while (and
  4037. (> (point) beg)
  4038. (setq bnd (lispy--bounds-comment)))
  4039. (goto-char (car bnd))
  4040. (skip-chars-backward "\n "))
  4041. (point))))
  4042. (if (> beg end)
  4043. (cons beg beg)
  4044. (cons beg end))))
  4045. (defun lispy-eval-single-outline ()
  4046. (let* ((bnd (lispy--eval-bounds-outline))
  4047. (res (lispy--eval
  4048. (lispy--string-dwim bnd))))
  4049. (when (and (null res)
  4050. (eq major-mode 'python-mode)
  4051. (string-match "^\\(.*Error:.*\\)" lispy-eval-error))
  4052. (setq res (match-string-no-properties 1 lispy-eval-error)))
  4053. (cond ((null res)
  4054. (lispy-message lispy-eval-error))
  4055. ((equal res "")
  4056. (message "(ok)"))
  4057. ((= ?: (char-before (line-end-position)))
  4058. (goto-char (cdr bnd))
  4059. (save-restriction
  4060. (narrow-to-region
  4061. (point)
  4062. (if (re-search-forward outline-regexp nil t)
  4063. (1- (match-beginning 0))
  4064. (point-max)))
  4065. (goto-char (point-min))
  4066. (unless (looking-at (concat "\n" lispy-outline-header))
  4067. (newline))
  4068. (lispy--insert-eval-result res))
  4069. (goto-char (car bnd))
  4070. res)
  4071. (t
  4072. (message (replace-regexp-in-string "%" "%%" res))))))
  4073. (defun lispy-message (str &optional popup)
  4074. "Display STR in the echo area.
  4075. If STR is too large, pop it to a buffer instead."
  4076. (if (or
  4077. popup
  4078. (> (length str) 4000)
  4079. (> (cl-count ?\n str)
  4080. (or
  4081. 14
  4082. (* (window-height (frame-root-window)) max-mini-window-height))))
  4083. (with-current-buffer (pop-to-buffer "*lispy-message*")
  4084. (special-mode)
  4085. (let ((inhibit-read-only t))
  4086. (delete-region (point-min) (point-max))
  4087. (insert str)
  4088. (goto-char (point-min)))
  4089. str)
  4090. (condition-case nil
  4091. (message str)
  4092. (error (message (replace-regexp-in-string "%" "%%" str))))))
  4093. (defun lispy-eval-and-insert ()
  4094. "Eval last sexp and insert the result."
  4095. (interactive)
  4096. (cl-labels
  4097. ((doit ()
  4098. (cond ((region-active-p)
  4099. (when (= (point) (region-beginning))
  4100. (exchange-point-and-mark)))
  4101. ((lispy-right-p))
  4102. (t
  4103. (lispy-forward 1)))
  4104. (let ((str (lispy--eval (lispy--string-dwim))))
  4105. (newline-and-indent)
  4106. (insert str)
  4107. (when (and (lispy-right-p) (lispy--major-mode-lisp-p))
  4108. (lispy-alt-multiline t)))))
  4109. (if (lispy-left-p)
  4110. (save-excursion
  4111. (doit))
  4112. (doit))))
  4113. (defun lispy-eval-and-comment ()
  4114. "Eval last sexp and insert the result as a comment."
  4115. (interactive)
  4116. (let* ((eval-str (if (eq major-mode 'python-mode)
  4117. (lispy-eval-python-str)
  4118. (lispy--string-dwim)))
  4119. (str (lispy--eval eval-str))
  4120. re-bnd)
  4121. (save-excursion
  4122. (cond ((region-active-p)
  4123. (setq re-bnd (cons (region-beginning)
  4124. (region-end)))
  4125. (when (= (point) (region-beginning))
  4126. (exchange-point-and-mark)))
  4127. ((eq major-mode 'python-mode)
  4128. (let ((bnd (lispy-eval-python-bnd)))
  4129. (goto-char (cdr bnd))
  4130. (unless (looking-at "\n *#")
  4131. (newline)
  4132. (insert
  4133. (save-excursion
  4134. (goto-char (car bnd))
  4135. (beginning-of-line)
  4136. (buffer-substring
  4137. (point)
  4138. (progn
  4139. (back-to-indentation)
  4140. (point))))))))
  4141. ((lispy-left-p)
  4142. (lispy-different)))
  4143. (lispy--insert-eval-result (or str lispy-eval-error))
  4144. (unless (eolp)
  4145. (newline)))
  4146. (unless (eq major-mode 'python-mode)
  4147. (lispy--reindent 1))
  4148. (when re-bnd
  4149. (lispy--mark re-bnd))))
  4150. (defun lispy--major-mode-lisp-p ()
  4151. (memq major-mode (append lispy-elisp-modes
  4152. lispy-clojure-modes
  4153. '(scheme-mode lisp-mode))))
  4154. (defun lispy--insert-eval-result (str)
  4155. (let (bound)
  4156. (if (not (looking-at
  4157. (format "\n *\\(%s\\) ?=>" lispy-outline-header)))
  4158. (unless (lispy-bolp)
  4159. (newline-and-indent))
  4160. (goto-char (1+ (match-beginning 1)))
  4161. (setq bound (lispy--bounds-comment))
  4162. (delete-region (car bound) (cdr bound)))
  4163. (save-restriction
  4164. (let ((indent (buffer-substring-no-properties
  4165. (line-beginning-position) (point))))
  4166. (delete-region (line-beginning-position) (point))
  4167. (narrow-to-region (point) (point))
  4168. (insert str)
  4169. (delete-trailing-whitespace)
  4170. (while (lispy-after-string-p "\n")
  4171. (delete-char -1))
  4172. (save-excursion
  4173. (cond ((and (lispy-right-p)
  4174. (lispy--major-mode-lisp-p))
  4175. (when (> (current-column) 80)
  4176. (ignore-errors
  4177. (lispy-alt-multiline t)))
  4178. (goto-char (point-min))
  4179. (insert "=>" (if (> (length str) 70) "\n" " ")))
  4180. ((and (lispy-right-p)
  4181. (eq major-mode 'python-mode))
  4182. (cond ((< (current-column) 100))
  4183. ((looking-back "[]}]" (line-beginning-position))
  4184. (let ((cnt (if (string= "]" (match-string 0))
  4185. -1
  4186. -2))
  4187. (beg (save-excursion
  4188. (forward-list -1)
  4189. (1+ (point)))))
  4190. (backward-char 1)
  4191. (ignore-errors
  4192. (while (> (point) beg)
  4193. (if (lispy-after-string-p ">")
  4194. (progn
  4195. (re-search-backward "<" nil t)
  4196. (newline-and-indent)
  4197. (backward-char 3))
  4198. (forward-sexp cnt)
  4199. (when (> (point) beg)
  4200. (newline-and-indent))))))
  4201. (goto-char (point-max)))
  4202. ((and (looking-back "[])]\\]" (line-beginning-position))
  4203. (eq (point-min)
  4204. (save-excursion
  4205. (forward-list -1))))
  4206. (let ((beg (1+ (point-min))))
  4207. (backward-char 1)
  4208. (while (> (point) beg)
  4209. (forward-sexp -1)
  4210. (when (> (point) beg)
  4211. (newline-and-indent)))))
  4212. (t
  4213. (fill-paragraph)))
  4214. (let ((ln (line-number-at-pos)))
  4215. (goto-char (point-min))
  4216. (insert "=>")
  4217. (insert (if (= ln 1) " " "\n"))))
  4218. (t
  4219. (goto-char (point-min))
  4220. (insert "=> ")
  4221. (forward-line 1)
  4222. (while (< (point) (point-max))
  4223. (unless (eolp)
  4224. (insert " "))
  4225. (forward-line 1)))))
  4226. (lispy-comment-region (point-min) (point-max))
  4227. (goto-char (point-min))
  4228. (while (< (point) (point-max))
  4229. (insert indent)
  4230. (beginning-of-line 2))))))
  4231. (defun lispy-comment-region (beg end)
  4232. "Comment the region between BEG and END.
  4233. Unlike `comment-region', ensure a contiguous comment."
  4234. (interactive "r")
  4235. (goto-char beg)
  4236. (beginning-of-line)
  4237. (let ((elen (length lispy-outline-header)))
  4238. (while (< (point) end)
  4239. (insert lispy-outline-header)
  4240. (cl-incf end elen)
  4241. (unless (eolp)
  4242. (insert " ")
  4243. (cl-incf end 1))
  4244. (beginning-of-line 2))))
  4245. (defun lispy-eval-and-replace ()
  4246. "Eval last sexp and replace it with the result."
  4247. (interactive)
  4248. (let* ((leftp (lispy--leftp))
  4249. (bnd (lispy--bounds-dwim))
  4250. (str (lispy--string-dwim bnd))
  4251. (res (lispy--eval str)))
  4252. (delete-region (car bnd) (cdr bnd))
  4253. (deactivate-mark)
  4254. (insert res)
  4255. (unless (or (lispy-left-p)
  4256. (lispy-right-p)
  4257. (member major-mode '(python-mode julia-mode)))
  4258. (lispy--out-backward 1))
  4259. (when (and leftp (lispy-right-p))
  4260. (lispy-different))))
  4261. (defconst lispy--eval-cond-msg
  4262. (format "%s: nil" (propertize "cond" 'face 'font-lock-keyword-face))
  4263. "Message to echo when the current `cond' branch is nil.")
  4264. (defvar lispy-eval-other--window nil
  4265. "Target window for `lispy-eval-other-window'.")
  4266. (defvar lispy-eval-other--buffer nil
  4267. "Target buffer for `lispy-eval-other-window'.")
  4268. (defvar lispy-eval-other--cfg nil
  4269. "Last window configuration for `lispy-eval-other-window'.")
  4270. (defun lispy-eval--last-live-p ()
  4271. "Return t if the last eval window is still live with same buffer."
  4272. (and (window-live-p
  4273. lispy-eval-other--window)
  4274. (equal (window-buffer
  4275. lispy-eval-other--window)
  4276. lispy-eval-other--buffer)
  4277. (equal (cl-mapcan #'window-list (frame-list))
  4278. lispy-eval-other--cfg)))
  4279. (defvar lispy--eval-sym nil
  4280. "Last set `dolist' sym.")
  4281. (defvar lispy--eval-data nil
  4282. "List data for a `dolist' sym.")
  4283. (declare-function aw-select "ext:ace-window")
  4284. (defvar aw-dispatch-always)
  4285. (defun lispy--dolist-item-expr (expr)
  4286. "Produce an eval expression for dolist-type EXPR.
  4287. EXPR is (SYM LST).
  4288. SYM will take on each value of LST with each eval."
  4289. (let ((sym (car expr)))
  4290. (unless (eq sym lispy--eval-sym)
  4291. (setq lispy--eval-sym sym)
  4292. (setq lispy--eval-data
  4293. (lispy--eval-elisp-form (cadr expr) lexical-binding)))
  4294. (if lispy--eval-data
  4295. (let* ((popped (pop lispy--eval-data))
  4296. (popped (if (symbolp popped)
  4297. `(quote ,popped)
  4298. popped)))
  4299. (set sym popped))
  4300. (setq lispy--eval-data
  4301. (lispy--eval-elisp-form (cadr expr) lexical-binding))
  4302. (set sym nil))))
  4303. (defun lispy--mapcar-item-expr (lmda lst)
  4304. "Produce an eval expression for mapcar-type LMDA EXPR.
  4305. LMDA is (lambda (SYM) ...).
  4306. SYM will take on each value of LST with each eval."
  4307. (let ((sym (car lmda)))
  4308. (when (eq sym 'closure)
  4309. (setq sym (caar (cddr lmda))))
  4310. (unless (eq sym lispy--eval-sym)
  4311. (setq lispy--eval-sym sym)
  4312. (setq lispy--eval-data lst))
  4313. (if lispy--eval-data
  4314. (let* ((popped (pop lispy--eval-data))
  4315. (popped (if (symbolp popped)
  4316. `(quote ,popped)
  4317. popped)))
  4318. (set sym popped))
  4319. (setq lispy--eval-data lst)
  4320. (set sym nil))))
  4321. (defun lispy-eval-other-window (&optional arg)
  4322. "Eval current expression in the context of other window.
  4323. In case the point is on a let-bound variable, add a `setq'.
  4324. When ARG is non-nil, force select the window."
  4325. (interactive "P")
  4326. (require 'ace-window)
  4327. (let* ((expr (save-mark-and-excursion (lispy--setq-expression)))
  4328. (aw-dispatch-always nil)
  4329. (target-window
  4330. (cond ((not (memq major-mode lispy-elisp-modes))
  4331. (selected-window))
  4332. ((and (null arg) (lispy-eval--last-live-p))
  4333. lispy-eval-other--window)
  4334. ((setq lispy-eval-other--window
  4335. (aw-select " Ace - Eval in Window"))
  4336. (setq lispy-eval-other--buffer
  4337. (window-buffer lispy-eval-other--window))
  4338. (setq lispy-eval-other--cfg
  4339. (cl-mapcan #'window-list (frame-list)))
  4340. lispy-eval-other--window)
  4341. (t
  4342. (setq lispy-eval-other--buffer nil)
  4343. (setq lispy-eval-other--cfg nil)
  4344. (selected-window))))
  4345. res)
  4346. (cond ((memq major-mode '(lisp-mode scheme-mode))
  4347. (lispy-message (lispy--eval (prin1-to-string expr))))
  4348. ((memq major-mode lispy-clojure-modes)
  4349. (lispy-eval 1))
  4350. (t
  4351. (with-selected-window target-window
  4352. (setq res (lispy--eval-elisp-form expr lexical-binding)))
  4353. (cond ((equal res lispy--eval-cond-msg)
  4354. (lispy-message res))
  4355. ((and (fboundp 'object-p) (object-p res))
  4356. (message "(eieio object length %d)" (length res)))
  4357. ((and (memq major-mode lispy-elisp-modes)
  4358. (consp res)
  4359. (numberp (car res))
  4360. (numberp (cdr res)))
  4361. (lispy-message
  4362. (format "%S\n%s" res
  4363. (with-selected-window target-window
  4364. (lispy--string-dwim res)))))
  4365. (t
  4366. (lispy-message
  4367. (replace-regexp-in-string "%" "%%"
  4368. (format "%S" res)))))))))
  4369. (defun lispy-follow ()
  4370. "Follow to `lispy--current-function'."
  4371. (interactive)
  4372. (lispy-goto-symbol (lispy--current-function)))
  4373. (declare-function cider-doc-lookup "ext:cider-doc")
  4374. (defun lispy-describe ()
  4375. "Display documentation for `lispy--current-function'."
  4376. (interactive)
  4377. (cond ((memq major-mode lispy-elisp-modes)
  4378. (let ((symbol (intern-soft (lispy--current-function))))
  4379. (cond ((fboundp symbol)
  4380. (describe-function symbol))
  4381. ((boundp symbol)
  4382. (describe-variable symbol)))))
  4383. ((memq major-mode lispy-clojure-modes)
  4384. (require 'cider-doc)
  4385. (cider-doc-lookup (lispy--current-function)))
  4386. (t
  4387. (lispy-complain
  4388. (format "%s isn't supported currently" major-mode)))))
  4389. (defvar lispy-bof-last-point 1)
  4390. (defun lispy-pam-store (sym)
  4391. "Store point and mark to SYM."
  4392. (if (region-active-p)
  4393. (progn
  4394. (set sym (cons (point) (mark)))
  4395. (deactivate-mark))
  4396. (set sym (point))))
  4397. (defun lispy-pam-restore (sym)
  4398. "Restore point and mark from FROM."
  4399. (let ((val (symbol-value sym)))
  4400. (if (consp val)
  4401. (progn
  4402. (goto-char (car val))
  4403. (set-mark (cdr val)))
  4404. (goto-char val))))
  4405. (defun lispy-beginning-of-defun (&optional arg)
  4406. "Forward to `beginning-of-defun' with ARG. Deactivate region.
  4407. When called twice in a row, restore point and mark."
  4408. (interactive "p")
  4409. (cond ((and (called-interactively-p 'any)
  4410. (looking-at "^(")
  4411. (let ((pt (if (consp lispy-bof-last-point)
  4412. (car lispy-bof-last-point)
  4413. lispy-bof-last-point)))
  4414. (and
  4415. (> pt (point))
  4416. (<= pt (save-excursion (forward-list) (point))))))
  4417. (lispy-pam-restore 'lispy-bof-last-point))
  4418. ((looking-at "^("))
  4419. (t
  4420. (lispy-pam-store 'lispy-bof-last-point)
  4421. (beginning-of-defun arg))))
  4422. ;;* Locals: avy-jump
  4423. (declare-function avy--regex-candidates "avy")
  4424. (declare-function avy-process "avy")
  4425. (declare-function avy--overlay-post "avy")
  4426. (defun lispy-ace-char ()
  4427. "Visually select a char within the current defun."
  4428. (interactive)
  4429. (let ((avy-keys lispy-avy-keys))
  4430. (avy-with lispy-ace-char
  4431. (lispy--avy-do
  4432. (string (read-char "Char: "))
  4433. (save-excursion
  4434. ;; `beginning-of-defun' won't work, since it can change sexp
  4435. (lispy--out-backward 50)
  4436. (lispy--bounds-dwim))
  4437. (lambda () t)
  4438. lispy-avy-style-char))))
  4439. (defun lispy-ace-paren (&optional arg)
  4440. "Jump to an open paren within the current defun.
  4441. ARG can extend the bounds beyond the current defun."
  4442. (interactive "p")
  4443. (setq arg (or arg 1))
  4444. (lispy--remember)
  4445. (deactivate-mark)
  4446. (let ((avy-keys lispy-avy-keys)
  4447. (bnd (if (eq arg 1)
  4448. (save-excursion
  4449. (lispy--out-backward 50)
  4450. (lispy--bounds-dwim))
  4451. (cons (window-start)
  4452. (window-end nil t)))))
  4453. (avy-with lispy-ace-paren
  4454. (lispy--avy-do
  4455. lispy-left
  4456. bnd
  4457. (lambda () (not (lispy--in-string-or-comment-p)))
  4458. lispy-avy-style-paren))))
  4459. (defun lispy-ace-symbol (arg)
  4460. "Jump to a symbol withing the current sexp and mark it.
  4461. Sexp is obtained by exiting the list ARG times."
  4462. (interactive "p")
  4463. (lispy--out-forward
  4464. (if (region-active-p)
  4465. (progn (deactivate-mark) arg)
  4466. (1- arg)))
  4467. (let ((avy-keys lispy-avy-keys)
  4468. res)
  4469. (avy-with lispy-ace-symbol
  4470. (let ((avy--overlay-offset (if (eq lispy-avy-style-symbol 'at) -1 0)))
  4471. (setq res (lispy--avy-do
  4472. "[([{ ]\\(?:\\sw\\|\\s_\\|[\"'`#~,@]\\)"
  4473. (lispy--bounds-dwim)
  4474. (lambda ()
  4475. (not (save-excursion
  4476. (forward-char -1)
  4477. (lispy--in-string-or-comment-p))))
  4478. lispy-avy-style-symbol))))
  4479. (unless (eq res t)
  4480. (unless (or (eq (char-after) ?\")
  4481. (looking-at ". "))
  4482. (forward-char 1))
  4483. (lispy-mark-symbol))))
  4484. (defun lispy-ace-subword (arg)
  4485. "Mark sub-word within a sexp.
  4486. Sexp is obtained by exiting list ARG times."
  4487. (interactive "p")
  4488. (if (and (region-active-p)
  4489. (string-match "\\`\\(\\sw+\\)\\s_"
  4490. (lispy--string-dwim)))
  4491. (lispy--mark (cons (region-beginning)
  4492. (+ (region-beginning) (match-end 1))))
  4493. (lispy--out-forward
  4494. (if (region-active-p)
  4495. (progn (deactivate-mark) arg)
  4496. (1- arg)))
  4497. (let* ((avy-keys lispy-avy-keys)
  4498. (res (avy-with 'lispy-ace-subword
  4499. (lispy--avy-do
  4500. "[([{ -/]\\(?:\\sw\\|\\s_\\|\\s(\\|[\"'`#]\\)"
  4501. (lispy--bounds-dwim)
  4502. (lambda () (or (not (lispy--in-string-or-comment-p))
  4503. (lispy-looking-back ".\"")))
  4504. lispy-avy-style-symbol))))
  4505. (unless (eq res t)
  4506. (skip-chars-forward "-([{ `'#")
  4507. (mark-word)))))
  4508. (defun lispy--avy-do (regex bnd filter style)
  4509. "Visually select a match to REGEX within BND.
  4510. Filter out the matches that don't match FILTER.
  4511. Use STYLE function to update the overlays."
  4512. (lispy--recenter-bounds bnd)
  4513. (let* ((avy-all-windows nil)
  4514. (cands (avy--regex-candidates
  4515. regex
  4516. (car bnd) (cdr bnd)
  4517. filter)))
  4518. (dolist (x cands)
  4519. (when (> (- (cdar x) (caar x)) 1)
  4520. (cl-incf (caar x))))
  4521. (avy-process
  4522. cands
  4523. (cl-case style
  4524. (pre #'avy--overlay-pre)
  4525. (at #'avy--overlay-at)
  4526. (at-full #'avy--overlay-at-full)
  4527. (post #'avy--overlay-post)))))
  4528. (defun lispy-ace-symbol-replace (arg)
  4529. "Jump to a symbol withing the current sexp and delete it.
  4530. Sexp is obtained by exiting the list ARG times."
  4531. (interactive "p")
  4532. (lispy-ace-symbol arg)
  4533. (when (region-active-p)
  4534. (lispy-delete 1)))
  4535. ;;* Locals: outline
  4536. (defun lispy-outline-level ()
  4537. "Compute the outline level of the heading at point."
  4538. (save-excursion
  4539. (save-match-data
  4540. (end-of-line)
  4541. (if (re-search-backward lispy-outline nil t)
  4542. (max (cl-count ?* (match-string 0)) 1)
  4543. 0))))
  4544. (defun lispy-outline-next (arg)
  4545. "Call `outline-next-visible-heading' ARG times."
  4546. (interactive "p")
  4547. (lispy--remember)
  4548. (lispy-dotimes arg
  4549. (let ((pt (point)))
  4550. (outline-next-visible-heading 1)
  4551. (unless (looking-at outline-regexp)
  4552. (goto-char pt)
  4553. (error "Past last outline")))))
  4554. (defun lispy-outline-prev (arg)
  4555. "Call `outline-previous-visible-heading' ARG times."
  4556. (interactive "p")
  4557. (lispy--remember)
  4558. (deactivate-mark)
  4559. (lispy-dotimes arg
  4560. (let ((pt (point)))
  4561. (outline-previous-visible-heading 1)
  4562. (unless (looking-at outline-regexp)
  4563. (goto-char pt)
  4564. (error "Past first outline")))))
  4565. (defun lispy-outline-promote ()
  4566. "Promote current outline level by one."
  4567. (interactive)
  4568. (save-excursion
  4569. (beginning-of-line)
  4570. (when (looking-at lispy-outline)
  4571. (goto-char (match-end 0))
  4572. (insert "*"))))
  4573. (defun lispy-outline-demote ()
  4574. "Demote current outline level by one."
  4575. (interactive)
  4576. (save-excursion
  4577. (beginning-of-line)
  4578. (when (looking-at lispy-outline)
  4579. (if (<= (- (match-end 0)
  4580. (match-beginning 0))
  4581. (1+ (- (length lispy-outline-header)
  4582. ;; `sml-mode'
  4583. (cl-count ?* lispy-outline-header))))
  4584. (progn
  4585. (setq this-command 'lispy-outline-left)
  4586. (lispy-complain "Can't demote outline"))
  4587. (goto-char (match-end 0))
  4588. (delete-char -1))
  4589. t)))
  4590. (defun lispy-outline-left ()
  4591. "Move left."
  4592. (interactive)
  4593. (when (looking-at lispy-outline)
  4594. (lispy--remember)
  4595. (let ((level-up (1- (funcall outline-level))))
  4596. (when (> level-up 0)
  4597. (re-search-backward (format "^#\\*\\{1,%d\\} " level-up) nil t)))))
  4598. (defun lispy-outline-right ()
  4599. "Move right."
  4600. (interactive)
  4601. (let ((pt (point))
  4602. result)
  4603. (save-restriction
  4604. (org-narrow-to-subtree)
  4605. (forward-char)
  4606. (if (re-search-forward lispy-outline nil t)
  4607. (progn
  4608. (goto-char (match-beginning 0))
  4609. (setq result t))
  4610. (goto-char pt)))
  4611. (lispy--ensure-visible)
  4612. result))
  4613. (defun lispy-outline-goto-child ()
  4614. "Goto the first variable `lispy-left' of the current outline."
  4615. (interactive)
  4616. (let ((end (save-excursion
  4617. (or (re-search-forward lispy-outline nil t 2)
  4618. (point-max)))))
  4619. (if (re-search-forward lispy-left end t)
  4620. (progn
  4621. (backward-char 1)
  4622. (lispy--ensure-visible))
  4623. (lispy-complain "This outline has no children"))))
  4624. (declare-function ediff-regions-internal "ediff")
  4625. (declare-function iedit-regexp-quote "iedit")
  4626. (declare-function iedit-start "iedit")
  4627. (declare-function org-back-to-heading "org")
  4628. (declare-function org-end-of-subtree "org")
  4629. (declare-function org-at-heading-p "org")
  4630. (declare-function org-speed-move-safe "org")
  4631. (declare-function org-cycle-internal-local "org")
  4632. (declare-function org-content "org")
  4633. (declare-function org-cycle-internal-global "org")
  4634. (declare-function org-narrow-to-subtree "org")
  4635. (defun lispy-tab ()
  4636. "Indent code and hide/show outlines.
  4637. When region is active, call `lispy-mark-car'."
  4638. (interactive)
  4639. (let (outline-eval-tag)
  4640. (cond ((region-active-p)
  4641. (lispy-mark-car))
  4642. ((looking-at lispy-outline)
  4643. (outline-minor-mode 1)
  4644. (condition-case e
  4645. (lispy-flet (org-unlogged-message (&rest _x))
  4646. (require 'org)
  4647. (let ((org-outline-regexp outline-regexp))
  4648. (org-cycle-internal-local)))
  4649. (error
  4650. (if (string= (error-message-string e) "before first heading")
  4651. (outline-next-visible-heading 1)
  4652. (signal (car e) (cdr e))))))
  4653. ((looking-at (setq outline-eval-tag (format "^%s =>" lispy-outline-header)))
  4654. (let* ((bnd (lispy--bounds-comment))
  4655. (beg (car bnd))
  4656. (end (cdr bnd)))
  4657. (if (overlays-in beg end)
  4658. (remove-overlays beg end)
  4659. (outline-flag-region
  4660. (+ beg (1- (length outline-eval-tag))) end 'visible))))
  4661. (t
  4662. (lispy--normalize-1)))))
  4663. (defun lispy-shifttab (arg)
  4664. "Hide/show outline summary.
  4665. When ARG isn't nil, show table of contents."
  4666. (interactive "P")
  4667. (require 'org)
  4668. (outline-minor-mode 1)
  4669. (let ((org-outline-regexp outline-regexp))
  4670. (lispy-flet (org-unlogged-message (&rest _x))
  4671. (if arg
  4672. (org-content)
  4673. (when (eq org-cycle-global-status 'overview)
  4674. (setq org-cycle-global-status 'contents))
  4675. (org-cycle-internal-global))))
  4676. (recenter))
  4677. ;;* Locals: refactoring
  4678. (defun lispy-to-lambda ()
  4679. "Turn the current function definition into a lambda."
  4680. (interactive)
  4681. (when (save-excursion (lispy--out-backward 1))
  4682. (beginning-of-defun))
  4683. (forward-char 1)
  4684. (let ((beg (point)))
  4685. (when (re-search-forward "(" (save-excursion (forward-list)) t)
  4686. (delete-region beg (- (point) 2))
  4687. (goto-char beg)
  4688. (insert "lambda")
  4689. (goto-char (1- beg)))))
  4690. (defun lispy-to-defun ()
  4691. "Turn the current lambda or toplevel sexp into a defun."
  4692. (interactive)
  4693. (let (bnd expr)
  4694. (cond ((and (lispy-from-left (bolp))
  4695. (progn
  4696. (setq expr
  4697. (lispy--read
  4698. (lispy--string-dwim
  4699. (setq bnd (lispy--bounds-dwim)))))
  4700. (cl-every #'symbolp expr)))
  4701. (delete-region (car bnd)
  4702. (cdr bnd))
  4703. (lispy--insert
  4704. `(defun ,(car expr) ,(or (cdr expr) '(ly-raw empty))
  4705. (ly-raw newline)))
  4706. (backward-char))
  4707. ((let ((pt (point)))
  4708. (when (region-active-p)
  4709. (deactivate-mark))
  4710. (when (lispy-right-p)
  4711. (backward-list))
  4712. (while (and (not (looking-at "(lambda"))
  4713. (lispy--out-backward 1)))
  4714. (if (looking-at "(lambda")
  4715. t
  4716. (goto-char pt)
  4717. nil))
  4718. (let ((name (read-string "Function name: ")))
  4719. (forward-char 1)
  4720. (delete-char 6)
  4721. (insert "defun " name)
  4722. (lispy-kill-at-point)
  4723. (insert "#'" name)
  4724. (message "defun stored to kill ring")
  4725. (lispy-backward 1)))
  4726. ((looking-at "(let")
  4727. (lispy--extract-let-as-defun))
  4728. (t
  4729. (lispy-extract-block)))))
  4730. (defun lispy-extract-defun ()
  4731. "Extract the marked block as a defun.
  4732. For the defun to have arguments, capture them with `lispy-bind-variable'."
  4733. (interactive)
  4734. (let* ((bnd (lispy--bounds-dwim))
  4735. (str (lispy--string-dwim bnd))
  4736. (expr (lispy--read (format "(progn %s)" str)))
  4737. (name
  4738. (make-symbol
  4739. (read-string "Function name: ")))
  4740. vars
  4741. expr-without-let
  4742. expr-defun
  4743. expr-funcall)
  4744. (setq vars nil)
  4745. (setq expr-without-let
  4746. (lispy-mapcan-tree
  4747. (lambda (x y)
  4748. (if (eq (car-safe x) 'let)
  4749. (let* ((var-conses (cadr x))
  4750. (first-var-cons (car var-conses))
  4751. (var-name (car first-var-cons))
  4752. (let-body (cddr x)))
  4753. (if (equal (list var-name)
  4754. (delete '(ly-raw newline) let-body))
  4755. (progn
  4756. (push (cons var-name (cdr first-var-cons)) vars)
  4757. (cons var-name y))
  4758. (cons x y)))
  4759. (cons x y)))
  4760. expr))
  4761. (setq expr-defun
  4762. `(defun ,name ,(or (mapcar 'car vars) '(ly-raw empty))
  4763. (ly-raw newline)
  4764. ,@(cdr expr-without-let)))
  4765. (setq expr-funcall
  4766. `(,name ,@(mapcar 'cadr vars)))
  4767. (delete-region (car bnd) (cdr bnd))
  4768. (lispy--insert expr-funcall)
  4769. (save-excursion
  4770. (lispy-beginning-of-defun)
  4771. (lispy--insert expr-defun)
  4772. (insert "\n\n"))))
  4773. (defun lispy--extract-let-as-defun ()
  4774. (let* ((bnd (lispy--bounds-dwim))
  4775. (expr (lispy--read (lispy--string-dwim bnd)))
  4776. (vars (delete '(ly-raw newline) (cadr expr)))
  4777. (body (cl-cdddr expr))
  4778. (name
  4779. (make-symbol
  4780. (read-string "Function name: ")))
  4781. (expr-defun `(defun ,name ,(mapcar #'car vars) (ly-raw newline)
  4782. ,@body)))
  4783. (delete-region (car bnd) (cdr bnd))
  4784. (lispy--insert
  4785. `(,name ,@(mapcar #'cadr vars)))
  4786. (save-excursion
  4787. (lispy-beginning-of-defun)
  4788. (when (looking-back ";;;###autoload\n" (line-beginning-position 0))
  4789. (goto-char (match-beginning 0)))
  4790. (lispy--insert expr-defun)
  4791. (insert "\n\n")
  4792. (forward-sexp -1)
  4793. (lispy--reindent))
  4794. (undo-boundary)))
  4795. (declare-function lispy-flatten--clojure "le-clojure")
  4796. (declare-function lispy-flatten--lisp "le-lisp")
  4797. (defun lispy-flatten (arg)
  4798. "Inline a function at the point of its call.
  4799. Pass the ARG along."
  4800. (interactive "P")
  4801. (cond ((memq major-mode lispy-elisp-modes)
  4802. (lispy-flatten--elisp arg))
  4803. ((or (memq major-mode lispy-clojure-modes)
  4804. (memq major-mode '(nrepl-repl-mode
  4805. cider-clojure-interaction-mode)))
  4806. (require 'le-clojure)
  4807. (lispy-flatten--clojure arg))
  4808. ((eq major-mode 'lisp-mode)
  4809. (lispy-flatten--lisp))
  4810. (t
  4811. (lispy-complain
  4812. (format "%S isn't currently supported" major-mode)))))
  4813. (defun lispy-let-flatten ()
  4814. "Inline a function at the point of its call using `let'."
  4815. (interactive)
  4816. (let* ((begp (if (lispy-left-p)
  4817. t
  4818. (if (lispy-right-p)
  4819. (progn (backward-list) nil)
  4820. (lispy-left 1))))
  4821. (bnd (lispy--bounds-list))
  4822. (str (lispy--string-dwim bnd))
  4823. (expr (lispy--read str))
  4824. (fstr (condition-case e
  4825. (lispy--function-str
  4826. (car expr))
  4827. (unsupported-mode-error
  4828. (lispy-complain
  4829. (format
  4830. "Can't flatten: symbol `%s' is defined in `%s'"
  4831. (lispy--prin1-fancy (car expr))
  4832. (lispy--prin1-fancy (cdr e))))
  4833. nil))))
  4834. (when fstr
  4835. (goto-char (car bnd))
  4836. (delete-region
  4837. (car bnd)
  4838. (cdr bnd))
  4839. (if (macrop (car expr))
  4840. (error "macros not yet supported")
  4841. (let* ((e-args (cl-remove-if
  4842. #'lispy--whitespacep
  4843. (cdr expr)))
  4844. (p-body (lispy--function-parse fstr))
  4845. (f-args (car p-body))
  4846. (body (cadr p-body))
  4847. (print-quoted t)
  4848. (body
  4849. (cond (e-args
  4850. `(let ,(cl-mapcar #'list f-args e-args)
  4851. (ly-raw newline)
  4852. ,@body))
  4853. ((= 1 (length body))
  4854. (car body))
  4855. (t
  4856. (cons 'progn body)))))
  4857. (lispy--insert body)))
  4858. (lispy-multiline)
  4859. (when begp
  4860. (goto-char (car bnd))))))
  4861. (defun lispy-flatten--elisp (arg)
  4862. "Inline an Elisp function at the point of its call.
  4863. The function body is obtained from `find-function-noselect'.
  4864. With ARG, use the contents of `lispy-store-region-and-buffer' instead."
  4865. (let* ((begp (if (lispy-left-p)
  4866. t
  4867. (if (lispy-right-p)
  4868. (progn (backward-list)
  4869. nil)
  4870. (lispy-left 1))))
  4871. (bnd (lispy--bounds-list))
  4872. (str (lispy--string-dwim bnd))
  4873. (expr (lispy--read str))
  4874. (fstr (if arg
  4875. (with-current-buffer (get 'lispy-store-bounds 'buffer)
  4876. (lispy--string-dwim (get 'lispy-store-bounds 'region)))
  4877. (condition-case e
  4878. (lispy--function-str (car expr))
  4879. (unsupported-mode-error
  4880. (lispy-complain
  4881. (format "Can't flatten: symbol `%s' is defined in `%s'"
  4882. (lispy--prin1-fancy (car expr))
  4883. (lispy--prin1-fancy (cdr e))))
  4884. nil))))
  4885. (res (if (macrop (car expr))
  4886. (macroexpand (read str))
  4887. (lispy--flatten-function
  4888. fstr
  4889. (cl-remove-if #'lispy--whitespacep (cdr expr))))))
  4890. (when fstr
  4891. (goto-char (car bnd))
  4892. (delete-region (car bnd) (cdr bnd))
  4893. (if (macrop (car expr))
  4894. (progn
  4895. (save-excursion
  4896. (insert (pp-to-string res))
  4897. (when (bolp)
  4898. (delete-char -1)))
  4899. (indent-sexp))
  4900. (let* ((print-quoted t))
  4901. (lispy--insert res)))
  4902. (lispy-alt-multiline)
  4903. (when begp
  4904. (goto-char (car bnd))))))
  4905. (defun lispy-to-ifs ()
  4906. "Transform current `cond' expression to equivalent `if' expressions."
  4907. (interactive)
  4908. (lispy-from-left
  4909. (let* ((bnd (lispy--bounds-dwim))
  4910. (expr (lispy--read (lispy--string-dwim bnd))))
  4911. (unless (eq (car expr) 'cond)
  4912. (error "%s isn't cond" (car expr)))
  4913. (delete-region (car bnd) (cdr bnd))
  4914. (lispy--fast-insert
  4915. (car
  4916. (lispy--whitespace-trim
  4917. (lispy--cases->ifs (cdr expr)))))))
  4918. (lispy-from-left
  4919. (indent-sexp)))
  4920. (defun lispy-to-cond ()
  4921. "Reverse of `lispy-to-ifs'."
  4922. (interactive)
  4923. (lispy-from-left
  4924. (let* ((bnd (lispy--bounds-dwim))
  4925. (expr (lispy--read (lispy--string-dwim bnd)))
  4926. (res (cond ((eq (car expr) 'if)
  4927. (cons 'cond (lispy--ifs->cases expr)))
  4928. ((memq (car expr) '(case cl-case))
  4929. (lispy--case->cond expr))
  4930. (t
  4931. (error "Can't convert %s to cond" (car expr))))))
  4932. (delete-region (car bnd) (cdr bnd))
  4933. (lispy--fast-insert res)))
  4934. (lispy-from-left
  4935. (indent-sexp)))
  4936. (defun lispy-unbind-variable ()
  4937. "Substitute let-bound variable."
  4938. (interactive)
  4939. (if (memq major-mode lispy-clojure-modes)
  4940. (lispy-unbind-variable-clojure)
  4941. (let ((inhibit-message t)
  4942. beg end)
  4943. (require 'iedit)
  4944. (save-excursion
  4945. (lispy--out-backward 2)
  4946. (setq beg (point))
  4947. (forward-list 1)
  4948. (setq end (point)))
  4949. (forward-char 1)
  4950. (iedit-start (iedit-regexp-quote (lispy--string-dwim)) beg end)
  4951. (lispy-mark-symbol)
  4952. (lispy-move-down 1)
  4953. (iedit-mode)
  4954. (deactivate-mark)
  4955. (lispy-left 1)
  4956. (lispy-delete 1)
  4957. (when (looking-at "[ \n]*")
  4958. (delete-region (match-beginning 0)
  4959. (match-end 0)))
  4960. (if (looking-at ")")
  4961. (progn
  4962. (lispy--out-backward 1)
  4963. (lispy-down 1)
  4964. (lispy-raise-some))
  4965. (save-excursion
  4966. (lispy--out-backward 2)
  4967. (lispy--normalize-1)))
  4968. (undo-boundary))))
  4969. (defun lispy-unbind-variable-clojure ()
  4970. "Subsititute let-bound variable in Clojure."
  4971. (interactive)
  4972. (require 'iedit)
  4973. (deactivate-mark)
  4974. (lispy-flet (message (&rest _x))
  4975. (iedit-mode 0))
  4976. (lispy-mark-symbol)
  4977. (lispy-move-down 1)
  4978. (iedit-mode)
  4979. (exchange-point-and-mark)
  4980. (lispy-slurp 1)
  4981. (delete-active-region)
  4982. (deactivate-mark)
  4983. (lispy--out-backward 2)
  4984. (lispy--normalize-1)
  4985. (lispy-flow 1))
  4986. (defun lispy-bind-variable ()
  4987. "Bind current expression as variable.
  4988. `lispy-map-done' is used to finish entering the variable name.
  4989. The bindings of `lispy-backward' or `lispy-mark-symbol' can also be used."
  4990. (interactive)
  4991. (let* ((bnd (lispy--bounds-dwim))
  4992. (str (lispy--string-dwim bnd)))
  4993. (setq lispy-bind-var-in-progress t)
  4994. (deactivate-mark)
  4995. (lispy-map-delete-overlay)
  4996. (delete-region (car bnd) (cdr bnd))
  4997. (insert (format "(let (( %s))\n)" str))
  4998. (goto-char (car bnd))
  4999. (indent-sexp)
  5000. (forward-sexp)
  5001. (setq lispy-map-target-beg (+ (car bnd) 7))
  5002. (setq lispy-map-target-len 0)
  5003. (backward-char 1)
  5004. (setq lispy-map-format-function 'identity)
  5005. (lispy-map-make-input-overlay (point) (point))))
  5006. ;;* Locals: multiple cursors
  5007. (declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core")
  5008. (declare-function multiple-cursors-mode "ext:multiple-cursors-core")
  5009. (declare-function mc/all-fake-cursors "ext:multiple-cursors-core")
  5010. (declare-function mc/maybe-multiple-cursors-mode "ext:multiple-cursors-core")
  5011. (declare-function mc/mark-lines "ext:mc-mark-more")
  5012. (declare-function mc/remove-fake-cursors "ext:multiple-cursors-core")
  5013. (defun lispy-cursor-down (arg)
  5014. "Add ARG cursors using `lispy-down'."
  5015. (interactive "p")
  5016. (require 'multiple-cursors)
  5017. (if (and (mc/all-fake-cursors)
  5018. (not (eq last-command
  5019. 'lispy-cursor-down)))
  5020. (progn
  5021. (deactivate-mark)
  5022. (mc/remove-fake-cursors))
  5023. (if (lispy-left-p)
  5024. (lispy-dotimes arg
  5025. (mc/create-fake-cursor-at-point)
  5026. (cl-loop do (lispy-down 1)
  5027. while (mc/all-fake-cursors (point) (1+ (point)))))
  5028. (mc/mark-lines arg 'forwards))
  5029. (mc/maybe-multiple-cursors-mode)))
  5030. (eval-after-load 'multiple-cursors
  5031. '(defadvice mc/execute-command-for-all-fake-cursors
  5032. (around lispy-other-mode-mc (cmd) activate)
  5033. (unless (and (eq cmd 'special-lispy-other-mode)
  5034. (or (lispy-left-p)
  5035. (lispy-right-p)
  5036. (region-active-p)))
  5037. ad-do-it)))
  5038. (defun lispy-cursor-ace ()
  5039. "Add a cursor at a visually selected paren.
  5040. Currently, only one cursor can be added with local binding.
  5041. Any amount can be added with a global binding."
  5042. (interactive)
  5043. (require 'multiple-cursors)
  5044. (mc/create-fake-cursor-at-point)
  5045. (lispy--avy-do
  5046. "("
  5047. (cons (window-start) (window-end))
  5048. (lambda () (not (lispy--in-string-or-comment-p)))
  5049. lispy-avy-style-paren)
  5050. (mc/maybe-multiple-cursors-mode))
  5051. ;;* Locals: ediff
  5052. (defun lispy-store-region-and-buffer ()
  5053. "Store current buffer and `lispy--bounds-dwim'."
  5054. (interactive)
  5055. (put 'lispy-store-bounds 'buffer (current-buffer))
  5056. (put 'lispy-store-bounds 'region (lispy--bounds-dwim)))
  5057. (defun lispy--vertical-splitp ()
  5058. "Return nil if the frame isn't two vertical windows.
  5059. In case it is, return the left window."
  5060. (let ((windows (window-list)))
  5061. (when (= (length windows) 2)
  5062. (let ((wnd1 (car windows))
  5063. (wnd2 (cadr windows)))
  5064. (when (= (window-pixel-top wnd1)
  5065. (window-pixel-top wnd2))
  5066. (if (< (window-pixel-left wnd1)
  5067. (window-pixel-left wnd2))
  5068. wnd1
  5069. wnd2))))))
  5070. (defun lispy--ediff-regions (bnd1 bnd2 &optional buf1 buf2 desc1 desc2)
  5071. (interactive)
  5072. (let ((wnd (current-window-configuration))
  5073. (e1 (lispy--make-ediff-buffer
  5074. (or buf1 (current-buffer)) (or desc1 "-A-")
  5075. bnd1))
  5076. (e2 (lispy--make-ediff-buffer
  5077. (or buf2 (current-buffer)) (or desc2 "-B-")
  5078. bnd2)))
  5079. (require 'ediff)
  5080. (apply #'ediff-regions-internal
  5081. `(,@(if (equal (selected-window)
  5082. (lispy--vertical-splitp))
  5083. (append e1 e2)
  5084. (append e2 e1))
  5085. nil ediff-regions-linewise nil nil))
  5086. (add-hook 'ediff-after-quit-hook-internal
  5087. `(lambda ()
  5088. (setq ediff-after-quit-hook-internal nil)
  5089. (set-window-configuration ,wnd)))))
  5090. (defun lispy-ediff-regions ()
  5091. "Comparable to `ediff-regions-linewise'.
  5092. First region and buffer come from `lispy-store-region-and-buffer'
  5093. Second region and buffer are the current ones."
  5094. (interactive)
  5095. (if (null (get 'lispy-store-bounds 'buffer))
  5096. (error "No bounds stored: call `lispy-store-region-and-buffer' for this")
  5097. (lispy--ediff-regions
  5098. (lispy--bounds-dwim)
  5099. (get 'lispy-store-bounds 'region)
  5100. (current-buffer)
  5101. (get 'lispy-store-bounds 'buffer))))
  5102. ;;* Locals: marking
  5103. (defun lispy-mark-right (arg)
  5104. "Go right ARG times and mark."
  5105. (interactive "p")
  5106. (let* ((pt (point))
  5107. (mk (mark))
  5108. (lispy-ignore-whitespace t)
  5109. (r (lispy--out-forward arg)))
  5110. (deactivate-mark)
  5111. (if (or (= pt (point))
  5112. (= mk (point))
  5113. (and (region-active-p)
  5114. (= (region-beginning)
  5115. (region-end))))
  5116. (progn
  5117. (lispy-complain "can't go any further")
  5118. (if (> mk pt)
  5119. (lispy--mark (cons pt mk))
  5120. (lispy--mark (cons mk pt)))
  5121. nil)
  5122. (lispy--mark
  5123. (lispy--bounds-dwim))
  5124. r)))
  5125. (defun lispy-mark-left (arg)
  5126. "Go left ARG times and mark."
  5127. (interactive "p")
  5128. (if (lispy-mark-right arg)
  5129. (lispy-different)
  5130. (when (= (point) (region-end))
  5131. (exchange-point-and-mark))))
  5132. (defun lispy-mark-car ()
  5133. "Mark the car of current thing."
  5134. (interactive)
  5135. (lispy--remember)
  5136. (let ((bnd-1 (lispy--bounds-dwim))
  5137. bnd-2)
  5138. (cond ((and (eq (char-after (car bnd-1)) ?\")
  5139. (eq (char-before (cdr bnd-1)) ?\")
  5140. (eq 1 (length (read (format "(%s)" (lispy--string-dwim))))))
  5141. (lispy--mark (cons (1+ (car bnd-1))
  5142. (1- (cdr bnd-1)))))
  5143. ((and (eq (char-after (car bnd-1)) ?\`)
  5144. (eq (char-before (cdr bnd-1)) ?\'))
  5145. (lispy--mark (cons (1+ (car bnd-1))
  5146. (1- (cdr bnd-1)))))
  5147. ((save-excursion
  5148. (goto-char (car bnd-1))
  5149. (looking-at "\\(['`,@]+\\)\\w"))
  5150. (set-mark (match-end 1))
  5151. (goto-char (cdr bnd-1)))
  5152. ((and (region-active-p)
  5153. (or (and (= (point) (region-end))
  5154. (looking-at "\\_>"))
  5155. (and (= (point) (region-beginning))
  5156. (looking-at "\\_<")))))
  5157. (t
  5158. (goto-char (car bnd-1))
  5159. (while (and (equal bnd-1 (setq bnd-2 (bounds-of-thing-at-point 'sexp)))
  5160. (< (point) (cdr bnd-1)))
  5161. (forward-char)
  5162. (skip-chars-forward " "))
  5163. (if bnd-2
  5164. (lispy--mark bnd-2)
  5165. (lispy-complain "can't descend further"))))))
  5166. ;;* Locals: edebug
  5167. (declare-function lispy--clojure-debug-quit "le-clojure")
  5168. (defun lispy-edebug-stop ()
  5169. "Stop edebugging, while saving current function arguments."
  5170. (interactive)
  5171. (cond ((memq major-mode lispy-elisp-modes)
  5172. (if (bound-and-true-p edebug-active)
  5173. (save-excursion
  5174. (lispy-left 99)
  5175. (if (looking-at
  5176. "(\\(?:cl-\\)?def\\(?:un\\|macro\\)")
  5177. (progn
  5178. (goto-char (match-end 0))
  5179. (search-forward "(")
  5180. (backward-char 1)
  5181. (forward-sexp 1)
  5182. (let ((sexps
  5183. (mapcar
  5184. (lambda (x!)
  5185. (when (consp x!)
  5186. (setq x! (car x!)))
  5187. (cons x!
  5188. (let ((expr x!))
  5189. (edebug-eval expr))))
  5190. (mapcar (lambda (x)
  5191. (if (consp x)
  5192. (car x)
  5193. x))
  5194. (delq '&allow-other-keys
  5195. (delq '&key
  5196. (delq '&optional
  5197. (delq '&rest
  5198. (lispy--preceding-sexp))))))))
  5199. (wnd (current-window-configuration))
  5200. (pt (point)))
  5201. (run-with-timer
  5202. 0 nil
  5203. `(lambda ()
  5204. (mapc (lambda (x!) (set (car x!) (cdr x!))) ',sexps)
  5205. (set-window-configuration ,wnd)
  5206. (goto-char ,pt)))
  5207. (top-level)))))
  5208. (self-insert-command 1)))
  5209. ((eq major-mode 'clojure-mode)
  5210. (lispy--clojure-debug-quit))))
  5211. (declare-function cider-debug-defun-at-point "ext:cider-debug")
  5212. (defun lispy-edebug (arg)
  5213. "Start/stop edebug of current thing depending on ARG.
  5214. ARG is 1: `edebug-defun' on this function.
  5215. ARG is 2: `eval-defun' on this function.
  5216. ARG is 3: `edebug-defun' on the function from this sexp.
  5217. ARG is 4: `eval-defun' on the function from this sexp."
  5218. (interactive "p")
  5219. (cond ((= arg 1)
  5220. (if (memq major-mode lispy-elisp-modes)
  5221. (edebug-defun)
  5222. (if (eq major-mode 'clojure-mode)
  5223. (cider-debug-defun-at-point)
  5224. (error "Can't debug for %S" major-mode))))
  5225. ((= arg 2)
  5226. (eval-defun nil))
  5227. (t
  5228. (let* ((expr (lispy--read (lispy--string-dwim)))
  5229. (fun (car expr)))
  5230. (if (fboundp fun)
  5231. (let* ((fnd (find-definition-noselect fun nil))
  5232. (buf (car fnd))
  5233. (pt (cdr fnd)))
  5234. (with-current-buffer buf
  5235. (goto-char pt)
  5236. (cond ((= arg 3)
  5237. (edebug-defun))
  5238. ((= arg 4)
  5239. (eval-defun nil))
  5240. (t
  5241. (error "Argument = %s isn't supported" arg)))))
  5242. (error "%s isn't bound" fun))))))
  5243. (declare-function lispy--clojure-debug-step-in "le-clojure")
  5244. (declare-function lispy--python-debug-step-in "le-python")
  5245. (declare-function lispy-eval-python-bnd "le-python")
  5246. (declare-function lispy-eval-python-str "le-python")
  5247. (declare-function lispy-set-python-process "le-python")
  5248. (defun lispy-debug-step-in ()
  5249. "Eval current function arguments and jump to definition."
  5250. (interactive)
  5251. (cond ((memq major-mode lispy-elisp-modes)
  5252. (let* ((ldsi-sxp (lispy--setq-expression))
  5253. (ldsi-fun (car ldsi-sxp)))
  5254. (cond
  5255. ((memq ldsi-fun '(mapcar mapc mapcan
  5256. cl-remove-if cl-remove-if-not
  5257. cl-find-if cl-find-if-not
  5258. cl-some cl-every cl-any cl-notany))
  5259. (let ((fn (nth 1 ldsi-sxp))
  5260. (lst (nth 2 ldsi-sxp)))
  5261. (when (eq (car-safe fn) 'lambda)
  5262. (set (car (cadr fn)) (car (eval lst)))
  5263. (lispy-flow 2))))
  5264. ((or (functionp ldsi-fun)
  5265. (macrop ldsi-fun))
  5266. (when (eq ldsi-fun 'funcall)
  5267. (setq ldsi-fun (eval (cadr ldsi-sxp)))
  5268. (setq ldsi-sxp (cons ldsi-fun (cddr ldsi-sxp))))
  5269. (let ((ldsi-args
  5270. (copy-sequence
  5271. (help-function-arglist
  5272. (if (ad-is-advised ldsi-fun)
  5273. (ad-get-orig-definition ldsi-fun)
  5274. ldsi-fun)
  5275. t)))
  5276. (ldsi-vals (cdr ldsi-sxp))
  5277. ldsi-arg
  5278. ldsi-val)
  5279. (catch 'done
  5280. (while (setq ldsi-arg (pop ldsi-args))
  5281. (cond ((eq ldsi-arg '&optional)
  5282. (setq ldsi-arg (pop ldsi-args))
  5283. (set ldsi-arg (eval (pop ldsi-vals))))
  5284. ((eq ldsi-arg '&rest)
  5285. (setq ldsi-arg (pop ldsi-args))
  5286. (set ldsi-arg
  5287. (if (functionp ldsi-fun)
  5288. (mapcar #'eval ldsi-vals)
  5289. ldsi-vals))
  5290. (throw 'done t))
  5291. (t
  5292. (setq ldsi-val (pop ldsi-vals))
  5293. (set ldsi-arg
  5294. (if (functionp ldsi-fun)
  5295. (eval ldsi-val)
  5296. ldsi-val))))))
  5297. (lispy-goto-symbol ldsi-fun)))
  5298. (t
  5299. (lispy-complain
  5300. (format "%S isn't a function" ldsi-fun))))))
  5301. ((eq major-mode 'clojure-mode)
  5302. (require 'le-clojure)
  5303. (lispy--clojure-debug-step-in))
  5304. ((eq major-mode 'python-mode)
  5305. (require 'le-python)
  5306. (lispy--python-debug-step-in))
  5307. (t
  5308. (lispy-complain
  5309. (format "%S isn't currently supported" major-mode)))))
  5310. (defvar cl--bind-lets)
  5311. (defvar cl--bind-forms)
  5312. (defvar cl--bind-defs)
  5313. (defvar cl--bind-block)
  5314. (defvar cl--bind-enquote)
  5315. (defmacro lispy-destructuring-setq (args expr)
  5316. "Set ARGS to parts of EXPR.
  5317. An equivalent of `cl-destructuring-bind'."
  5318. (declare (indent 2))
  5319. (let* ((cl--bind-lets nil)
  5320. (cl--bind-forms nil)
  5321. (cl--bind-defs nil)
  5322. (cl--bind-block (quote cl-none))
  5323. (cl--bind-enquote nil)
  5324. res)
  5325. (cl--do-arglist (or args (quote (&aux))) expr)
  5326. (setq res
  5327. (nreverse cl--bind-lets))
  5328. `(with-no-warnings
  5329. (progn
  5330. ,@(mapcar (lambda (x)
  5331. (cons 'setq x))
  5332. res)))))
  5333. ;;* Locals: miscellanea
  5334. (defun lispy-describe-bindings-C-4 ()
  5335. "Describe bindings that start with \"C-4\"."
  5336. (interactive)
  5337. (describe-bindings (kbd "C-4")))
  5338. (declare-function lispy--eval-python "le-python")
  5339. (defun lispy-cd ()
  5340. "Change the current REPL working directory."
  5341. (interactive)
  5342. (if (eq major-mode 'python-mode)
  5343. (let* ((pwd
  5344. (lispy--eval-python "import os; print(os.getcwd())"))
  5345. (cwd (read-directory-name "cd: " pwd)))
  5346. (lispy--eval-python (format "os.chdir('%s')" cwd))
  5347. (message cwd))
  5348. (user-error "Unimplemented for %S" major-mode)))
  5349. (defhydra hydra-lispy-x (:exit t
  5350. :hint nil
  5351. :columns 3)
  5352. "x"
  5353. ;; ("a" nil)
  5354. ("b" lispy-bind-variable "bind variable")
  5355. ("c" lispy-to-cond "to cond")
  5356. ("C" lispy-cleanup "cleanup")
  5357. ("d" lispy-to-defun "to defun")
  5358. ("D" lispy-extract-defun "extract defun")
  5359. ("e" lispy-edebug "edebug")
  5360. ("f" lispy-flatten "flatten")
  5361. ("F" lispy-let-flatten "let-flatten")
  5362. ;; ("g" nil)
  5363. ("h" lispy-describe "describe")
  5364. ("i" lispy-to-ifs "to ifs")
  5365. ("j" lispy-debug-step-in "debug step in")
  5366. ("k" lispy-extract-block "extract block")
  5367. ("l" lispy-to-lambda "to lambda")
  5368. ("m" lispy-cursor-ace "multi cursor")
  5369. ("n" lispy-cd)
  5370. ;; ("o" nil)
  5371. ("p" lispy-set-python-process "process")
  5372. ;; ("q" nil)
  5373. ("r" lispy-eval-and-replace "eval and replace")
  5374. ("s" save-buffer)
  5375. ("t" lispy-view-test "view test")
  5376. ("u" lispy-unbind-variable "unbind let-var")
  5377. ("v" lispy-eval-expression "eval")
  5378. ;; ("w" nil)
  5379. ;; ("x" nil)
  5380. ;; ("y" nil)
  5381. ;; ("z" nil)
  5382. ("B" lispy-store-region-and-buffer "store list bounds")
  5383. ("R" lispy-reverse "reverse")
  5384. ("T" lispy-ert "ert")
  5385. ("" lispy-x-more-verbosity :exit nil)
  5386. ("?" lispy-x-more-verbosity "help" :exit nil))
  5387. (defun lispy-cleanup ()
  5388. (interactive)
  5389. (save-excursion
  5390. (while (re-search-forward "^;; =>" nil t)
  5391. (let ((bnd (lispy--bounds-comment)))
  5392. (delete-region (car bnd) (1+ (cdr bnd))))))
  5393. (save-buffer))
  5394. (defvar lispy-x--old-hint "")
  5395. (defun lispy-x-more-verbosity ()
  5396. (interactive)
  5397. (let ((cv (hydra-get-property 'hydra-lispy-x :verbosity)))
  5398. (cl-case cv
  5399. (0
  5400. (setq lispy-x--old-hint hydra-lispy-x/hint)
  5401. (setq hydra-lispy-x/hint
  5402. (hydra--format 'hydra-lispy-x '(nil nil :exit t :hint none)
  5403. (concat
  5404. "\n_b_nd _c_nd _d_ef _e_de _f_la "
  5405. "_h_elp _i_f _j_mp bl_k_ _l_mb _m_ul "
  5406. "_r_ep _s_av _u_nb _v_t _B_nd _R_ev er_T_ _?_")
  5407. hydra-lispy-x/heads))
  5408. (hydra-set-property 'hydra-lispy-x :verbosity 1))
  5409. (1
  5410. (setq hydra-lispy-x/hint lispy-x--old-hint)
  5411. (hydra-set-property 'hydra-lispy-x :verbosity 2)))))
  5412. (defun lispy-x ()
  5413. "Forward to `hydra-lispy-x/body'"
  5414. (interactive)
  5415. (hydra-set-property 'hydra-lispy-x :verbosity 0)
  5416. (hydra-lispy-x/body))
  5417. (defun lispy-ert ()
  5418. "Call (`ert' t)."
  5419. (interactive)
  5420. (ert t))
  5421. (defun lispy-undo ()
  5422. "Deactivate region and `undo'."
  5423. (interactive)
  5424. (when (region-active-p)
  5425. (deactivate-mark t))
  5426. (undo))
  5427. (defun lispy-view ()
  5428. "Recenter current sexp to first screen line, accounting for scroll-margin.
  5429. If already there, return it to previous position."
  5430. (interactive)
  5431. (lispy-from-left
  5432. (let ((window-line (count-lines (window-start) (point))))
  5433. (if (or (= window-line scroll-margin)
  5434. (and (not (bolp)) (= window-line (1+ scroll-margin))))
  5435. (recenter (or (get 'lispy-recenter :line) 0))
  5436. (put 'lispy-recenter :line window-line)
  5437. (recenter 0)))))
  5438. (defun lispy--setq-doconst (x)
  5439. "Return a cons of description and value for X.
  5440. X is an item of a radio- or choice-type defcustom."
  5441. (let (y)
  5442. (when (and (listp x)
  5443. (consp (setq y (last x))))
  5444. (setq x (car y))
  5445. (cons (prin1-to-string x)
  5446. (if (symbolp x)
  5447. (list 'quote x)
  5448. x)))))
  5449. (defun lispy-setq ()
  5450. "Set variable at point, with completion."
  5451. (interactive)
  5452. (let ((sym (intern-soft (thing-at-point 'symbol)))
  5453. sym-type
  5454. cands)
  5455. (when (and (boundp sym)
  5456. (setq sym-type (get sym 'custom-type)))
  5457. (cond
  5458. ((and (consp sym-type)
  5459. (memq (car sym-type) '(choice radio)))
  5460. (setq cands (mapcar #'lispy--setq-doconst (cdr sym-type))))
  5461. ((eq sym-type 'boolean)
  5462. (setq cands
  5463. '(("nil" . nil) ("t" . t))))
  5464. (t
  5465. (error "Unrecognized custom type")))
  5466. (let ((res (ivy-read (format "Set (%S): " sym) cands)))
  5467. (when res
  5468. (setq res
  5469. (if (assoc res cands)
  5470. (cdr (assoc res cands))
  5471. (read res)))
  5472. (eval `(setq ,sym ,res)))))))
  5473. (unless (fboundp 'macrop)
  5474. (defun macrop (object)
  5475. "Non-nil if and only if OBJECT is a macro."
  5476. (let ((def (indirect-function object)))
  5477. (when (consp def)
  5478. (or (eq 'macro (car def))
  5479. (and (autoloadp def) (memq (nth 4 def) '(macro t))))))))
  5480. (defalias 'lispy--preceding-sexp
  5481. (if (fboundp 'elisp--preceding-sexp)
  5482. 'elisp--preceding-sexp
  5483. 'preceding-sexp))
  5484. (declare-function projectile-find-file "ext:projectile")
  5485. (declare-function projectile-find-file-other-window "ext:projectile")
  5486. (declare-function projectile-mode "ext:projectile")
  5487. (declare-function projectile-project-root "ext:projectile")
  5488. (defvar projectile-mode)
  5489. (declare-function find-file-in-project "ext:find-file-in-project")
  5490. (defun lispy-visit (arg)
  5491. "Forward to find file in project depending on ARG."
  5492. (interactive "p")
  5493. (if (eq lispy-visit-method 'ffip)
  5494. (find-file-in-project)
  5495. (unless projectile-mode
  5496. (projectile-mode 1))
  5497. (cond ((= arg 1)
  5498. (projectile-find-file nil))
  5499. ((= arg 2)
  5500. (projectile-find-file-other-window))
  5501. (t
  5502. (projectile-find-file arg)))))
  5503. (defun lispy-narrow (arg)
  5504. "Narrow ARG sexps or region."
  5505. (interactive "p")
  5506. (cond ((region-active-p)
  5507. (narrow-to-region (region-beginning) (region-end)))
  5508. ((lispy-left-p)
  5509. (narrow-to-region (point)
  5510. (save-excursion
  5511. (lispy-forward arg)
  5512. (point))))
  5513. ((lispy-right-p)
  5514. (narrow-to-region (point)
  5515. (save-excursion
  5516. (lispy-backward arg)
  5517. (point))))
  5518. ((looking-at lispy-outline)
  5519. (save-excursion
  5520. (outline-back-to-heading)
  5521. (let ((org-outline-regexp outline-regexp))
  5522. (org-narrow-to-subtree))))))
  5523. (defun lispy-widen ()
  5524. "Forward to `widen'."
  5525. (interactive)
  5526. (widen))
  5527. (defun lispy-other-space ()
  5528. "Alternative to `lispy-space'."
  5529. (interactive)
  5530. (cond ((lispy-right-p)
  5531. (backward-char 1)
  5532. (insert " "))
  5533. ((lispy-left-p)
  5534. (insert " ")
  5535. (backward-char 1))))
  5536. (defun lispy-paste (arg)
  5537. "Forward to `yank'.
  5538. If the region is active, replace instead of yanking.
  5539. When ARG is given, paste at that place in the current list."
  5540. (interactive "p")
  5541. (cond ((region-active-p)
  5542. (let ((bnd (lispy--bounds-dwim)))
  5543. (deactivate-mark)
  5544. (lispy--maybe-safe-delete-region (car bnd)
  5545. (cdr bnd))
  5546. (insert (lispy--maybe-safe-current-kill))))
  5547. ((> arg 1)
  5548. (lispy-mark-car)
  5549. (lispy-down (- arg 2))
  5550. (deactivate-mark)
  5551. (just-one-space)
  5552. (insert (lispy--maybe-safe-current-kill))
  5553. (unless (or (eolp) (looking-at lispy-right))
  5554. (just-one-space)
  5555. (forward-char -1)))
  5556. ((lispy-right-p)
  5557. (newline-and-indent)
  5558. (insert (lispy--maybe-safe-current-kill)))
  5559. ((lispy-left-p)
  5560. (newline-and-indent)
  5561. (forward-line -1)
  5562. (lispy--indent-for-tab)
  5563. (insert (lispy--maybe-safe-current-kill)))
  5564. (t
  5565. (insert (lispy--maybe-safe-current-kill)))))
  5566. (defalias 'lispy-font-lock-ensure
  5567. (if (fboundp 'font-lock-ensure)
  5568. 'font-lock-ensure
  5569. 'font-lock-fontify-buffer))
  5570. (defun lispy--fontify (str mode)
  5571. "Return STR fontified in MODE."
  5572. (with-temp-buffer
  5573. (funcall mode)
  5574. (show-paren-mode)
  5575. (insert str)
  5576. (lispy-font-lock-ensure)
  5577. (let ((color-paren (face-attribute 'show-paren-match :background))
  5578. (color-cursor-fg (face-attribute 'lispy-cursor-face :foreground))
  5579. (color-cursor-bg (face-attribute 'lispy-cursor-face :background))
  5580. pt mk p1 p2)
  5581. (goto-char (point-min))
  5582. (when (search-forward "|" nil t)
  5583. (backward-delete-char 1)
  5584. (setq pt (point))
  5585. (when (< (- (line-end-position) pt) 2)
  5586. (end-of-line)
  5587. (insert " ")))
  5588. (goto-char (point-min))
  5589. (when (search-forward "~" nil t)
  5590. (backward-delete-char 1)
  5591. (setq mk (point))
  5592. (when (< mk pt)
  5593. (cl-decf pt)))
  5594. (if pt
  5595. (progn
  5596. (goto-char pt)
  5597. (cond ((lispy-right-p)
  5598. (setq p2 (1- (point)))
  5599. (lispy-different)
  5600. (setq p1 (point)))
  5601. ((lispy-left-p)
  5602. (setq p1 (point))
  5603. (lispy-different)
  5604. (setq p2 (1- (point)))))
  5605. (when p2
  5606. (save-excursion
  5607. (goto-char p2)
  5608. (when (< (- (line-end-position) p2) 2)
  5609. (end-of-line)
  5610. (insert " "))))
  5611. (setq str (buffer-string))
  5612. (add-face-text-property 0 (length str) '(face 'lispy-test-face) t str)
  5613. (when mk
  5614. (if (< mk pt)
  5615. (progn
  5616. (add-text-properties (1- mk) (1- pt) '(face region) str)
  5617. (set-text-properties (1- pt) pt '(face cursor) str))
  5618. (add-text-properties (1- (min pt mk)) (1- (max pt mk)) '(face region) str)
  5619. (set-text-properties (1- pt) pt '(face cursor) str)))
  5620. (when p1
  5621. (add-text-properties
  5622. (1- p1) p1
  5623. `(face (:background
  5624. ,color-paren
  5625. :foreground
  5626. ,(if (and mk
  5627. (>= p1 (min pt mk))
  5628. (<= p1 (max pt mk)))
  5629. color-cursor-fg
  5630. color-cursor-bg))) str))
  5631. (when p2
  5632. (add-text-properties
  5633. (1- p2) p2
  5634. `(face (:background
  5635. ,color-paren
  5636. :foreground
  5637. ,(if (and mk
  5638. (>= p2 (min pt mk))
  5639. (<= p2 (max pt mk)))
  5640. color-cursor-fg
  5641. color-cursor-bg)))
  5642. str))
  5643. (add-text-properties
  5644. (1- pt) pt
  5645. `(face (:background
  5646. ,color-cursor-bg
  5647. :foreground
  5648. ,(if (eq pt p1)
  5649. color-paren
  5650. color-cursor-fg)))
  5651. str)
  5652. str)
  5653. str))))
  5654. (defun lispy-view-test ()
  5655. "View better the test at point."
  5656. (interactive)
  5657. (cond ((and (overlayp lispy-overlay)
  5658. (eq (point) (get 'lispy-overlay 'last-point)))
  5659. (delete-overlay lispy-overlay)
  5660. (setq lispy-overlay nil))
  5661. ((looking-at "(should (\\(?:string=\\|equal\\)")
  5662. (setq lispy-hint-pos (point))
  5663. (let* ((expr (cadr (read (lispy--string-dwim))))
  5664. (str1 (cadr (cadr expr)))
  5665. (str2 (cl-caddr expr))
  5666. (keys (cl-cddadr expr))
  5667. (keys (if (and (= (length keys) 1)
  5668. (consp (car keys))
  5669. (eq (caar keys) 'execute-kbd-macro))
  5670. (cl-cadar keys)
  5671. keys))
  5672. (sep (make-string (- (window-width)
  5673. (current-column)) ?-))
  5674. (mode (if (looking-at "[^\n]*(lispy-with clojure")
  5675. 'clojure-mode
  5676. 'emacs-lisp-mode)))
  5677. (lispy--show
  5678. (concat "\n"
  5679. (lispy--fontify str1 mode)
  5680. "\n" sep "\n"
  5681. (substring (prin1-to-string keys) 1 -1)
  5682. "\n" sep "\n"
  5683. (lispy--fontify (if (stringp str2)
  5684. str2
  5685. (prin1-to-string str2)) mode)
  5686. "\n"))))
  5687. (t
  5688. (lispy-complain "should position point before (should (string="))))
  5689. (defun lispy-map-done ()
  5690. (interactive)
  5691. (lispy-map-delete-overlay)
  5692. (setq lispy-bind-var-in-progress nil)
  5693. (lispy-backward 1))
  5694. (defvar lispy-map-keymap
  5695. (let ((map (make-sparse-keymap)))
  5696. (define-key map (kbd "[") #'lispy-map-done)
  5697. (define-key map (kbd "<return>") #'lispy-map-done)
  5698. map)
  5699. "The input overlay keymap for `lispy-extract-block'.")
  5700. (defun lispy-map-make-input-overlay (beg end)
  5701. "Set `lispy-map-input-overlay' to an overlay from BEG to END.
  5702. This overlay will automatically extend with modifications.
  5703. Each modification inside `lispy-map-input-overlay' will update the
  5704. area between `lispy-map-target-beg' and `lispy-map-target-len'."
  5705. (when (overlayp lispy-map-input-overlay)
  5706. (delete-overlay lispy-map-input-overlay))
  5707. (let ((ov (make-overlay beg end (current-buffer) nil t)))
  5708. (overlay-put ov 'face 'iedit-occurrence)
  5709. (overlay-put ov 'insert-in-front-hooks '(lispy-map--overlay-update-hook))
  5710. (overlay-put ov 'insert-behind-hooks '(lispy-map--overlay-update-hook))
  5711. (overlay-put ov 'modification-hooks '(lispy-map--overlay-update-hook))
  5712. (overlay-put ov 'priority 200)
  5713. (overlay-put ov 'keymap lispy-map-keymap)
  5714. (setq lispy-map-input-overlay ov)))
  5715. (defun lispy-map-delete-overlay ()
  5716. "Delete `lispy-map-input-overlay'."
  5717. (when (overlayp lispy-map-input-overlay)
  5718. (delete-overlay lispy-map-input-overlay)))
  5719. (defun lispy-map-format-function-extract-block (str)
  5720. (let* ((fun-and-args (read (format "(%s)" str)))
  5721. (args (cdr fun-and-args)))
  5722. (format "%S %s"
  5723. (car fun-and-args)
  5724. (if (memq major-mode lispy-clojure-modes)
  5725. (if args
  5726. (format
  5727. "[%s]"
  5728. (substring (prin1-to-string args)
  5729. 1 -1))
  5730. "[]")
  5731. (if args
  5732. (prin1-to-string args)
  5733. "()")))))
  5734. (defun lispy-map--overlay-update-hook (_occurrence _after _beg _end &optional change)
  5735. (when change
  5736. (let* ((inhibit-modification-hooks t)
  5737. (ovl-beg (overlay-start lispy-map-input-overlay))
  5738. (ovl-end (overlay-end lispy-map-input-overlay))
  5739. (str (buffer-substring-no-properties ovl-beg ovl-end)))
  5740. (save-excursion
  5741. (goto-char
  5742. (+ lispy-map-target-beg
  5743. (if (> lispy-map-target-beg ovl-beg)
  5744. (- ovl-end ovl-beg)
  5745. 0)))
  5746. (delete-char lispy-map-target-len)
  5747. (let ((new-str (funcall lispy-map-format-function str)))
  5748. (insert new-str)
  5749. (setq lispy-map-target-len (length new-str)))))))
  5750. (defun lispy-extract-block ()
  5751. "Transform the current sexp or region into a function call.
  5752. The newly generated function will be placed above the current function.
  5753. Starts the input for the new function name and arguments.
  5754. To finalize this input, press \"[\"."
  5755. (interactive)
  5756. (lispy-map-delete-overlay)
  5757. (let* ((bnd (lispy--bounds-dwim))
  5758. (str (lispy--string-dwim bnd)))
  5759. (undo-boundary)
  5760. (delete-region (car bnd) (cdr bnd))
  5761. (insert "()")
  5762. (backward-char)
  5763. (lispy-map-make-input-overlay (point) (point))
  5764. (setq lispy-map-format-function 'lispy-map-format-function-extract-block)
  5765. (save-excursion
  5766. (lispy-beginning-of-defun)
  5767. (save-excursion
  5768. (insert
  5769. (if (memq major-mode lispy-clojure-modes)
  5770. "(defn a []\n"
  5771. "(defun a ()\n")
  5772. str
  5773. ")\n\n"))
  5774. (indent-sexp)
  5775. (forward-char 1)
  5776. (forward-sexp 2)
  5777. (delete-char -1)
  5778. (setq lispy-map-target-beg (point))
  5779. (setq lispy-map-target-len 3))))
  5780. ;;* Predicates
  5781. (defun lispy--in-string-p ()
  5782. "Test if point is inside a string.
  5783. Return start of string it is."
  5784. (let ((syn (syntax-ppss)))
  5785. (or (and (nth 3 syn)
  5786. (nth 8 syn))
  5787. (and (eq (char-after) ?\")
  5788. (not (eq ?\\ (char-before)))
  5789. (point)))))
  5790. (defun lispy--in-comment-p ()
  5791. "Test if point is inside a comment."
  5792. (save-excursion
  5793. (unless (eolp)
  5794. (forward-char 1))
  5795. (nth 4 (syntax-ppss))))
  5796. (defun lispy--in-string-or-comment-p ()
  5797. "Test if point is inside a string or a comment."
  5798. (let* ((sp (syntax-ppss))
  5799. (beg (nth 8 sp)))
  5800. (when (or (eq (char-after beg) ?\")
  5801. (nth 4 sp))
  5802. beg)))
  5803. (defun lispy--buffer-narrowed-p ()
  5804. "Return T if the current buffer is narrowed."
  5805. (or (/= (point-min) 1)
  5806. (/= (point-max) (1+ (buffer-size)))))
  5807. (defun lispy--raw-comment-p (expr)
  5808. "Return t if EXPR is a raw comment."
  5809. (and (listp expr)
  5810. (eq (car expr) 'ly-raw)
  5811. (consp (cdr expr))
  5812. (eq (cadr expr) 'comment)))
  5813. (defun lispy--raw-string-p (expr)
  5814. "Return t if EXPR is a raw comment."
  5815. (and (listp expr)
  5816. (eq (car expr) 'ly-raw)
  5817. (consp (cdr expr))
  5818. (eq (cadr expr) 'string)))
  5819. (defun lispy--leftp ()
  5820. "Return t if at region beginning, or at start of the list."
  5821. (if (region-active-p)
  5822. (= (point) (region-beginning))
  5823. (or (lispy-left-p)
  5824. (looking-at lispy-outline))))
  5825. (defun lispy--symbolp (str)
  5826. "Return t if STR is a symbol."
  5827. (string-match "\\`\\(?:\\sw\\|\\s_\\)+\\'" str))
  5828. (defun lispy--string-markedp ()
  5829. "Return t if the current active region is a string."
  5830. (and (region-active-p)
  5831. (eq ?\" (char-after (region-beginning)))
  5832. (eq ?\" (char-before (region-end)))))
  5833. (defun lispy-bolp ()
  5834. "Return t if point is at beginning of line, after optional spaces."
  5835. (save-excursion
  5836. (skip-chars-backward " \t")
  5837. (bolp)))
  5838. (defun lispy-after-string-p (str)
  5839. "Return t if the string before point is STR."
  5840. (string=
  5841. (buffer-substring
  5842. (max
  5843. (- (point) (length str))
  5844. (point-min))
  5845. (point))
  5846. str))
  5847. (defun lispy--empty-line-p ()
  5848. "Test whether the point is on an \"empty\" line.
  5849. Return t if the point is by itself on a line with optional whitespace.
  5850. Return 'right if the point is on a line with only right delimiters and
  5851. whitespace."
  5852. (if (and (looking-at (concat "[[:space:]]*" lispy-right "*$"))
  5853. (lispy-looking-back "^[[:space:]]*"))
  5854. (if (looking-at (concat "[[:space:]]*" lispy-right))
  5855. 'right
  5856. t)
  5857. nil))
  5858. (defun lispy--preceding-syntax (preceding-syntax-alist &optional before after)
  5859. "Return a regexp corresponding to valid syntax that can precede delimiters.
  5860. This is done by checking PRECEDING-SYNTAX-ALIST for the current major mode.
  5861. Return nil if there is no entry for the current major mode. When there is an
  5862. entry, prepend BEFORE and append AFTER to the regexp when they are specified."
  5863. (let ((regexps (or (cdr (assoc major-mode preceding-syntax-alist))
  5864. (cdr (assoc t preceding-syntax-alist)))))
  5865. (when regexps
  5866. (concat before
  5867. "\\(?:"
  5868. (apply #'concat
  5869. (lispy-interleave
  5870. "\\|"
  5871. regexps))
  5872. "\\)"
  5873. after))))
  5874. (defun lispy--in-empty-list-p (preceding-syntax-alist)
  5875. "Test whether the point is in a list with no sexps.
  5876. A list with only characters that can precede a delimiter (e.g. \"`(,)\") is
  5877. consider an empty list."
  5878. (and (lispy-looking-back
  5879. (concat lispy-left
  5880. "[[:space:]]*"
  5881. (lispy--preceding-syntax preceding-syntax-alist nil "*")))
  5882. (looking-at (concat "[[:space:]]*" lispy-right))))
  5883. (defun lispy--not-at-sexp-p (preceding-syntax-alist)
  5884. "Test whether the point is at a \"free\" spot and not at a wrappable sexp.
  5885. PRECEDING-SYNTAX-ALIST should be an alist of `major-mode' to a list of regexps.
  5886. The regexps correspond to valid syntax that can precede an opening delimiter in
  5887. each major mode."
  5888. (let* ((space "[[:space:]]")
  5889. (space-or-eol (concat "\\(" space "+\\|" space "*$\\)"))
  5890. (right-or-eol (concat "\\(" lispy-right "+\\|" space "*$\\)"))
  5891. (special-syntax (lispy--preceding-syntax preceding-syntax-alist))
  5892. (line (buffer-substring-no-properties
  5893. (line-beginning-position)
  5894. (line-end-position))))
  5895. (or (lispy--in-empty-list-p preceding-syntax-alist)
  5896. ;; empty line
  5897. (string-match (concat "^" space "*" special-syntax "*" space "*$")
  5898. line)
  5899. ;; empty position at end of list or line
  5900. (and (looking-at right-or-eol)
  5901. (lispy-looking-back (concat space "+" special-syntax "*")))
  5902. ;; empty position at beginning of list
  5903. (and (looking-at space-or-eol)
  5904. (lispy-looking-back (concat lispy-left special-syntax "*")))
  5905. ;; empty position in middle
  5906. (and (looking-at (concat space "+"))
  5907. (lispy-looking-back (concat space "+" special-syntax "*"))))))
  5908. ;;* Pure
  5909. (declare-function lispy-bounds-python-block "le-python")
  5910. (defun lispy--bounds-dwim ()
  5911. "Return a cons of region bounds if it's active.
  5912. Otherwise return cons of current string, symbol or list bounds."
  5913. (let (bnd)
  5914. (cond ((region-active-p)
  5915. (cons (region-beginning)
  5916. (region-end)))
  5917. ((and (setq bnd (lispy--bounds-string))
  5918. (or (eq (point) (car bnd))
  5919. (eq (point) (1- (cdr bnd)))))
  5920. bnd)
  5921. ((looking-at lispy-outline)
  5922. (save-excursion
  5923. (cons
  5924. (progn
  5925. (outline-end-of-heading)
  5926. (1+ (point)))
  5927. (progn
  5928. (outline-end-of-subtree)
  5929. (skip-chars-backward "\n")
  5930. (when (setq bnd (lispy--bounds-comment))
  5931. (goto-char (1- (car bnd))))
  5932. (point)))))
  5933. ((save-excursion
  5934. (when (lispy-right-p)
  5935. (backward-list))
  5936. (and (or (looking-at (concat "[^[:space:]\n]*" lispy-left))
  5937. (looking-at "[`'#]"))
  5938. (setq bnd (bounds-of-thing-at-point 'sexp))))
  5939. (save-excursion
  5940. (goto-char (car bnd))
  5941. (lispy--skip-delimiter-preceding-syntax-backward)
  5942. (cons (point) (cdr bnd))))
  5943. ((looking-at ";;")
  5944. (lispy--bounds-comment))
  5945. ((and (eq major-mode 'python-mode)
  5946. (lispy-bolp))
  5947. (lispy-bounds-python-block))
  5948. (t
  5949. (let ((res (ignore-errors
  5950. (bounds-of-thing-at-point
  5951. (if (looking-at lispy-right)
  5952. 'symbol
  5953. 'sexp)))))
  5954. (if res
  5955. (save-excursion
  5956. (goto-char (cdr res))
  5957. (lispy--in-string-or-comment-p)
  5958. (skip-chars-backward "[.,]")
  5959. (cons (car res) (point)))
  5960. (or
  5961. (ignore-errors
  5962. (bounds-of-thing-at-point 'symbol))
  5963. (and (lispy-looking-back "\" *")
  5964. (save-excursion
  5965. (goto-char (match-beginning 0))
  5966. (lispy--bounds-string)))
  5967. (ignore-errors
  5968. (bounds-of-thing-at-point 'sentence))
  5969. (ignore-errors
  5970. (save-excursion
  5971. (backward-word 1)
  5972. (bounds-of-thing-at-point 'symbol)))
  5973. (ignore-errors
  5974. (save-excursion
  5975. (forward-word 1)
  5976. (bounds-of-thing-at-point 'symbol))))))))))
  5977. (declare-function python-nav-end-of-statement "python")
  5978. (defun lispy--bounds-c-toplevel ()
  5979. "Return a cons of the bounds of a C-like top-level expression."
  5980. (cons
  5981. (point)
  5982. (save-excursion
  5983. (if (looking-at " *\\(\\sw\\|\\s_\\)+ *=")
  5984. (progn
  5985. (python-nav-end-of-statement)
  5986. (point))
  5987. (let ((end (line-end-position))
  5988. pt)
  5989. (while (= ?\\ (char-before end))
  5990. (goto-char end)
  5991. (setq end (line-end-position 2)))
  5992. (while (< (point) end)
  5993. (setq pt (point))
  5994. (if (looking-at " \\*")
  5995. (forward-char 2)
  5996. (forward-sexp 1)))
  5997. (if (<= (point) end)
  5998. (point)
  5999. pt))))))
  6000. (defun lispy--bounds-list ()
  6001. "Return the bounds of smallest list that includes the point."
  6002. (save-excursion
  6003. (lispy--exit-string)
  6004. (when (looking-at lispy-left)
  6005. (forward-char))
  6006. (when (lispy-looking-back lispy-right)
  6007. (backward-char))
  6008. (ignore-errors
  6009. (let (beg end)
  6010. (up-list)
  6011. (setq end (point))
  6012. (backward-list)
  6013. (setq beg (point))
  6014. (cons beg end)))))
  6015. (defun lispy--bounds-string ()
  6016. "Return bounds of current string."
  6017. (unless (lispy--in-comment-p)
  6018. (let ((beg (or (nth 8 (syntax-ppss))
  6019. (and (eq (char-after (point)) ?\")
  6020. (not (eq ?\\ (char-before)))
  6021. (point)))))
  6022. (when (and beg (not (comment-only-p beg (1+ (point)))))
  6023. (ignore-errors
  6024. (cons beg (save-excursion
  6025. (goto-char beg)
  6026. (forward-sexp)
  6027. (point))))))))
  6028. (defun lispy--bounds-comment ()
  6029. "Return bounds of current comment."
  6030. (and (lispy--in-comment-p)
  6031. (save-excursion
  6032. (when (lispy--beginning-of-comment)
  6033. (let ((pt (point)))
  6034. (while (and (lispy--in-comment-p)
  6035. (forward-comment -1)
  6036. (lispy-looking-back "^[[:space:]]*")
  6037. (= 1 (- (count-lines (point) pt)
  6038. (if (bolp) 0 1))))
  6039. (setq pt (point)))
  6040. (goto-char pt))
  6041. (if (looking-at "#|")
  6042. (cons (point)
  6043. (progn
  6044. (comment-forward)
  6045. (point)))
  6046. (let ((beg (lispy--beginning-of-comment))
  6047. (pt (point))
  6048. (col (current-column)))
  6049. (while (and (lispy--in-comment-p)
  6050. (forward-comment 1)
  6051. (lispy--beginning-of-comment)
  6052. (and (= 1 (- (count-lines pt (point))
  6053. (if (bolp) 0 1)))
  6054. ;; count comments starting in different columns
  6055. ;; as separate
  6056. (= col (current-column))
  6057. ;; if there's code in between,
  6058. ;; count comments as separate
  6059. (lispy-looking-back "^\\s-*")))
  6060. (setq pt (point)))
  6061. (goto-char pt)
  6062. (end-of-line)
  6063. (cons beg (point))))))))
  6064. (defun lispy--bounds-outline ()
  6065. "Return bounds of current outline."
  6066. (save-excursion
  6067. (save-match-data
  6068. (condition-case e
  6069. (cons
  6070. (progn
  6071. (org-back-to-heading t)
  6072. (point))
  6073. (progn
  6074. (org-end-of-subtree t t)
  6075. (when (and (org-at-heading-p)
  6076. (not (eobp)))
  6077. (backward-char 1))
  6078. (point)))
  6079. (error
  6080. (if (string-match
  6081. "^Before first headline"
  6082. (error-message-string e))
  6083. (cons (point-min)
  6084. (or (ignore-errors
  6085. (org-speed-move-safe 'outline-next-visible-heading)
  6086. (point))
  6087. (point-max)))
  6088. (signal (car e) (cdr e))))))))
  6089. (defun lispy--outline-beg ()
  6090. "Return the current outline start."
  6091. (save-excursion
  6092. (condition-case nil
  6093. (progn
  6094. (outline-back-to-heading)
  6095. (point))
  6096. (error (point-min)))))
  6097. (defun lispy--outline-end ()
  6098. "Return the current outline end."
  6099. (save-excursion
  6100. (if (outline-next-heading)
  6101. (1- (point))
  6102. (point-max))))
  6103. (defun lispy--string-dwim (&optional bounds)
  6104. "Return the string that corresponds to BOUNDS.
  6105. `lispy--bounds-dwim' is used if BOUNDS is nil."
  6106. (setq bounds (or bounds (lispy--bounds-dwim)))
  6107. (buffer-substring-no-properties (car bounds) (cdr bounds)))
  6108. (declare-function python-info-current-symbol "python")
  6109. (defun lispy--current-function ()
  6110. "Return current function as string."
  6111. (if (region-active-p)
  6112. (let ((str (lispy--string-dwim)))
  6113. (if (string-match "\\`[#'`]*\\(.*?\\)'?\\'" str)
  6114. (match-string 1 str)
  6115. nil))
  6116. (save-excursion
  6117. (if (eq major-mode 'python-mode)
  6118. (let ((bnd (bounds-of-thing-at-point 'symbol)))
  6119. (if bnd
  6120. (lispy--string-dwim bnd)
  6121. (up-list -1)
  6122. (python-info-current-symbol)))
  6123. (lispy--back-to-paren)
  6124. (when (looking-at "(\\([^ \n)]+\\)[ )\n]")
  6125. (match-string-no-properties 1))))))
  6126. (defun lispy--prin1-fancy (x)
  6127. "Return a propertized `prin1-to-string'-ed X."
  6128. (propertize (prin1-to-string x)
  6129. 'face 'font-lock-constant-face))
  6130. ;;* Utilities: movement
  6131. (defun lispy--out-forward (arg)
  6132. "Move outside list forwards ARG times.
  6133. Return nil on failure, (point) otherwise."
  6134. (lispy--exit-string)
  6135. (catch 'break
  6136. (dotimes (_i arg)
  6137. (if (ignore-errors (up-list) t)
  6138. (if buffer-read-only
  6139. (deactivate-mark)
  6140. (unless lispy-ignore-whitespace
  6141. (lispy--remove-gaps)
  6142. (lispy--indent-for-tab)))
  6143. (when (lispy-left-p)
  6144. (forward-list))
  6145. (throw 'break nil)))
  6146. (point)))
  6147. (defun lispy--out-backward (arg)
  6148. "Move outside list forwards ARG times.
  6149. Return nil on failure, t otherwise."
  6150. (let ((oldpt (point))
  6151. newpt)
  6152. (lispy--out-forward arg)
  6153. (when (lispy-right-p)
  6154. (forward-list -1))
  6155. (if (= oldpt (setq newpt (point)))
  6156. nil
  6157. newpt)))
  6158. (defun lispy--back-to-paren ()
  6159. "Move to ( going out backwards."
  6160. (let ((lispy-ignore-whitespace t))
  6161. (lispy--exit-string)
  6162. (while (and (not (looking-at "("))
  6163. (lispy--out-backward 1)))))
  6164. (defun lispy--exit-string ()
  6165. "When in string, go to its beginning."
  6166. (let ((s (syntax-ppss)))
  6167. (when (nth 3 s)
  6168. (goto-char (nth 8 s)))))
  6169. (defun lispy--beginning-of-comment ()
  6170. "Go to beginning of comment on current line."
  6171. (end-of-line)
  6172. (comment-beginning)
  6173. (let ((cs (comment-search-backward (line-beginning-position) t)))
  6174. (or
  6175. (when cs
  6176. (goto-char cs))
  6177. (and (looking-at (concat "^" lispy-outline-header))
  6178. (point)))))
  6179. (defun lispy--comment-search-forward (dir)
  6180. "Search for a first comment in direction DIR.
  6181. Move to the end of line."
  6182. (while (not (lispy--in-comment-p))
  6183. (forward-line dir)
  6184. (end-of-line)))
  6185. (defun lispy--skip-delimiter-preceding-syntax-backward ()
  6186. "Move backwards past syntax that could precede an opening delimiter such as '.
  6187. Specifically, move backwards to the closest whitespace char or opening delimiter
  6188. or to the beginning of the line."
  6189. (re-search-backward (concat "[[:space:]]" "\\|"
  6190. lispy-left "\\|"
  6191. "^"))
  6192. (goto-char (match-end 0)))
  6193. ;;* Utilities: evaluation
  6194. (defun lispy--eval (e-str)
  6195. "Eval E-STR according to current `major-mode'.
  6196. The result is a string."
  6197. (if (string= e-str "")
  6198. ""
  6199. (funcall
  6200. (cond ((memq major-mode lispy-elisp-modes)
  6201. 'lispy--eval-elisp)
  6202. ((or (memq major-mode lispy-clojure-modes)
  6203. (memq major-mode '(nrepl-repl-mode
  6204. cider-clojure-interaction-mode)))
  6205. (require 'le-clojure)
  6206. 'lispy-eval-clojure)
  6207. ((eq major-mode 'scheme-mode)
  6208. (require 'le-scheme)
  6209. 'lispy--eval-scheme)
  6210. ((eq major-mode 'lisp-mode)
  6211. (require 'le-lisp)
  6212. 'lispy--eval-lisp)
  6213. ((eq major-mode 'hy-mode)
  6214. (require 'le-hy)
  6215. 'lispy--eval-hy)
  6216. ((eq major-mode 'python-mode)
  6217. (require 'le-python)
  6218. 'lispy--eval-python)
  6219. ((eq major-mode 'julia-mode)
  6220. (require 'le-julia)
  6221. 'lispy--eval-julia)
  6222. ((eq major-mode 'ruby-mode)
  6223. 'oval-ruby-eval)
  6224. ((eq major-mode 'matlab-mode)
  6225. 'matlab-eval)
  6226. (t (error "%s isn't supported currently" major-mode)))
  6227. e-str)))
  6228. (defun lispy-eval-expression ()
  6229. "Like `eval-expression', but for current language."
  6230. (interactive)
  6231. (let ((form (minibuffer-with-setup-hook
  6232. 'lispy-mode
  6233. (read-from-minibuffer "Eval: "))))
  6234. (lispy-message (lispy--eval form))))
  6235. (defvar lispy-eval-match-data nil)
  6236. (defun lispy--eval-elisp-form (lispy-form lexical)
  6237. "Eval LISPY-FORM and return its value.
  6238. If LEXICAL is t, evaluate using lexical scoping.
  6239. Restore and save `lispy-eval-match-data' appropriately,
  6240. so that no other packages disturb the match data."
  6241. (let (val)
  6242. (unwind-protect
  6243. (progn
  6244. (fset '\, #'identity)
  6245. (set-match-data lispy-eval-match-data)
  6246. (setq val (eval lispy-form lexical))
  6247. (setq lispy-eval-match-data (match-data)))
  6248. (fset '\, nil))
  6249. val))
  6250. (defalias 'lispy-eval-defun-1
  6251. (if (fboundp 'eval-defun-1)
  6252. 'eval-defun-1
  6253. 'elisp--eval-defun-1))
  6254. (defun lispy--eval-elisp (e-str)
  6255. "Eval E-STR as Elisp code."
  6256. (let ((e-sexp (read e-str)))
  6257. (when (consp e-sexp)
  6258. (cond ((and (memq (car e-sexp) '(defvar defcustom defvar-local))
  6259. (consp (cdr e-sexp))
  6260. (boundp (cadr e-sexp)))
  6261. (set (cadr e-sexp) (eval (cl-caddr e-sexp))))
  6262. ((eq (car e-sexp) 'defface)
  6263. (lispy-eval-defun-1 (macroexpand e-sexp)))
  6264. ((memq (car e-sexp) '(\, \,@))
  6265. (setq e-sexp (cadr e-sexp)))))
  6266. (condition-case e
  6267. (prin1-to-string
  6268. (lispy--eval-elisp-form e-sexp lexical-binding))
  6269. (error
  6270. (progn
  6271. (fset '\, nil)
  6272. (let ((es (error-message-string e)))
  6273. (if (and lispy-lax-eval
  6274. (string-match
  6275. "^Symbol's value as variable is void: \\(.*\\)$"
  6276. es))
  6277. (progn
  6278. (setq es (match-string 1 es))
  6279. (set (intern es) nil)
  6280. (message "Caught unbound variable %s, setting it to nil." es))
  6281. (signal (car e) (cdr e)))))))))
  6282. ;;* Utilities: tags
  6283. (defvar lispy-tag-arity
  6284. '((lisp-mode
  6285. (defclass . 1)
  6286. (defconstant . 1)
  6287. (defgeneric . 1)
  6288. (define-condition . 1)
  6289. (define-symbol-macro . 1)
  6290. (defmethod . 2)
  6291. (defpackage . 1)
  6292. (defparameter . 1)
  6293. (defsetf . 1)
  6294. (defstruct . 1)
  6295. (deftype . 1)
  6296. (in-package . 1)
  6297. (load . 1)
  6298. (setq . 2)
  6299. ;; SLIME/SLY specific
  6300. (definterface . 1)
  6301. (defimplementation . 1)
  6302. (define-caller-pattern . 1)
  6303. (define-variable-pattern . 1)
  6304. (define-pattern-substitution . 1)
  6305. (defslimefun . 1)
  6306. (defslyfun . 1))
  6307. (emacs-lisp-mode
  6308. (setq . 2)
  6309. (csetq . 2)
  6310. (setq-default . 2)
  6311. (add-to-list . 2)
  6312. (add-hook . 2)
  6313. (load . 1)
  6314. (load-file . 1)
  6315. (define-key . 3)
  6316. (ert-deftest . 1)
  6317. (declare-function . 1)
  6318. (defalias . 2)
  6319. (defvaralias . 2)
  6320. (defvar-local . 1)
  6321. (make-variable-buffer-local . 1)
  6322. (define-minor-mode . 1)
  6323. (make-obsolete . 2)
  6324. (put . 3)
  6325. (overlay-put . 3)
  6326. (make-obsolete-variable . 1)
  6327. (define-obsolete-function-alias . 1)
  6328. (define-obsolete-variable-alias . 1)
  6329. (eval-after-load . 1)
  6330. (global-set-key . 2)
  6331. (if . 1)
  6332. (when . 1)
  6333. (unless . 1)
  6334. (advice-add . 1)
  6335. (cl-defun . 1)
  6336. (defstruct . 1)
  6337. (cl-defstruct . 1)
  6338. ;; org-mode specific
  6339. (org-defkey . 3)
  6340. ;; use-package specific
  6341. (use-package . 1)
  6342. ;; lispy-specific
  6343. (lispy-defverb . 1)
  6344. ;; misc
  6345. (defhydra . 1)
  6346. (ivy-set-actions . 1)
  6347. (ivy-set-sources . 1)
  6348. (ivy-set-occur . 1)))
  6349. "Alist of tag arities for supported modes.")
  6350. (defun lispy--tag-regexp (&optional mode)
  6351. "Return tag regexp based on MODE."
  6352. (setq mode (or mode major-mode))
  6353. (cond ((eq mode 'lisp-mode)
  6354. (concat
  6355. "^([ \t\n]*\\_<\\(?:cl:\\)?"
  6356. "\\("
  6357. (regexp-opt
  6358. (mapcar (lambda (x) (symbol-name (car x)))
  6359. (cdr (assoc mode lispy-tag-arity))))
  6360. "\\)"
  6361. "\\_>"))
  6362. ((memq major-mode lispy-elisp-modes)
  6363. (concat
  6364. "^([ \t\n]*\\_<"
  6365. "\\("
  6366. (regexp-opt
  6367. (mapcar (lambda (x) (symbol-name (car x)))
  6368. (cdr (assoc mode lispy-tag-arity))))
  6369. "\\)"
  6370. "\\_>"))
  6371. ((memq major-mode lispy-clojure-modes)
  6372. "^(\\([a-z-A-Z0-0]+\\)")
  6373. (t (error "%s isn't supported" mode))))
  6374. (defun lispy--propertize-tag (kind x &optional face)
  6375. "Concatenate KIND and the name of tag X.
  6376. KIND is fontified with `font-lock-keyword-face'.
  6377. The name of X fontified according to FACE.
  6378. FACE can be :keyword, :function or :type. It defaults to 'default."
  6379. (concat
  6380. (if kind (concat (propertize kind 'face 'font-lock-keyword-face) " ") "")
  6381. (propertize (car x) 'face
  6382. (cl-case face
  6383. (:keyword 'font-lock-keyword-face)
  6384. (:type 'font-lock-type-face)
  6385. (:function 'font-lock-function-name-face)
  6386. (:command 'lispy-command-name-face)
  6387. (t 'font-lock-variable-name-face)))))
  6388. (defun lispy--modify-tag (x regex arity-alist file)
  6389. "Re-parse X and modify it accordingly.
  6390. REGEX selects the symbol is 1st place of sexp.
  6391. ARITY-ALIST combines strings that REGEX matches and their arities.
  6392. FILE is the file where X is defined."
  6393. (let* ((overlay (nth 4 x))
  6394. (buffer (find-file-noselect file))
  6395. (start (cond ((overlayp overlay)
  6396. (overlay-start overlay))
  6397. ((vectorp overlay)
  6398. (aref overlay 0))
  6399. (t
  6400. (error "Unexpected")))))
  6401. (with-current-buffer buffer
  6402. (save-excursion
  6403. (goto-char (or start (point-min)))
  6404. (when (looking-at regex)
  6405. (goto-char (match-end 0))
  6406. (let ((tag-head (match-string 1))
  6407. beg arity str)
  6408. (skip-chars-forward " \n")
  6409. (when (setq arity (cdr (assoc (intern tag-head) arity-alist)))
  6410. (setq beg (point))
  6411. (condition-case nil
  6412. (forward-sexp arity)
  6413. (error
  6414. (forward-sexp 1)))
  6415. (setq str (replace-regexp-in-string
  6416. "\n *" " " (buffer-substring-no-properties beg (point))))
  6417. (setcar x str)
  6418. (setcar (nthcdr 1 x) (intern tag-head))))))))
  6419. x)
  6420. (defun lispy--tag-name-lisp (x)
  6421. "Build tag name for Common Lisp tag X."
  6422. (cond ((not (stringp (car x)))
  6423. "tag with no name")
  6424. ((eq (cadr x) 'function)
  6425. (lispy--propertize-tag nil x :function))
  6426. ((eq (cadr x) 'type)
  6427. (lispy--propertize-tag "defstruct" x :type))
  6428. ((eq (cadr x) 'variable)
  6429. (lispy--propertize-tag "defvar" x))
  6430. ((assq (cadr x) (cdr (assoc 'lisp-mode lispy-tag-arity)))
  6431. (lispy--propertize-tag (symbol-name (cadr x)) x))
  6432. (t (car x))))
  6433. (defun lispy--tag-sexp-elisp (x &optional file)
  6434. "Get the actual sexp from semantic tag X in FILE."
  6435. (let ((ov (nth 4 x))
  6436. buf end)
  6437. (if (overlayp ov)
  6438. (setq buf (overlay-buffer ov)
  6439. end (overlay-end ov))
  6440. (if (vectorp ov)
  6441. (setq buf (find-file-noselect
  6442. (or file
  6443. (aref ov 2)))
  6444. end (aref ov 1))
  6445. (error "Unexpected")))
  6446. (with-current-buffer buf
  6447. (save-excursion
  6448. (goto-char end)
  6449. (ignore-errors
  6450. (lispy--preceding-sexp))))))
  6451. (defun lispy--tag-name-elisp (x &optional file)
  6452. "Build tag name for Elisp tag X in FILE."
  6453. (cond ((not (stringp (car x)))
  6454. "tag with no name")
  6455. ((eq (cadr x) 'include)
  6456. (lispy--propertize-tag "require" x))
  6457. ((eq (cadr x) 'package)
  6458. (lispy--propertize-tag "provide" x))
  6459. ((eq (cadr x) 'customgroup)
  6460. (lispy--propertize-tag "defgroup" x))
  6461. ((eq (cadr x) 'function)
  6462. (if (semantic-tag-get-attribute x :user-visible-flag)
  6463. (lispy--propertize-tag nil x :command)
  6464. (lispy--propertize-tag nil x :function)))
  6465. ((eq (cadr x) 'variable)
  6466. (lispy--propertize-tag "defvar" x))
  6467. ((assq (cadr x) (cdr (assoc 'emacs-lisp-mode lispy-tag-arity)))
  6468. (lispy--propertize-tag (symbol-name (cadr x)) x))
  6469. ((and (eq (cadr x) 'code)
  6470. (string= (car x) "define-derived-mode"))
  6471. (let ((sexp (lispy--tag-sexp-elisp x file)))
  6472. (if (and sexp (listp sexp))
  6473. (lispy--propertize-tag
  6474. "define-derived-mode"
  6475. (list (format "%s %s"
  6476. (cadr sexp)
  6477. (cl-caddr sexp))))
  6478. "define-derived-mode")))
  6479. (t (car x))))
  6480. (defun lispy--tag-name-clojure (x)
  6481. "Build tag name for Clojure tag X."
  6482. (cond ((not (stringp (car x))))
  6483. ((eq (cadr x) 'package)
  6484. (lispy--propertize-tag "ns" x))
  6485. ((eq (cadr x) 'function)
  6486. (lispy--propertize-tag nil x :function))
  6487. ((eq (cadr x) 'variable)
  6488. (lispy--propertize-tag "def" x))
  6489. (t (car x))))
  6490. (defun lispy--tag-name (x &optional file)
  6491. "Given a semantic tag X in FILE, return its string representation.
  6492. This is `semantic-tag-name', amended with extra info.
  6493. For example, a `setq' statement is amended with variable name that it uses."
  6494. (let ((str (cond ((memq major-mode lispy-elisp-modes)
  6495. (lispy--tag-name-elisp x file))
  6496. ((memq major-mode lispy-clojure-modes)
  6497. (lispy--tag-name-clojure x))
  6498. ((eq major-mode 'scheme-mode)
  6499. ;; (lispy--tag-name-scheme x)
  6500. (car x))
  6501. ((eq major-mode 'lisp-mode)
  6502. (lispy--tag-name-lisp x))
  6503. (t nil))))
  6504. (when str
  6505. (setq str (replace-regexp-in-string "\t" " " str))
  6506. (let ((width (car lispy-helm-columns)))
  6507. (if (> (length str) width)
  6508. (concat (substring str 0 (- width 4)) " ...")
  6509. str)))))
  6510. (defun lispy--fetch-tags-recursive ()
  6511. "Fetch all tags in current directory recursively."
  6512. (lispy--fetch-tags
  6513. (split-string
  6514. (shell-command-to-string
  6515. (format "find %s -type f -regex \".*\\.%s\" ! -regex \".*\\(\\.git\\|\\.cask\\).*\""
  6516. default-directory
  6517. (file-name-extension (buffer-file-name))))
  6518. "\n"
  6519. t)))
  6520. (defun lispy--fetch-tags-projectile ()
  6521. "Fetch all tags in the projectile directory recursively."
  6522. (require 'projectile)
  6523. (let ((default-directory (projectile-project-root)))
  6524. (lispy--fetch-tags-recursive)))
  6525. (defun lispy--goto (fun)
  6526. "Jump to symbol selected from (FUN)."
  6527. (let ((semantic-on (bound-and-true-p semantic-mode)))
  6528. (semantic-mode 1)
  6529. (let ((candidates (funcall fun)))
  6530. (lispy--select-candidate
  6531. (mapcar #'lispy--format-tag-line candidates)
  6532. #'lispy--action-jump))
  6533. (when (and lispy-no-permanent-semantic
  6534. (not semantic-on))
  6535. (semantic-mode -1))))
  6536. ;;* Utilities: slurping and barfing
  6537. (defun lispy--slurp-forward ()
  6538. "Grow current sexp forward by one sexp."
  6539. (let ((pt (point))
  6540. (char (char-before)))
  6541. (skip-chars-forward " \t")
  6542. (delete-region pt (point))
  6543. (unless (or (lispy-after-string-p "()")
  6544. (lispy-after-string-p "[]")
  6545. (lispy-after-string-p "{}")
  6546. (eolp))
  6547. (insert " "))
  6548. (when (ignore-errors
  6549. (forward-sexp) t)
  6550. (delete-region (1- pt) pt)
  6551. (insert char))))
  6552. (defun lispy--slurp-backward ()
  6553. "Grow current sexp backward by one sexp."
  6554. (let ((pt (point))
  6555. (char (char-after)))
  6556. (backward-sexp)
  6557. (delete-region pt (1+ pt))
  6558. (insert char)
  6559. (backward-char)))
  6560. (defun lispy--barf-forward ()
  6561. "Shrink current sexp forward by one sexp."
  6562. (let ((pt (point))
  6563. (char (char-after)))
  6564. (unless (looking-at "()")
  6565. (forward-char)
  6566. (forward-sexp)
  6567. (delete-region pt (1+ pt))
  6568. (skip-chars-forward " \n ")
  6569. (insert char)
  6570. (backward-char)
  6571. (indent-region pt (point))
  6572. (lispy--reindent 1))))
  6573. (defun lispy--barf-backward ()
  6574. "Shrink current sexp backward by one sexp."
  6575. (let ((pt (point))
  6576. (char (char-before)))
  6577. (unless (lispy-after-string-p "()")
  6578. (backward-char)
  6579. (backward-sexp)
  6580. (skip-chars-backward " \n ")
  6581. (while (lispy--in-comment-p)
  6582. (goto-char (comment-beginning))
  6583. (skip-chars-backward " \n "))
  6584. (delete-region (1- pt) pt)
  6585. (insert char)
  6586. (lispy--indent-region (point) pt))))
  6587. (defun lispy--replace-regexp-in-code (regexp to-string)
  6588. "Replace text matching REGEXP with TO-STRING in whole buffer.
  6589. Ignore the matches in strings and comments."
  6590. (goto-char (point-min))
  6591. (while (re-search-forward regexp nil t)
  6592. (unless (lispy--in-string-or-comment-p)
  6593. (replace-match to-string))))
  6594. ;;* Utilities: source transformation
  6595. (defvar lispy--braces-table
  6596. (let ((table (make-char-table 'syntax-table nil)))
  6597. (modify-syntax-entry ?\{ "(} " table)
  6598. (modify-syntax-entry ?\} "){ " table)
  6599. (modify-syntax-entry ?\[ "(] " table)
  6600. (modify-syntax-entry ?\] ")[ " table)
  6601. (modify-syntax-entry ?\( "() " table)
  6602. (modify-syntax-entry ?\) ")( " table)
  6603. table)
  6604. "Syntax table for paired braces.")
  6605. (defvar scheme-mode-hook)
  6606. (defun lispy--read (str)
  6607. "Read STR including comments and newlines."
  6608. (let* ((deactivate-mark nil)
  6609. (mode major-mode)
  6610. cbnd
  6611. (str (with-temp-buffer
  6612. (funcall mode)
  6613. (insert str)
  6614. ;; ——— ly-raw —————————————————
  6615. (lispy--replace-regexp-in-code "(ly-raw" "(ly-raw raw")
  6616. ;; ——— comments ———————————————
  6617. (goto-char (point-min))
  6618. (while (comment-search-forward (point-max) t)
  6619. (lispy--beginning-of-comment)
  6620. (setq cbnd (cons (point) (line-end-position)))
  6621. (setq str (lispy--string-dwim cbnd))
  6622. (delete-region (car cbnd) (cdr cbnd))
  6623. (insert (format "(ly-raw comment %S)" str)))
  6624. ;; ——— reader macro syntax (LISP)
  6625. (goto-char (point-min))
  6626. (while (re-search-forward "#[a-z][\"(]" nil t)
  6627. (forward-char -1)
  6628. (unless (lispy--in-string-or-comment-p)
  6629. (let ((beg (match-beginning 0))
  6630. rep)
  6631. (forward-sexp 1)
  6632. (setq rep (format "(ly-raw lisp-macro %S)"
  6633. (buffer-substring-no-properties
  6634. beg (point))))
  6635. (delete-region beg (point))
  6636. (insert rep))))
  6637. ;; ——— strings ————————————————
  6638. (goto-char (point-min))
  6639. (while (re-search-forward "\"" nil t)
  6640. (progn
  6641. (setq cbnd (lispy--bounds-string))
  6642. (when cbnd
  6643. (if (or (lispy-after-string-p "ly-raw comment \"")
  6644. (lispy-after-string-p "ly-raw lisp-macro \""))
  6645. (goto-char (cdr cbnd))
  6646. (setq str (lispy--string-dwim cbnd))
  6647. (delete-region (car cbnd) (cdr cbnd))
  6648. (insert (format "(ly-raw string %S)" str))))))
  6649. ;; ——— newlines ———————————————
  6650. (lispy--replace-regexp-in-code "\n" " (ly-raw newline)")
  6651. ;; ——— numbers ————————————————
  6652. (goto-char (point-min))
  6653. (while (re-search-forward "\\b[+-]?[0-9]+\\(?:\\.[0-9]+\\)?\\(?:e[+-]?[0-9]*\\)" nil t)
  6654. (if (setq cbnd (lispy--bounds-string))
  6655. (goto-char (cdr cbnd))
  6656. (let ((s (match-string-no-properties 0)))
  6657. (delete-region (match-beginning 0) (match-end 0))
  6658. (insert (format "(ly-raw float \"%s\")" s)))))
  6659. ;; ——— () —————————————————————
  6660. (goto-char (point-min))
  6661. (while (re-search-forward "\\(?:[^\\]\\|^\\)\\(()\\)" nil t)
  6662. (unless (lispy--in-string-or-comment-p)
  6663. (replace-match "(ly-raw empty)" nil nil nil 1)))
  6664. ;; ——— ? char syntax ——————————
  6665. (goto-char (point-min))
  6666. (while (re-search-forward "\\(?:\\s-\\|\\s(\\)\\?" nil t)
  6667. (unless (lispy--in-string-or-comment-p)
  6668. (let ((pt (point))
  6669. sexp)
  6670. (lispy--skip-elisp-char)
  6671. (setq sexp (buffer-substring-no-properties pt (point)))
  6672. (delete-region (1- pt) (point))
  6673. (insert (format "(ly-raw char %S)" sexp)))))
  6674. ;; ——— \ char syntax (Clojure)—
  6675. (goto-char (point-min))
  6676. (while (re-search-forward "\\\\\\(\\sw\\|space\\|tab\\)\\b" nil t)
  6677. (unless (lispy--in-string-or-comment-p)
  6678. (replace-match (format "(ly-raw clojure-char %S)"
  6679. (substring-no-properties
  6680. (match-string 0)))
  6681. nil t)))
  6682. ;; ——— \ char syntax (LISP)————
  6683. (goto-char (point-min))
  6684. (while (re-search-forward "#\\\\\\(.\\)" nil t)
  6685. (unless (lispy--in-string-or-comment-p)
  6686. (replace-match (format "(ly-raw lisp-char %S)"
  6687. (substring-no-properties
  6688. (match-string 0)))
  6689. nil t)))
  6690. ;; ——— Clojure gensym —————————
  6691. (goto-char (point-min))
  6692. (while (re-search-forward "\\([a-zA-Z][a-zA-z-/_0-9]*#\\)" nil t)
  6693. (unless (lispy--in-string-or-comment-p)
  6694. (replace-match (format "(ly-raw clojure-gensym %S)"
  6695. (match-string-no-properties 1)))))
  6696. ;; ——— #' —————————————————————
  6697. (goto-char (point-min))
  6698. (while (re-search-forward "#'" nil t)
  6699. (unless (lispy--in-string-or-comment-p)
  6700. (forward-sexp)
  6701. (insert ")")
  6702. (replace-match "(ly-raw function ")))
  6703. ;; ——— ,@ —————————————————————
  6704. (goto-char (point-min))
  6705. (while (re-search-forward "\\(?:[^\\]\\|^\\),@" nil t)
  6706. (unless (lispy--in-string-or-comment-p)
  6707. (backward-char 2)
  6708. (let ((beg (point))
  6709. (sxp (ignore-errors (read (current-buffer)))))
  6710. (when (and (consp sxp)
  6711. (eq (car sxp) '\,@))
  6712. (insert ")")
  6713. (goto-char beg)
  6714. (delete-char 2)
  6715. (insert "(ly-raw comma-splice ")))))
  6716. ;; ——— #_ —————————————————————
  6717. (goto-char (point-min))
  6718. (while (re-search-forward "#_[({[]" nil t)
  6719. (backward-char 1)
  6720. (let ((beg (point)))
  6721. (forward-list 1)
  6722. (insert ")")
  6723. (goto-char beg)
  6724. (delete-char -2)
  6725. (insert "(ly-raw clojure-reader-comment ")))
  6726. ;; ——— #{ or { or #( or @( or #?( or #?@( ——————————
  6727. (goto-char (point-min))
  6728. (while (re-search-forward "#object\\[\\|#\\?@(\\|@(\\|#(\\|{\\|#{\\|#::{\\|#\\?(" nil t)
  6729. (let ((class
  6730. (cond ((string= (match-string 0) "#{")
  6731. "clojure-set")
  6732. ((string= (match-string 0) "{")
  6733. "clojure-map")
  6734. ((string= (match-string 0) "#(")
  6735. "clojure-lambda")
  6736. ((string= (match-string 0) "@(")
  6737. "clojure-deref-list")
  6738. ((string= (match-string 0) "#?@(")
  6739. "clojure-reader-conditional-splice")
  6740. ((string= (match-string 0) "#?(")
  6741. "clojure-reader-conditional")
  6742. ((string= (match-string 0) "#::{")
  6743. "clojure-namespaced-map")
  6744. ((string= (match-string 0) "#object[")
  6745. "clojure-object")
  6746. (t
  6747. (error "Unexpected class %s" (match-string 0))))))
  6748. (unless (lispy--in-string-or-comment-p)
  6749. (backward-char 1)
  6750. (save-excursion
  6751. (if (save-match-data
  6752. (looking-at "((ly-raw string"))
  6753. (forward-list 1)
  6754. (with-syntax-table lispy--braces-table
  6755. (forward-list 1)))
  6756. (delete-char -1)
  6757. (insert "))"))
  6758. (delete-region (match-beginning 0) (match-end 0))
  6759. (insert "(ly-raw " class " ("))))
  6760. ;; ——— #1 —————————————————————
  6761. ;; Elisp syntax for circular lists
  6762. (goto-char (point-min))
  6763. (while (re-search-forward "\\(?:^\\|\\s-\\|\\s(\\)\\(#[0-9]+\\)" nil t)
  6764. (unless (lispy--in-string-p)
  6765. (replace-match (format "(ly-raw reference %S)"
  6766. (substring-no-properties
  6767. (match-string 1)))
  6768. nil nil nil 1)))
  6769. ;; ——— ' ——————————————————————
  6770. (goto-char (point-min))
  6771. (while (re-search-forward "'" nil t)
  6772. (unless (lispy--in-string-or-comment-p)
  6773. (backward-char 1)
  6774. (let ((beg (point))
  6775. (sxp (ignore-errors (read (current-buffer)))))
  6776. (when (and (consp sxp)
  6777. (eq (car sxp) 'quote))
  6778. (insert ")")
  6779. (goto-char beg)
  6780. (delete-char 1)
  6781. (insert "(ly-raw quote ")))))
  6782. ;; ——— ` ——————————————————————
  6783. (goto-char (point-min))
  6784. (while (re-search-forward "\\(?:[^\\]\\|^\\)`" nil t)
  6785. (unless (lispy--in-string-or-comment-p)
  6786. (cond ((looking-at lispy-left)
  6787. (delete-char -1)
  6788. (insert "(ly-raw \\` ")
  6789. (forward-list 1)
  6790. (insert ")")
  6791. (backward-list 1)
  6792. (forward-char 7))
  6793. ((looking-at "\\sw\\|\\s_\\|[,@]")
  6794. (let ((beg (point)))
  6795. (forward-sexp 1)
  6796. (insert "\")")
  6797. (goto-char (1- beg))
  6798. (insert "(ly-raw quasiquote \""))))))
  6799. ;; ——— , ——————————————————————
  6800. (lispy--replace-regexp-in-code "\\\\," "(ly-raw comma-symbol)")
  6801. (goto-char (point-min))
  6802. (while (re-search-forward "[^\\]?,[^@\"]" nil t)
  6803. (unless (lispy--in-string-or-comment-p)
  6804. (backward-char 2)
  6805. (if (memq major-mode lispy-clojure-modes)
  6806. (progn
  6807. (delete-char 1)
  6808. (insert "(ly-raw clojure-comma)"))
  6809. (let ((beg (point))
  6810. (sxp (ignore-errors (read (current-buffer)))))
  6811. (when (and (consp sxp)
  6812. (eq (car sxp) '\,))
  6813. (insert ")")
  6814. (goto-char beg)
  6815. (delete-char 1)
  6816. (insert "(ly-raw \\, "))))))
  6817. ;; ——— angle syntax —————————
  6818. ;; used for markers/buffers/windows/overlays
  6819. (goto-char (point-min))
  6820. (while (re-search-forward "#<" nil t)
  6821. (unless (lispy--in-string-or-comment-p)
  6822. (delete-region (match-beginning 0) (match-end 0))
  6823. (insert "(ly-raw angle \"")
  6824. (re-search-forward ">")
  6825. (backward-delete-char 1)
  6826. (insert "\")")))
  6827. ;; ——— cons cell syntax ———————
  6828. (lispy--replace-regexp-in-code " \\. " " (ly-raw dot) ")
  6829. ;; Racket stuff
  6830. (lispy--replace-regexp-in-code "#t" "(ly-raw racket-true)")
  6831. (lispy--replace-regexp-in-code "#f" "(ly-raw racket-false)")
  6832. (goto-char (point-min))
  6833. (while (re-search-forward "#:\\(\\(?:\\sw\\|\\s_\\)+\\)" nil t)
  6834. (unless (lispy--in-string-or-comment-p)
  6835. (replace-match (format "(ly-raw racket-option %s)"
  6836. (match-string 1)))))
  6837. ;; Clojure # in a symbol
  6838. (goto-char (point-min))
  6839. (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" nil t)
  6840. (unless (lispy--in-string-p)
  6841. (when (cl-position ?# (match-string 0))
  6842. (let* ((bnd (lispy--bounds-dwim))
  6843. (str (lispy--string-dwim bnd)))
  6844. (delete-region (car bnd) (cdr bnd))
  6845. (insert (format "(ly-raw symbol %S)" str))))))
  6846. ;; Clojure (. object method)
  6847. (goto-char (point-min))
  6848. (while (re-search-forward "(\\.[\t\n ]" nil t)
  6849. (if (setq cbnd (lispy--bounds-string))
  6850. (goto-char (cdr cbnd))
  6851. (forward-char -1)
  6852. (delete-char -1)
  6853. (insert "(ly-raw clojure-dot)")))
  6854. ;; ——— ———————————————————————
  6855. (buffer-substring-no-properties
  6856. (point-min)
  6857. (point-max)))))
  6858. (ignore-errors
  6859. (read str))))
  6860. (defun lispy--skip-elisp-char ()
  6861. (unless (lispy-after-string-p "?")
  6862. (error "unexpected"))
  6863. (if (looking-at "\\\\")
  6864. (forward-sexp 1)
  6865. (forward-char 1)))
  6866. (defvar lispy--insert-alist
  6867. '((\` . "`")
  6868. (\, . ",")
  6869. (\,@ . ",@")))
  6870. (defun lispy-expr-canonical-p (str)
  6871. "Return t if STR is the same when read and re-inserted."
  6872. (interactive
  6873. (list (lispy--string-dwim (lispy--bounds-list))))
  6874. (let* ((mode major-mode)
  6875. (result (string=
  6876. str
  6877. (with-temp-buffer
  6878. (funcall mode)
  6879. (lispy--insert (lispy--read str))
  6880. (buffer-substring-no-properties
  6881. (point-min)
  6882. (point-max))))))
  6883. (when (called-interactively-p 'any)
  6884. (message "%s" result))
  6885. result))
  6886. (defun lispy--whitespacep (x)
  6887. "Check if X is a whitespace tag."
  6888. (and (consp x)
  6889. (eq (car x) 'ly-raw)
  6890. (or (eq (cadr x) 'newline)
  6891. (eq (cadr x) 'comment))))
  6892. (unless (fboundp 'define-error)
  6893. (defun define-error (name message &optional parent)
  6894. "Define NAME as a new error signal.
  6895. MESSAGE is a string that will be output to the echo area if such an error
  6896. is signaled without being caught by a `condition-case'.
  6897. PARENT is either a signal or a list of signals from which it inherits.
  6898. Defaults to `error'."
  6899. (unless parent (setq parent 'error))
  6900. (let ((conditions
  6901. (if (consp parent)
  6902. (apply #'nconc
  6903. (mapcar
  6904. (lambda (parent)
  6905. (cons parent
  6906. (or (get parent 'error-conditions)
  6907. (error "Unknown signal `%s'" parent))))
  6908. parent))
  6909. (cons parent (get parent 'error-conditions)))))
  6910. (put name 'error-conditions
  6911. (delete-dups (copy-sequence (cons name conditions))))
  6912. (when message (put name 'error-message message)))))
  6913. (define-error 'unsupported-mode-error "Unsupported mode")
  6914. (defun lispy--function-str (fun)
  6915. "Return FUN definition as a string."
  6916. (if (fboundp fun)
  6917. (condition-case e
  6918. (let* ((fnd
  6919. (save-window-excursion
  6920. (save-excursion
  6921. (find-function-noselect fun))))
  6922. (buf (car fnd))
  6923. (pt (cdr fnd)))
  6924. (with-current-buffer buf
  6925. (if (derived-mode-p
  6926. 'emacs-lisp-mode
  6927. 'clojure-mode
  6928. 'lisp-mode
  6929. 'scheme-mode)
  6930. (progn
  6931. (goto-char pt)
  6932. (lispy--string-dwim))
  6933. (signal 'unsupported-mode-error major-mode))))
  6934. (unsupported-mode-error
  6935. (signal (car e) (cdr e)))
  6936. (error
  6937. (prin1-to-string (symbol-function fun))))
  6938. (error "%s isn't bound" fun)))
  6939. (defun lispy--function-parse (str)
  6940. "Extract the function body and args from it's expression STR."
  6941. (let ((body (lispy--read str))
  6942. args)
  6943. (cond ((eq (car body) 'lambda)
  6944. (setq body (cons 'defun body)))
  6945. ((eq (car body) 'closure)
  6946. (setq body `(defun noname ,@(cddr body))))
  6947. ((eq (car body) 'defsubst)
  6948. (setq body (cons 'defun (cdr body)))))
  6949. (cond ((memq (car body) '(defun defmacro))
  6950. (setq body (lispy--whitespace-trim (cdr body))))
  6951. ((eq (car body) 'defalias)
  6952. (let ((name (cadr (cadr (read str)))))
  6953. (setq body
  6954. (cons name (cdr (symbol-function name))))))
  6955. (t
  6956. (error "Expected defun, defmacro, or defalias got %s" (car body))))
  6957. (if (symbolp (car body))
  6958. (setq body (lispy--whitespace-trim (cdr body)))
  6959. (error "Expected function name, got %s" (car body)))
  6960. (if (listp (car body))
  6961. (progn
  6962. (setq args (car body))
  6963. (setq body (lispy--whitespace-trim (cdr body))))
  6964. (error "Expected function arguments, got %s" (car body)))
  6965. ;; skip docstring
  6966. (if (and (listp (car body))
  6967. (eq (caar body) 'ly-raw)
  6968. (eq (cadar body) 'string))
  6969. (setq body (lispy--whitespace-trim (cdr body))))
  6970. ;; skip declare
  6971. (if (and (listp (car body))
  6972. (eq (caar body) 'declare))
  6973. (setq body (lispy--whitespace-trim (cdr body))))
  6974. ;; skip interactive
  6975. (if (and (listp (car body))
  6976. (eq (caar body) 'interactive))
  6977. (setq body (lispy--whitespace-trim (cdr body))))
  6978. (list args body)))
  6979. (defun lispy--flatten-function (fstr e-args)
  6980. "Return body of FSTR with args replaced by E-ARGS."
  6981. (let* ((p (lispy--function-parse fstr))
  6982. (f-args (car p))
  6983. (body (cadr p))
  6984. f-arg)
  6985. (when (equal f-args '(ly-raw empty))
  6986. (setq f-args nil))
  6987. (while (setq f-arg (pop f-args))
  6988. (cond ((eq f-arg '&rest)
  6989. (setq f-arg (pop f-args))
  6990. (when f-args
  6991. (error "&rest must be last"))
  6992. (setq body (lispy--replace body f-arg (cons 'list e-args))))
  6993. ((eq f-arg '&optional)
  6994. (setq f-arg (pop f-args))
  6995. (setq body (lispy--replace body f-arg (pop e-args))))
  6996. (t
  6997. (setq body (lispy--replace body f-arg (pop e-args))))))
  6998. (if (= (length body) 1)
  6999. (setq body (car body))
  7000. (setq body (cons 'progn body)))))
  7001. (defun lispy--fast-insert (f-expr)
  7002. "`lispy--insert' F-EXPR into a temp buffer and return `buffer-string'."
  7003. (insert
  7004. (with-temp-buffer
  7005. (emacs-lisp-mode)
  7006. (lispy--insert f-expr)
  7007. (buffer-string))))
  7008. (defun lispy--case->if (case &optional else)
  7009. "Return an if statement based on CASE statement and ELSE."
  7010. (append
  7011. `(if ,(car case))
  7012. (cond ((null (cdr case)) `((ly-raw newline) nil ,@else))
  7013. ((= (length (cl-remove-if #'lispy--whitespacep (cdr case))) 1)
  7014. (append (cdr case) else))
  7015. (t
  7016. (let ((p (or (cl-position-if-not
  7017. #'lispy--whitespacep
  7018. (cdr case))
  7019. -1)))
  7020. `(,@(cl-subseq (cdr case) 0 p)
  7021. (progn
  7022. (ly-raw newline)
  7023. ,@(cl-subseq (cdr case) p))
  7024. ,@else))))))
  7025. (defun lispy--cases->ifs (cases)
  7026. "Return nested if statements that correspond to CASES."
  7027. (cond ((= 1 (length cases))
  7028. (if (eq (caar cases) t)
  7029. (let ((then (cdar cases)))
  7030. (if (equal (car then) '(ly-raw newline))
  7031. (cdr then)
  7032. then))
  7033. (list (lispy--case->if (car cases)))))
  7034. ((lispy--whitespacep (car cases))
  7035. (cons (car cases)
  7036. (lispy--cases->ifs (cdr cases))))
  7037. (t
  7038. (list
  7039. (lispy--case->if
  7040. (car cases)
  7041. (lispy--cases->ifs (cdr cases)))))))
  7042. (defun lispy--whitespace-trim (x)
  7043. "Trim whitespace from start of X."
  7044. (cl-subseq x (cl-position-if-not #'lispy--whitespacep x)))
  7045. (defun lispy--if->case (cnd then)
  7046. "Return a case statement corresponding to if with CND and THEN."
  7047. (cond ((null then)
  7048. (reverse (lispy--whitespace-trim (reverse cnd))))
  7049. ((and (listp then) (eq (car then) 'progn))
  7050. (append cnd (lispy--whitespace-trim (cdr then))))
  7051. (t
  7052. (append cnd (list then)))))
  7053. (defun lispy--ifs->cases (ifs)
  7054. "Return a list of cases corresponding to nested IFS."
  7055. (let (result ifs1)
  7056. (if (eq (car ifs) 'if)
  7057. (setq ifs1 (cdr ifs))
  7058. (error "Unexpected"))
  7059. (while ifs1
  7060. (let* ((p1 (cl-position-if-not #'lispy--whitespacep ifs1))
  7061. (whitespace1 (cl-subseq ifs1 0 p1))
  7062. (ifs2 (cl-subseq ifs1 (1+ p1)))
  7063. (p2 (cl-position-if-not #'lispy--whitespacep ifs2))
  7064. (cnd (cl-subseq ifs1 p1 (+ p1 (1+ p2))))
  7065. (then (nth p2 ifs2))
  7066. (ifs3 (cl-subseq ifs2 (1+ p2)))
  7067. (p3 (cl-position-if-not #'lispy--whitespacep ifs3))
  7068. (whitespace2 (cl-subseq ifs3 0 p3))
  7069. (ifs4 (and ifs3 (cl-subseq ifs3 p3))))
  7070. (when whitespace1
  7071. (setq result (append result whitespace1)))
  7072. (setq result (append result (list (lispy--if->case cnd then))))
  7073. (setq result (append result whitespace2))
  7074. (if (and (eq (length ifs4) 1)
  7075. (listp (car ifs4))
  7076. (eq (caar ifs4) 'if))
  7077. (setq ifs1 (cdar ifs4))
  7078. (when ifs4
  7079. (setq result (append result
  7080. `((t (ly-raw newline) ,@ifs4)))))
  7081. (setq ifs1 nil))))
  7082. result))
  7083. (defun lispy--raw-quote-maybe (x)
  7084. "Quote X if it's a symbol."
  7085. (cond ((null x)
  7086. nil)
  7087. ((symbolp x)
  7088. `(ly-raw quote ,x))
  7089. (t
  7090. x)))
  7091. (defun lispy--case->cond (expr)
  7092. "Convert EXPR, a `case' expression, to a `cond'."
  7093. (let ((sym-name (cadr expr)))
  7094. (cons 'cond
  7095. (mapcar (lambda (x)
  7096. (if (lispy--whitespacep x)
  7097. x
  7098. (if (eq (car x) t)
  7099. x
  7100. (cons (list 'eq sym-name
  7101. (lispy--raw-quote-maybe (car x)))
  7102. (cdr x)))))
  7103. (cddr expr)))))
  7104. (defun lispy--replace (lst from to)
  7105. "Recursively replace elements in LST from FROM to TO."
  7106. (cond ((eq lst from)
  7107. to)
  7108. ((not (consp lst))
  7109. lst)
  7110. (t
  7111. (cons
  7112. (lispy--replace (car lst) from to)
  7113. (lispy--replace (cdr lst) from to)))))
  7114. ;;* Utilities: error reporting
  7115. (defun lispy-complain (msg)
  7116. "Display MSG if `lispy-verbose' is t."
  7117. (when (and lispy-verbose (null noninteractive))
  7118. (message "%s: %s"
  7119. (propertize
  7120. (prin1-to-string
  7121. this-command)
  7122. 'face 'font-lock-keyword-face)
  7123. msg)
  7124. nil))
  7125. ;;* Utilities: rest
  7126. (defun lispy--indent-region (beg end)
  7127. "Indent region BEG END without reporting progress."
  7128. (save-excursion
  7129. (setq end (copy-marker end))
  7130. (goto-char beg)
  7131. (while (< (point) end)
  7132. (or (and (bolp) (eolp))
  7133. (indent-according-to-mode))
  7134. (forward-line 1))
  7135. (move-marker end nil)))
  7136. (defvar lispy-no-indent-modes '(minibuffer-inactive-mode
  7137. comint-mode)
  7138. "List of major modes where `indent-for-tab-command' should not be used.
  7139. `lispy--indent-for-tab' will do nothing if the current mode or any of its parent
  7140. modes is in this list.")
  7141. (defun lispy--indent-for-tab ()
  7142. "Call `indent-for-tab-command'."
  7143. (unless (or (memq major-mode lispy-no-indent-modes)
  7144. (apply #'derived-mode-p lispy-no-indent-modes)
  7145. (= 0 (buffer-size)))
  7146. (let ((tab-always-indent t))
  7147. (lispy-flet (message (&rest _x))
  7148. (indent-for-tab-command)))))
  7149. (defun lispy--remove-gaps ()
  7150. "Remove dangling `\\s)'."
  7151. (when (and (lispy-right-p)
  7152. (looking-back "[^ \t\n]\\([ \t\n]+\\)\\s)"
  7153. (condition-case nil
  7154. (save-excursion
  7155. (backward-list)
  7156. (point))
  7157. (error (point-min))))
  7158. (not (eq ?\\ (aref (match-string 0) 0))))
  7159. (unless (save-excursion
  7160. (save-match-data
  7161. (goto-char (match-beginning 1))
  7162. (lispy--in-string-or-comment-p)))
  7163. (delete-region (match-beginning 1)
  7164. (match-end 1)))))
  7165. (defun lispy--surround-region (alpha omega)
  7166. "Surround active region with ALPHA and OMEGA and re-indent."
  7167. (let ((beg (region-beginning))
  7168. (end (region-end)))
  7169. (goto-char end)
  7170. (insert omega)
  7171. (goto-char beg)
  7172. (insert alpha)
  7173. (deactivate-mark)
  7174. (indent-region beg (+ 2 end))))
  7175. (defun lispy--mark (bnd)
  7176. "Mark BND. BND is a cons of beginning and end positions."
  7177. (setq deactivate-mark nil)
  7178. (set-mark (car bnd))
  7179. (goto-char (cdr bnd)))
  7180. (defun lispy--space-unless (context)
  7181. "Insert one space.
  7182. Unless inside string or comment, or `looking-back' at CONTEXT."
  7183. (let ((inhibit-field-text-motion t))
  7184. (unless (or lispy-no-space
  7185. (bolp)
  7186. (and (window-minibuffer-p)
  7187. (eq (point) (minibuffer-prompt-end)))
  7188. (lispy--in-string-or-comment-p)
  7189. (lispy-looking-back context))
  7190. (insert " "))))
  7191. (defun lispy--delimiter-space-unless (preceding-syntax-alist)
  7192. "Like `lispy--space-unless' but use PRECEDING-SYNTAX-ALIST for decision.
  7193. PRECEDING-SYNTAX-ALIST should be an alist of `major-mode' to a list of regexps.
  7194. When `looking-back' at any of these regexps, whitespace, or a delimiter, do not
  7195. insert a space."
  7196. (lispy--space-unless
  7197. (concat "^\\|\\s-\\|" lispy-left
  7198. (lispy--preceding-syntax preceding-syntax-alist "\\|"))))
  7199. (defun lispy--reindent (&optional arg)
  7200. "Reindent current sexp. Up-list ARG times before that."
  7201. (cond ((region-active-p)
  7202. (indent-region (region-beginning)
  7203. (region-end)))
  7204. (arg
  7205. (lispy-save-excursion
  7206. (lispy--out-forward arg)
  7207. (backward-list)
  7208. (indent-sexp)))
  7209. ((lispy-right-p)
  7210. (save-excursion
  7211. (backward-list)
  7212. (indent-sexp)))
  7213. ((lispy-left-p)
  7214. (indent-sexp))
  7215. (t
  7216. (save-excursion
  7217. (lispy--out-forward 1)
  7218. (backward-list)
  7219. (indent-sexp)))))
  7220. (defun lispy--delete ()
  7221. "Delete one sexp."
  7222. (unless (lispy-left-p)
  7223. (error "Bad position"))
  7224. (let ((bnd (lispy--bounds-list)))
  7225. (delete-region (car bnd) (cdr bnd))
  7226. (cond ((looking-at (concat "\n+" lispy-left))
  7227. (delete-region (match-beginning 0)
  7228. (1- (match-end 0))))
  7229. ((looking-at "\n\n+"))
  7230. ((looking-at "\\([ ]*\\)\n")
  7231. (delete-region (match-beginning 1)
  7232. (match-end 1)))
  7233. ((looking-at lispy-right))
  7234. ((eolp))
  7235. (t
  7236. (just-one-space)
  7237. (when (lispy-after-string-p "( ")
  7238. (backward-delete-char 1))))))
  7239. (defun lispy--current-tag ()
  7240. "Forward to `semantic-current-tag'.
  7241. Try to refresh if nil is returned."
  7242. (save-excursion
  7243. (lispy-beginning-of-defun)
  7244. (let ((tag (semantic-current-tag)))
  7245. (setq tag
  7246. (or (and tag (lispy--tag-name tag))
  7247. (semantic-tag-name tag)
  7248. (when (looking-at "(def")
  7249. (goto-char (match-end 0))
  7250. (forward-sexp 2)
  7251. (backward-char 1)
  7252. (thing-at-point 'sexp))
  7253. (lispy--fancy-tag)))
  7254. (when tag
  7255. (concat "\\b" (regexp-quote tag) " ")))))
  7256. (defun lispy--fancy-tag ()
  7257. "Return a fancy tag name using `lispy-tag-arity'."
  7258. (let ((arity-alist (cdr (assoc major-mode lispy-tag-arity)))
  7259. (regex (lispy--tag-regexp)))
  7260. (if (looking-at regex)
  7261. (progn
  7262. (goto-char (match-end 0))
  7263. (let ((tag-head (match-string 1))
  7264. beg arity)
  7265. (skip-chars-forward " \n")
  7266. (if (setq arity (cdr (assoc (intern tag-head) arity-alist)))
  7267. (progn
  7268. (setq beg (point))
  7269. (condition-case nil
  7270. (forward-sexp arity)
  7271. (error
  7272. (forward-sexp 1)))
  7273. (concat tag-head " "
  7274. (replace-regexp-in-string
  7275. "\n" " " (buffer-substring-no-properties beg (point)))))
  7276. tag-head)))
  7277. (save-excursion
  7278. (forward-char 1)
  7279. (thing-at-point 'sexp)))))
  7280. (defvar helm-update-blacklist-regexps)
  7281. (defvar helm-candidate-number-limit)
  7282. (defvar lispy-tag-history nil
  7283. "History for tags.")
  7284. (defvar lispy-select-candidate-mode-map
  7285. (let ((map (make-sparse-keymap)))
  7286. (define-key map (kbd "C-.") 'ivy-done)
  7287. map))
  7288. (defun lispy--select-candidate (candidates action)
  7289. "Select from CANDIDATES list with `helm'.
  7290. ACTION is called for the selected candidate."
  7291. (let (strs)
  7292. (cond ((eq lispy-completion-method 'helm)
  7293. (require 'helm-help)
  7294. ;; allows restriction with space
  7295. (require 'helm-multi-match)
  7296. (let (helm-update-blacklist-regexps
  7297. helm-candidate-number-limit)
  7298. (helm :sources
  7299. `((name . "semantic tags")
  7300. (candidates . ,candidates)
  7301. (action . ,action))
  7302. :preselect (lispy--current-tag)
  7303. :buffer "*lispy-goto*")))
  7304. ((progn
  7305. (setq strs (mapcar #'car candidates))
  7306. (eq lispy-completion-method 'ivy))
  7307. (ivy-read "tag: " strs
  7308. :keymap lispy-select-candidate-mode-map
  7309. :require-match t
  7310. :preselect (lispy--current-tag)
  7311. :action (lambda (x)
  7312. (funcall action
  7313. (cdr (assoc x candidates))))
  7314. :history 'lispy-tag-history
  7315. :caller 'lispy-goto))
  7316. (t
  7317. (let ((res
  7318. (cl-case lispy-completion-method
  7319. (ido
  7320. (ido-completing-read "tag: " strs))
  7321. (t
  7322. (completing-read "tag: " strs)))))
  7323. (funcall action (cdr (assoc res candidates))))))))
  7324. (defun lispy--action-jump (tag)
  7325. "Jump to TAG."
  7326. (if (eq (length tag) 3)
  7327. (with-selected-window (if (eq lispy-completion-method 'ivy)
  7328. (ivy--get-window ivy-last)
  7329. (selected-window))
  7330. (push-mark)
  7331. (find-file (cadr tag))
  7332. (goto-char
  7333. (let ((ov (cl-caddr tag)))
  7334. (if (overlayp ov)
  7335. (overlay-start ov)
  7336. (aref ov 0))))
  7337. (when (and (memq major-mode lispy-clojure-modes)
  7338. (not (looking-at "(")))
  7339. (forward-char -1))
  7340. (require 'find-func)
  7341. (recenter find-function-recenter-line)
  7342. (lispy--ensure-visible))
  7343. (error "Unexpected tag: %S" tag)))
  7344. (defun lispy--recenter-bounds (bnd)
  7345. "Make sure BND is visible in window.
  7346. BND is a cons of start and end points."
  7347. (cond ((> (count-lines (car bnd) (cdr bnd))
  7348. (window-height)))
  7349. ((< (car bnd) (window-start))
  7350. (save-excursion
  7351. (goto-char (car bnd))
  7352. (recenter 0)))
  7353. ((> (cdr bnd) (window-end))
  7354. (save-excursion
  7355. (goto-char (cdr bnd))
  7356. (recenter -1)))))
  7357. (defun lispy--prin1-to-string (expr offset mode)
  7358. "Return the string representation of EXPR.
  7359. EXPR is indented first, with OFFSET being the column position of
  7360. the first character of EXPR.
  7361. MODE is the major mode for indenting EXPR."
  7362. (let ((lif lisp-indent-function))
  7363. (with-temp-buffer
  7364. (funcall mode)
  7365. (dotimes (_i offset)
  7366. (insert ?\ ))
  7367. (let ((lisp-indent-function lif))
  7368. (lispy--insert expr))
  7369. (buffer-substring-no-properties
  7370. (+ (point-min) offset)
  7371. (point-max)))))
  7372. (defun lispy--splice-to-str (sexp)
  7373. "Return the printed representation of SEXP.
  7374. The outer delimiters are stripped."
  7375. (if sexp
  7376. (substring
  7377. (prin1-to-string sexp) 1 -1)
  7378. ""))
  7379. (defun lispy--insert (expr)
  7380. "Insert the EXPR read by `lispy--read'."
  7381. (let ((start-pt (point))
  7382. beg
  7383. sxp type)
  7384. (prin1 expr (current-buffer))
  7385. (save-restriction
  7386. (narrow-to-region start-pt (point))
  7387. (goto-char (point-min))
  7388. (while (and (re-search-forward "(ly-raw" nil t)
  7389. (setq beg (match-beginning 0)))
  7390. (goto-char beg)
  7391. (setq sxp (ignore-errors (read (current-buffer))))
  7392. (setq type (cadr sxp))
  7393. (cl-case type
  7394. (newline
  7395. (delete-region beg (point))
  7396. (delete-char
  7397. (- (skip-chars-backward " ")))
  7398. (insert "\n"))
  7399. ((string comment symbol float quasiquote)
  7400. (delete-region beg (point))
  7401. (insert (cl-caddr sxp)))
  7402. (comma-symbol
  7403. (delete-region beg (point))
  7404. (insert "\\,"))
  7405. (ignore
  7406. (delete-region beg (point))
  7407. (backward-delete-char 1))
  7408. (raw
  7409. (delete-region beg (point))
  7410. (prin1 (cons 'ly-raw (cddr sxp))
  7411. (current-buffer))
  7412. (backward-list)
  7413. (forward-char 7))
  7414. (quote
  7415. (delete-region beg (point))
  7416. (insert "'")
  7417. (let ((it (cl-caddr sxp)))
  7418. (if it
  7419. (prin1 it (current-buffer))
  7420. (insert "()")))
  7421. (goto-char beg))
  7422. (empty
  7423. (delete-region beg (point))
  7424. (insert "()"))
  7425. (char
  7426. (delete-region beg (point))
  7427. (insert "?" (cl-caddr sxp)))
  7428. (clojure-char
  7429. (delete-region beg (point))
  7430. (insert (cl-caddr sxp)))
  7431. (lisp-char
  7432. (delete-region beg (point))
  7433. (insert (cl-caddr sxp)))
  7434. (lisp-macro
  7435. (delete-region beg (point))
  7436. (insert (cl-caddr sxp)))
  7437. (clojure-gensym
  7438. (delete-region beg (point))
  7439. (insert (cl-caddr sxp)))
  7440. (function
  7441. (delete-region beg (point))
  7442. (insert (format "#'%S" (cl-caddr sxp)))
  7443. (goto-char beg))
  7444. (clojure-dot
  7445. (delete-region beg (point))
  7446. (insert "."))
  7447. (clojure-lambda
  7448. (delete-region beg (point))
  7449. (insert (format "#%S" (cl-caddr sxp)))
  7450. (goto-char beg))
  7451. (clojure-set
  7452. (delete-region beg (point))
  7453. (insert (format "#{%s}" (lispy--splice-to-str (cl-caddr sxp))))
  7454. (goto-char beg))
  7455. (clojure-map
  7456. (delete-region beg (point))
  7457. (insert (format "{%s}" (lispy--splice-to-str (cl-caddr sxp))))
  7458. (goto-char beg))
  7459. (clojure-object
  7460. (delete-region beg (point))
  7461. (insert (format "#object[%s]" (lispy--splice-to-str (cl-caddr sxp))))
  7462. (goto-char beg))
  7463. (clojure-namespaced-map
  7464. (delete-region beg (point))
  7465. (insert (format "#::{%s}" (lispy--splice-to-str (cl-caddr sxp))))
  7466. (goto-char beg))
  7467. (clojure-deref-list
  7468. (delete-region beg (point))
  7469. (insert (format "@(%s)" (lispy--splice-to-str (cl-caddr sxp))))
  7470. (goto-char beg))
  7471. (clojure-reader-conditional-splice
  7472. (delete-region beg (point))
  7473. (insert (format "#?@(%s)" (lispy--splice-to-str (cl-caddr sxp))))
  7474. (goto-char beg))
  7475. (clojure-reader-conditional
  7476. (delete-region beg (point))
  7477. (insert (format "#?(%s)" (lispy--splice-to-str (cl-caddr sxp))))
  7478. (goto-char beg))
  7479. (clojure-reader-comment
  7480. (delete-region beg (point))
  7481. (insert (format "#_%S" (cl-caddr sxp)))
  7482. (goto-char beg))
  7483. (clojure-comma
  7484. (delete-region beg (point))
  7485. (delete-horizontal-space)
  7486. (insert ", "))
  7487. (racket-true
  7488. (delete-region beg (point))
  7489. (insert "#t"))
  7490. (racket-false
  7491. (delete-region beg (point))
  7492. (insert "#f"))
  7493. (racket-option
  7494. (delete-region beg (point))
  7495. (insert (format "#:%S" (cl-caddr sxp))))
  7496. (angle
  7497. (delete-region beg (point))
  7498. (insert (format "#<%s>" (cl-caddr sxp)))
  7499. (goto-char beg))
  7500. (reference
  7501. (delete-region beg (point))
  7502. (insert (cl-caddr sxp)))
  7503. (\`
  7504. (if (> (length sxp) 3)
  7505. (progn
  7506. (goto-char beg)
  7507. (insert "`")
  7508. (delete-region (+ (point) 1)
  7509. (+ (point) 11)))
  7510. (delete-region beg (point))
  7511. (insert "`")
  7512. (prin1 (cl-caddr sxp) (current-buffer)))
  7513. (goto-char beg))
  7514. (\,
  7515. (delete-region beg (point))
  7516. (insert ",")
  7517. (prin1 (cl-caddr sxp) (current-buffer))
  7518. (goto-char beg))
  7519. (comma-splice
  7520. (delete-region beg (point))
  7521. (insert ",@")
  7522. (prin1 (cl-caddr sxp) (current-buffer))
  7523. (goto-char beg))
  7524. (dot
  7525. (delete-region beg (point))
  7526. (insert "."))
  7527. (t (goto-char (1+ beg)))))
  7528. (goto-char (point-min))
  7529. (while (re-search-forward "\\(?:\\s_\\|\\sw\\)\\(\\\\\\?\\)" nil t)
  7530. (replace-match "?" t t nil 1))
  7531. (goto-char (point-min))
  7532. (while (re-search-forward "\\\\\\." nil t)
  7533. (unless (save-match-data
  7534. (lispy--in-string-p))
  7535. (replace-match ".")))
  7536. (goto-char (point-min))
  7537. (while (re-search-forward "[0-9]+\\(\\\\#\\)" nil t)
  7538. (replace-match "#" nil t nil 1))
  7539. (when lispy-do-fill
  7540. (goto-char (point-min))
  7541. (while (re-search-forward " " nil t)
  7542. (cond ((lispy--in-string-p))
  7543. ((lispy--in-comment-p)
  7544. (fill-paragraph)
  7545. (goto-char (cdr (lispy--bounds-comment))))
  7546. ((> (current-column) fill-column)
  7547. (newline-and-indent)))))
  7548. (goto-char (point-max))
  7549. (widen)))
  7550. (when (and (lispy-right-p)
  7551. (not (lispy--in-comment-p)))
  7552. (backward-list)
  7553. (indent-sexp)
  7554. (forward-list)))
  7555. (defvar geiser-active-implementations)
  7556. (defvar clojure-align-forms-automatically)
  7557. (declare-function clojure-align "ext:clojure-mode")
  7558. (defun lispy--normalize-1 ()
  7559. "Normalize/prettify current sexp."
  7560. (when (and (looking-at "(")
  7561. (= (point)
  7562. (save-excursion
  7563. (lispy--out-backward 99)
  7564. (point))))
  7565. (let ((pt (point)))
  7566. (skip-chars-backward " \t")
  7567. (delete-region pt (point))))
  7568. (let* ((bnd (lispy--bounds-dwim))
  7569. (str (lispy--string-dwim bnd))
  7570. (offset (save-excursion
  7571. (goto-char (car bnd))
  7572. (current-column)))
  7573. (was-left (lispy-left-p)))
  7574. (cond ((or (and (memq major-mode lispy-clojure-modes)
  7575. (or (string-match "\\^" str)
  7576. (string-match "~" str)))
  7577. (> (length str) 10000))
  7578. (lispy-from-left
  7579. (indent-sexp)))
  7580. ((looking-at ";;"))
  7581. (t
  7582. (let* ((max-lisp-eval-depth 10000)
  7583. (max-specpdl-size 10000)
  7584. (geiser-active-implementations
  7585. (and (bound-and-true-p geiser-active-implementations)
  7586. (list (car geiser-active-implementations))))
  7587. (res (lispy--sexp-normalize
  7588. (lispy--read str)))
  7589. (new-str (lispy--prin1-to-string res offset major-mode)))
  7590. (unless (string= str new-str)
  7591. (delete-region (car bnd)
  7592. (cdr bnd))
  7593. (insert new-str)
  7594. (when was-left
  7595. (backward-list))))))
  7596. (when (and (memq major-mode lispy-clojure-modes)
  7597. clojure-align-forms-automatically)
  7598. (clojure-align (car bnd) (cdr bnd)))))
  7599. (defun lispy--sexp-trim-leading-newlines (expr comment)
  7600. "Trim leading (ly-raw newline) from EXPR.
  7601. Treat comments differently when COMMENT is t."
  7602. (while (and (consp expr)
  7603. (listp expr)
  7604. (equal (car expr) '(ly-raw newline))
  7605. (not (and comment
  7606. (lispy--raw-comment-p (cadr expr)))))
  7607. (setq expr (cdr expr)))
  7608. expr)
  7609. (defun lispy--sexp-trim-newlines (expr)
  7610. "Trim leading and trailing (ly-raw newline) from EXPR."
  7611. (if (and (consp expr)
  7612. (consp (cdr expr)))
  7613. (nreverse
  7614. (lispy--sexp-trim-leading-newlines
  7615. (nreverse
  7616. (lispy--sexp-trim-leading-newlines expr nil))
  7617. t))
  7618. expr))
  7619. (defun lispy--sexp-trim-trailing-newlines (foo comment)
  7620. "Trim trailing (ly-raw newline) from FOO.
  7621. Treat comments differently when COMMENT is t."
  7622. (if (and (consp foo) (consp (cdr foo)))
  7623. (let ((expr (reverse foo)))
  7624. (while (and (consp expr)
  7625. (listp expr)
  7626. (equal (car expr) '(ly-raw newline))
  7627. (not (and comment
  7628. (lispy--raw-comment-p (cadr expr)))))
  7629. (setq expr (cdr expr)))
  7630. (reverse expr))
  7631. foo))
  7632. (defun lispy--sexp-normalize (foo)
  7633. "Return a pretty version of FOO.
  7634. Only `ly-raw' lists within FOO are manipulated."
  7635. (cond ((null foo)
  7636. nil)
  7637. ((consp foo)
  7638. (cons (lispy--sexp-normalize
  7639. (lispy--sexp-trim-trailing-newlines (car foo) t))
  7640. (lispy--sexp-normalize
  7641. (lispy--sexp-trim-trailing-newlines (cdr foo) t))))
  7642. (t
  7643. foo)))
  7644. (defun lispy--do-replace (from to)
  7645. "Replace first match group of FROM to TO."
  7646. (goto-char (point-min))
  7647. (let (mb me ms)
  7648. (while (and (re-search-forward from nil t)
  7649. (setq mb (match-beginning 1))
  7650. (setq me (match-end 1))
  7651. (setq ms (match-string 1)))
  7652. (goto-char mb)
  7653. (if (or (lispy--in-string-or-comment-p)
  7654. (bolp))
  7655. (goto-char me)
  7656. (delete-region mb me)
  7657. (when (cl-search "\\1" to)
  7658. (setq to (replace-regexp-in-string "\\\\1" ms to)))
  7659. (insert to)))))
  7660. (defun lispy--teleport (beg end endp regionp)
  7661. "Move text from between BEG END to point.
  7662. Leave point at the beginning or end of text depending on ENDP.
  7663. Make text marked if REGIONP is t."
  7664. (let ((str (buffer-substring-no-properties beg end))
  7665. (beg1 (1+ (point)))
  7666. (size (buffer-size))
  7667. (deactivate-mark nil))
  7668. (if (and (>= (point) beg)
  7669. (<= (point) end))
  7670. (progn
  7671. (message "Can't teleport expression inside itself")
  7672. (goto-char beg))
  7673. (goto-char beg)
  7674. (delete-region beg end)
  7675. (when (and (eolp)
  7676. (lispy-bolp))
  7677. (delete-region (line-beginning-position)
  7678. (1+ (point))))
  7679. (when (> beg1 beg)
  7680. (cl-decf beg1 (- size (buffer-size))))
  7681. (goto-char beg1)
  7682. (when (looking-at lispy-left)
  7683. (save-excursion
  7684. (newline-and-indent)))
  7685. (unless (lispy-looking-back "[ ([{]")
  7686. (insert " ")
  7687. (cl-incf beg1))
  7688. (insert str)
  7689. (unless (looking-at "[\n)]")
  7690. (insert "\n")
  7691. (backward-char))
  7692. (lispy-save-excursion
  7693. (lispy--reindent 1)
  7694. (goto-char (1- beg1))
  7695. (indent-sexp))
  7696. (if regionp
  7697. (progn
  7698. (setq deactivate-mark nil)
  7699. (set-mark-command nil)
  7700. (goto-char beg1)
  7701. (when endp
  7702. (exchange-point-and-mark)))
  7703. (unless endp
  7704. (goto-char beg1)
  7705. (skip-chars-forward "'"))))))
  7706. (defun lispy--swap-regions (bnd1 bnd2)
  7707. "Swap buffer regions BND1 and BND2.
  7708. Return a cons of the new text cordinates."
  7709. (when (> (car bnd1) (car bnd2))
  7710. (cl-rotatef bnd1 bnd2))
  7711. (let ((str1 (lispy--string-dwim bnd1))
  7712. (str2 (lispy--string-dwim bnd2)))
  7713. (goto-char (car bnd2))
  7714. (delete-region (car bnd2) (cdr bnd2))
  7715. (insert str1)
  7716. (when (lispy--in-comment-p)
  7717. (unless (eolp)
  7718. (newline-and-indent)))
  7719. (goto-char (car bnd1))
  7720. (delete-region (car bnd1) (cdr bnd1))
  7721. (insert str2)
  7722. (goto-char (car bnd1)))
  7723. (let* ((l1 (- (cdr bnd1) (car bnd1)))
  7724. (l2 (- (cdr bnd2) (car bnd2)))
  7725. (new-beg (+ (car bnd2) (- l2 l1)))
  7726. (new-end (+ new-beg l1)))
  7727. (cons
  7728. (cons (car bnd1) (+ (car bnd1) l2))
  7729. (cons new-beg new-end))))
  7730. (defun lispy--ensure-visible ()
  7731. "Remove overlays hiding point."
  7732. (let ((overlays (overlays-at (point)))
  7733. ov expose)
  7734. (while (setq ov (pop overlays))
  7735. (if (and (invisible-p (overlay-get ov 'invisible))
  7736. (setq expose (overlay-get ov 'isearch-open-invisible)))
  7737. (funcall expose ov)))))
  7738. (defun lispy--delete-pair-in-string (left right)
  7739. "Delete a pair of LEFT and RIGHT in string."
  7740. (let ((bnd (lispy--bounds-string)))
  7741. (when bnd
  7742. (let ((pos (cond ((looking-at left)
  7743. (save-excursion
  7744. (let ((b1 (match-beginning 0))
  7745. (e1 (match-end 0))
  7746. b2 e2)
  7747. (when (re-search-forward right (cdr bnd) t)
  7748. (setq b2 (match-beginning 0)
  7749. e2 (match-end 0))
  7750. (delete-region b2 e2)
  7751. (delete-region b1 e1)
  7752. b1))))
  7753. ((looking-at right)
  7754. (save-excursion
  7755. (let ((b1 (match-beginning 0))
  7756. (e1 (match-end 0))
  7757. b2 e2)
  7758. (when (re-search-backward left (car bnd) t)
  7759. (setq b2 (match-beginning 0)
  7760. e2 (match-end 0))
  7761. (delete-region b1 e1)
  7762. (delete-region b2 e2)
  7763. (+ (point) (- b1 e2)))))))))
  7764. (when pos
  7765. (goto-char pos))))))
  7766. (defvar ediff-temp-indirect-buffer)
  7767. (defun lispy--make-ediff-buffer (buffer ext bnd)
  7768. "Create a copy of BUFFER with EXT added to the name.
  7769. Use only the part bounded by BND."
  7770. (cl-multiple-value-bind (name mode str)
  7771. (with-current-buffer buffer
  7772. (list (concat (buffer-name) ext) major-mode (lispy--string-dwim bnd)))
  7773. (with-current-buffer (get-buffer-create name)
  7774. (funcall mode)
  7775. (insert str "\n")
  7776. (indent-region (point-min) (point-max))
  7777. (require 'ediff-init)
  7778. (setq ediff-temp-indirect-buffer t)
  7779. (list (current-buffer) (point-min) (point-max)))))
  7780. (defvar lispy--edebug-command nil
  7781. "Command that corresponds to currently pressed key.")
  7782. (defvar lispy--cider-debug-command nil
  7783. "Command that corresponds to currently pressed key.")
  7784. (defun lispy--edebug-commandp ()
  7785. "Return true if `this-command-keys' should be forwarded to edebug."
  7786. (when (and (bound-and-true-p edebug-active)
  7787. (= 1 (length (this-command-keys))))
  7788. (let ((char (aref (this-command-keys) 0)))
  7789. (setq lispy--edebug-command
  7790. (cdr (or (assq char edebug-mode-map)
  7791. (assq char global-edebug-map)))))))
  7792. (defvar cider--debug-mode-map)
  7793. (defun lispy--cider-debug-commandp ()
  7794. "Return true if `this-command-keys' should be forwarded to cider-debug."
  7795. (when (and (bound-and-true-p cider--debug-mode)
  7796. (= 1 (length (this-command-keys))))
  7797. (let ((char (aref (this-command-keys) 0)))
  7798. (setq lispy--cider-debug-command
  7799. (cdr (assq char cider--debug-mode-map))))))
  7800. (defvar macrostep-keymap)
  7801. (defvar lispy--compat-cmd nil
  7802. "Store the looked up compat command.")
  7803. (defun lispy--insert-or-call (def plist)
  7804. "Return a lambda to call DEF if position is special.
  7805. Otherwise call `self-insert-command'.
  7806. PLIST currently accepts:
  7807. - :disable with a mode to disable
  7808. - :override with a lambda to conditionally abort command"
  7809. (let ((disable (plist-get plist :disable))
  7810. (override (plist-get plist :override))
  7811. (inserter (plist-get plist :inserter)))
  7812. `(lambda ()
  7813. ,(format "Call `%s' when special, self-insert otherwise.\n\n%s"
  7814. (symbol-name def) (documentation def))
  7815. (interactive)
  7816. ,@(when disable `((,disable -1)))
  7817. (unless (looking-at lispy-outline)
  7818. (lispy--ensure-visible))
  7819. (cond ,@(cond ((null override) nil)
  7820. ((functionp override)
  7821. `((funcall ,override)))
  7822. ((eq (car override) 'cond)
  7823. (cdr override))
  7824. (t
  7825. (error "Unexpected :override %S" override)))
  7826. ,@(when (memq 'edebug lispy-compat)
  7827. '(((lispy--edebug-commandp)
  7828. (call-interactively
  7829. lispy--edebug-command))))
  7830. ,@(when (memq 'cider lispy-compat)
  7831. '(((lispy--cider-debug-commandp)
  7832. (call-interactively
  7833. lispy--cider-debug-command))))
  7834. ,@(when (memq 'god-mode lispy-compat)
  7835. '(((and (or (bound-and-true-p god-global-mode)
  7836. (bound-and-true-p god-local-mode)))
  7837. (call-interactively 'god-mode-self-insert))))
  7838. ,@(when (memq 'macrostep lispy-compat)
  7839. '(((and (bound-and-true-p macrostep-mode)
  7840. (setq lispy--compat-cmd (lookup-key macrostep-keymap (this-command-keys))))
  7841. (call-interactively lispy--compat-cmd))))
  7842. ,@(when (memq 'magit-blame-mode lispy-compat)
  7843. '(((and (bound-and-true-p magit-blame-mode)
  7844. (setq lispy--compat-cmd (lookup-key magit-blame-mode-map (this-command-keys))))
  7845. (call-interactively lispy--compat-cmd))))
  7846. ((region-active-p)
  7847. (call-interactively ',def))
  7848. ((lispy--in-string-or-comment-p)
  7849. (setq this-command 'self-insert-command)
  7850. (call-interactively 'self-insert-command))
  7851. ((or (lispy-left-p)
  7852. (lispy-right-p)
  7853. (and (lispy-bolp)
  7854. (or (looking-at lispy-outline-header)
  7855. (looking-at lispy-outline))))
  7856. (call-interactively ',def))
  7857. (t
  7858. (setq this-command 'self-insert-command)
  7859. (call-interactively
  7860. (quote
  7861. ,(or inserter
  7862. 'self-insert-command))))))))
  7863. (defun lispy--quote-maybe (x)
  7864. "Quote X if it's a symbol."
  7865. (cond ((null x)
  7866. nil)
  7867. ((or (symbolp x) (consp x))
  7868. (list 'quote x))
  7869. (t
  7870. x)))
  7871. (defun lispy--pcase-pattern-matcher (pattern)
  7872. "Turn pcase PATTERN into a predicate.
  7873. For any given pcase PATTERN, return a predicate P that returns
  7874. non-nil for any EXP when and only when PATTERN matches EXP. In
  7875. that case, P returns a list of the form (bindings . BINDINGS) as
  7876. non-nil value, where BINDINGS is a list of bindings that pattern
  7877. matching with PATTERN would actually establish in a pcase branch."
  7878. (let ((arg (make-symbol "exp")))
  7879. `(lambda (,arg)
  7880. ,(pcase--u
  7881. `((,(pcase--match arg (pcase--macroexpand pattern))
  7882. ,(lambda (vars)
  7883. `(cons
  7884. 'progn
  7885. (list
  7886. ,@(nreverse (mapcar
  7887. (lambda (binding)
  7888. `(list 'setq ',(car binding)
  7889. (lispy--quote-maybe ,(cdr binding))))
  7890. vars)))))))))))
  7891. (defun lispy--setq-expression ()
  7892. "Return the smallest list to contain point.
  7893. Return an appropriate `setq' expression when in `let', `dolist',
  7894. `labels', `cond'."
  7895. (save-excursion
  7896. (let ((origin (point))
  7897. (lispy-ignore-whitespace t)
  7898. (tsexp
  7899. (ignore-errors
  7900. (cond ((lispy-left-p)
  7901. (forward-list))
  7902. ((lispy-right-p))
  7903. ((region-active-p)
  7904. (when (eq (point) (region-beginning))
  7905. (exchange-point-and-mark)))
  7906. (t
  7907. (up-list)))
  7908. (lispy--preceding-sexp))))
  7909. (when tsexp
  7910. (lispy-different)
  7911. (cond
  7912. ((looking-back "(\\(?:lexical-\\)?let\\(?:\\*\\|-when-compile\\)?[ \t\n]*"
  7913. (line-beginning-position 0))
  7914. (cons 'setq
  7915. (cl-mapcan
  7916. (lambda (x) (unless (listp x) (list x nil)))
  7917. tsexp)))
  7918. ((lispy-after-string-p "(dolist ")
  7919. `(lispy--dolist-item-expr ',tsexp))
  7920. ((and (consp tsexp)
  7921. (eq (car tsexp) 'lambda)
  7922. (eq (length (cadr tsexp)) 1)
  7923. (looking-back "(map\\sw* +"
  7924. (line-beginning-position)))
  7925. `(lispy--mapcar-item-expr ,tsexp
  7926. ,(save-excursion
  7927. (lispy-different)
  7928. (read (current-buffer)))))
  7929. ;; point moves
  7930. ((progn
  7931. (lispy--out-backward 1)
  7932. (looking-back
  7933. "(\\(?:lexical-\\)?let\\(?:\\*\\|-when-compile\\)?[ \t\n]*"
  7934. (line-beginning-position 0)))
  7935. (cons
  7936. (if (eq major-mode 'scheme-mode)
  7937. 'define
  7938. 'setq)
  7939. tsexp))
  7940. ((looking-back
  7941. "(\\(?:cl-\\)?labels[ \t\n]*"
  7942. (line-beginning-position 0))
  7943. (cons 'defun tsexp))
  7944. ((looking-at
  7945. "(cond\\b")
  7946. (let ((re tsexp))
  7947. `(if ,(car re)
  7948. (progn
  7949. ,@(cdr re))
  7950. lispy--eval-cond-msg)))
  7951. ((looking-at "(pcase\\s-*")
  7952. (goto-char (match-end 0))
  7953. (if (eval (pcase--expand (lispy--read (lispy--string-dwim))
  7954. `((,(car tsexp) t))))
  7955. `(progn
  7956. ,(funcall (lispy--pcase-pattern-matcher (car tsexp))
  7957. (eval (read (lispy--string-dwim))))
  7958. "pcase: t")
  7959. "pcase: nil"))
  7960. ((and (looking-at "(\\(?:cl-\\)?\\(?:defun\\|defmacro\\)")
  7961. (save-excursion
  7962. (lispy-flow 1)
  7963. (eq (point) origin)))
  7964. (let* ((fn-name (save-excursion
  7965. (forward-char)
  7966. (forward-sexp 2)
  7967. (lispy--preceding-sexp)))
  7968. (int-form
  7969. (and (fboundp fn-name)
  7970. (interactive-form fn-name)))
  7971. (int-form (when (eq (car int-form) 'interactive)
  7972. (cond ((listp (cadr int-form))
  7973. (cadr int-form))
  7974. ((equal (cadr int-form) "p")
  7975. ''(1))))))
  7976. (if int-form
  7977. `(lispy-destructuring-setq ,tsexp
  7978. ,int-form)
  7979. `(progn
  7980. ,@(mapcar
  7981. (lambda (x)
  7982. (list 'setq x nil))
  7983. (delq '&key (delq '&optional (delq '&rest tsexp))))))))
  7984. (t tsexp))))))
  7985. (defun lispy--find-unmatched-delimiters (beg end)
  7986. "Return the positions of unmatched delimiters between BEG and END.
  7987. When the region is a greater size than `lispy-safe-threshold', it will not be
  7988. checked and nil will be returned."
  7989. (if (> (- end beg) lispy-safe-threshold)
  7990. nil
  7991. (save-excursion
  7992. (goto-char beg)
  7993. (let ((lispy-delimiters (concat (substring lispy-right 0 -1)
  7994. "\""
  7995. (substring lispy-left 1)))
  7996. matched-left-quote-p
  7997. string-bounds
  7998. string-end
  7999. comment-end
  8000. left-positions
  8001. right-positions)
  8002. (while (re-search-forward lispy-delimiters end t)
  8003. (let* ((match-beginning (match-beginning 0))
  8004. (matched-delimiter (buffer-substring-no-properties
  8005. match-beginning
  8006. (match-end 0))))
  8007. (cond
  8008. ((and lispy-safe-actions-ignore-strings
  8009. (save-excursion
  8010. (goto-char match-beginning)
  8011. (setq string-bounds (lispy--bounds-string))
  8012. (setq string-end (cdr string-bounds))))
  8013. (setq matched-left-quote-p (= (1- (point))
  8014. (car string-bounds)))
  8015. (cond ((< (1- string-end) end)
  8016. (goto-char string-end)
  8017. ;; when skipping strings, will only match right quote
  8018. ;; if left quote is not in the region
  8019. (when (not matched-left-quote-p)
  8020. (push (1- string-end) right-positions)))
  8021. (t
  8022. (when matched-left-quote-p
  8023. ;; unmatched left quote
  8024. (push match-beginning left-positions))
  8025. (goto-char end))))
  8026. ((and lispy-safe-actions-ignore-comments
  8027. (save-excursion
  8028. (goto-char match-beginning)
  8029. (setq comment-end (cdr (lispy--bounds-comment)))))
  8030. (if (< comment-end end)
  8031. (goto-char comment-end)
  8032. (goto-char end)))
  8033. (t
  8034. (unless (looking-back "\\\\." (- (point) 2))
  8035. (if (or (string-match lispy-left matched-delimiter)
  8036. (and (string= matched-delimiter "\"")
  8037. (lispy--in-string-p)))
  8038. (push match-beginning left-positions)
  8039. (if (> (length left-positions) 0)
  8040. (pop left-positions)
  8041. (push match-beginning right-positions))))))))
  8042. (nreverse (append left-positions right-positions))))))
  8043. (defun lispy--maybe-split-safe-region (beg end &optional end-unsafe-p)
  8044. "Return a list of regions between BEG and END that are safe to delete.
  8045. It is expected that there are no unmatched delimiters in between BEG and END.
  8046. Split the region if deleting it would pull unmatched delimiters into a comment.
  8047. Specifically, split the region if all of the following are true:
  8048. - `lispy-safe-actions-no-pull-delimiters-into-comments' is non-nil
  8049. - BEG is inside a comment
  8050. - END is not in a comment
  8051. - Either there are unmatched delimiters on the line after END or END-UNSAFE-P is
  8052. non-nil
  8053. Otherwise, just return a list with the initial region. The regions are returned
  8054. in reverse order so that they can be easily deleted without recalculation."
  8055. (if (and lispy-safe-actions-no-pull-delimiters-into-comments
  8056. ;; check that BEG is inside a comment
  8057. ;; `lispy--in-comment-p' returns t at comment start which is
  8058. ;; unwanted here
  8059. (and (save-excursion
  8060. (nth 4 (syntax-ppss beg))))
  8061. (save-excursion
  8062. (goto-char end)
  8063. ;; check that END is not inside or a comment and that the
  8064. ;; following line has unmatched delimiters or has been specified
  8065. ;; as unsafe to pull into a comment
  8066. (and (not (lispy--in-comment-p))
  8067. (or end-unsafe-p
  8068. (lispy--find-unmatched-delimiters
  8069. end
  8070. (line-end-position))))))
  8071. ;; exclude newline; don't pull END into a comment
  8072. (let ((comment-end-pos (save-excursion
  8073. (goto-char beg)
  8074. (cdr (lispy--bounds-comment)))))
  8075. (list (cons (1+ comment-end-pos) end)
  8076. (cons beg comment-end-pos)))
  8077. (list (cons beg end))))
  8078. (defun lispy--find-safe-regions (beg end)
  8079. "Return a list of regions between BEG and END that are safe to delete.
  8080. The regions are returned in reverse order so that they can be easily deleted
  8081. without recalculation."
  8082. (let ((unmatched-delimiters (lispy--find-unmatched-delimiters beg end))
  8083. (maybe-safe-pos beg)
  8084. safe-regions)
  8085. (dolist (unsafe-pos unmatched-delimiters)
  8086. (unless (= maybe-safe-pos unsafe-pos)
  8087. (setq safe-regions
  8088. (nconc (lispy--maybe-split-safe-region maybe-safe-pos unsafe-pos
  8089. t)
  8090. safe-regions)))
  8091. (setq maybe-safe-pos (1+ unsafe-pos)))
  8092. (setq safe-regions
  8093. (nconc (lispy--maybe-split-safe-region maybe-safe-pos end)
  8094. safe-regions))))
  8095. (defun lispy--maybe-safe-delete-region (beg end)
  8096. "Delete the region from BEG to END.
  8097. If `lispy-safe-delete' is non-nil, exclude unmatched delimiters."
  8098. (if lispy-safe-delete
  8099. (let ((safe-regions (lispy--find-safe-regions beg end)))
  8100. (dolist (safe-region safe-regions)
  8101. (delete-region (car safe-region) (cdr safe-region))))
  8102. (delete-region beg end)))
  8103. (defun lispy--maybe-safe-kill-region (beg end)
  8104. "Kill the region from BEG to END.
  8105. If `lispy-safe-delete' is non-nil, exclude unmatched delimiters."
  8106. (if lispy-safe-delete
  8107. (let ((safe-regions (lispy--find-safe-regions beg end))
  8108. safe-strings)
  8109. (dolist (safe-region safe-regions)
  8110. (push (lispy--string-dwim safe-region) safe-strings)
  8111. (delete-region (car safe-region) (cdr safe-region)))
  8112. (kill-new (apply #'concat safe-strings)))
  8113. (kill-region beg end)))
  8114. (defun lispy--maybe-safe-region (beg end)
  8115. "Return the text from BEG to END.
  8116. If `lispy-safe-copy' is non-nil, exclude unmatched delimiters."
  8117. (if lispy-safe-copy
  8118. (let ((safe-regions (lispy--find-safe-regions beg end))
  8119. safe-strings)
  8120. (dolist (safe-region safe-regions)
  8121. (push (lispy--string-dwim safe-region) safe-strings))
  8122. (apply #'concat safe-strings))
  8123. (lispy--string-dwim (cons beg end))))
  8124. (defvar lispy--pairs
  8125. '(("(" . ")")
  8126. ("[" . "]")
  8127. ("{" . "}")))
  8128. (defun lispy--balance (text)
  8129. "Return TEXT with unmatched delimiters added to the beginning or end.
  8130. This does not attempt to deal with unbalanced double quotes as it is not always
  8131. possible to infer which side the missing quote should be added to."
  8132. (let ((old-major-mode major-mode))
  8133. (with-temp-buffer
  8134. (funcall old-major-mode)
  8135. (insert text)
  8136. (let ((unmatched-positions
  8137. (lispy--find-unmatched-delimiters (point-min) (point-max)))
  8138. add-to-beginning
  8139. add-to-end
  8140. delim)
  8141. (dolist (pos unmatched-positions)
  8142. (setq delim (buffer-substring pos (1+ pos)))
  8143. (cond ((string-match lispy-left delim)
  8144. (push (cdr (assoc delim lispy--pairs))
  8145. add-to-end))
  8146. ((string-match lispy-right delim)
  8147. (push (car (rassoc delim lispy--pairs))
  8148. add-to-beginning))))
  8149. (when add-to-beginning
  8150. (goto-char (point-min))
  8151. (insert (apply #'concat add-to-beginning)))
  8152. (when add-to-end
  8153. (goto-char (point-max))
  8154. (when (and lispy-safe-actions-no-pull-delimiters-into-comments
  8155. (lispy--in-comment-p))
  8156. (push "\n" add-to-end))
  8157. (insert (apply #'concat add-to-end)))
  8158. (buffer-substring (point-min) (point-max))))))
  8159. (defun lispy--maybe-safe-current-kill ()
  8160. "Return the most recent kill.
  8161. If `lispy-safe-paste' is non-nil, any unmatched delimiters will be added to it."
  8162. (if lispy-safe-paste
  8163. (lispy--balance (current-kill 0))
  8164. (current-kill 0)))
  8165. ;;* Key definitions
  8166. (defvar ac-trigger-commands '(self-insert-command))
  8167. (defvar mc/cmds-to-run-for-all nil)
  8168. (defvar mc/cmds-to-run-once nil)
  8169. (mapc (lambda (x) (add-to-list 'mc/cmds-to-run-once x))
  8170. '(lispy-cursor-down))
  8171. (mapc (lambda (x) (add-to-list 'mc/cmds-to-run-for-all x))
  8172. '(lispy-parens lispy-brackets lispy-braces lispy-quotes
  8173. lispy-kill lispy-delete))
  8174. (defadvice ac-handle-post-command (around ac-post-command-advice activate)
  8175. "Don't `auto-complete' when region is active."
  8176. (unless (region-active-p)
  8177. ad-do-it))
  8178. (defun lispy--delsel-advice (orig-fun)
  8179. "Advice for `delete-selection-mode'.
  8180. Usage:
  8181. (advice-add 'delete-selection-pre-hook :around 'lispy--delsel-advice)"
  8182. (if (and (use-region-p)
  8183. (string-match-p "^special" (symbol-name this-command)))
  8184. (progn
  8185. (delete-active-region)
  8186. (setq this-command 'ignore)
  8187. (self-insert-command 1))
  8188. (funcall orig-fun)))
  8189. (defun lispy--undo-tree-advice (_arg)
  8190. "Advice to run before `undo-tree-undo'.
  8191. Otherwise, executing undo in middle of a lispy overlay operation
  8192. irreversibly corrupts the undo tree state. "
  8193. (lispy-map-delete-overlay))
  8194. (advice-add 'undo-tree-undo :before 'lispy--undo-tree-advice)
  8195. (defun lispy-define-key (keymap key def &rest plist)
  8196. "Forward to (`define-key' KEYMAP KEY FUNC).
  8197. FUNC is obtained from (`lispy--insert-or-call' DEF PLIST)."
  8198. (declare (indent 3))
  8199. (require 'eldoc)
  8200. (let ((func (defalias (intern (concat "special-" (symbol-name def)))
  8201. (lispy--insert-or-call def plist))))
  8202. (add-to-list 'ac-trigger-commands func)
  8203. (unless (memq func mc/cmds-to-run-once)
  8204. (add-to-list 'mc/cmds-to-run-for-all func))
  8205. (eldoc-add-command func)
  8206. (define-key keymap (kbd key) func)))
  8207. (lispy-defverb
  8208. "goto"
  8209. (("d" lispy-goto)
  8210. ("l" lispy-goto-local)
  8211. ("r" lispy-goto-recursive)
  8212. ("p" lispy-goto-projectile)
  8213. ("f" lispy-follow)
  8214. ("b" pop-tag-mark)
  8215. ("q" lispy-quit)
  8216. ("j" lispy-goto-def-down)
  8217. ("a" lispy-goto-def-ace)
  8218. ("e" lispy-goto-elisp-commands)))
  8219. (lispy-defverb
  8220. "other"
  8221. (("h" lispy-move-left)
  8222. ("j" lispy-down-slurp)
  8223. ("k" lispy-up-slurp)
  8224. ("l" lispy-move-right)
  8225. ("SPC" lispy-other-space)
  8226. ("g" lispy-goto-mode)))
  8227. (defhydra lh-knight ()
  8228. "knight"
  8229. ("j" lispy-knight-down)
  8230. ("k" lispy-knight-up)
  8231. ("z" nil))
  8232. (defvar lispy-mode-map-special
  8233. (let ((map (make-sparse-keymap)))
  8234. ;; navigation
  8235. (lispy-define-key map "l" 'lispy-right)
  8236. (lispy-define-key map "h" 'lispy-left)
  8237. (lispy-define-key map "f" 'lispy-flow)
  8238. (lispy-define-key map "j" 'lispy-down)
  8239. (lispy-define-key map "k" 'lispy-up)
  8240. (lispy-define-key map "d" 'lispy-different)
  8241. (lispy-define-key map "o" 'lispy-other-mode)
  8242. (lispy-define-key map "p" 'lispy-eval-other-window)
  8243. (lispy-define-key map "P" 'lispy-paste)
  8244. (lispy-define-key map "y" 'lispy-occur)
  8245. (lispy-define-key map "z" 'lh-knight/body)
  8246. ;; outline
  8247. (lispy-define-key map "J" 'lispy-outline-next)
  8248. (lispy-define-key map "K" 'lispy-outline-prev)
  8249. (lispy-define-key map "L" 'lispy-outline-goto-child)
  8250. ;; Paredit transformations
  8251. (lispy-define-key map ">" 'lispy-slurp)
  8252. (lispy-define-key map "<" 'lispy-barf)
  8253. (lispy-define-key map "/" 'lispy-splice)
  8254. (lispy-define-key map "r" 'lispy-raise)
  8255. (lispy-define-key map "R" 'lispy-raise-some)
  8256. (lispy-define-key map "+" 'lispy-join)
  8257. ;; more transformations
  8258. (lispy-define-key map "C" 'lispy-convolute)
  8259. (lispy-define-key map "X" 'lispy-convolute-left)
  8260. (lispy-define-key map "w" 'lispy-move-up)
  8261. (lispy-define-key map "s" 'lispy-move-down)
  8262. (lispy-define-key map "O" 'lispy-oneline)
  8263. (lispy-define-key map "M" 'lispy-alt-multiline)
  8264. (lispy-define-key map "S" 'lispy-stringify)
  8265. ;; marking
  8266. (lispy-define-key map "a" 'lispy-ace-symbol
  8267. :override '(cond ((looking-at lispy-outline)
  8268. (lispy-meta-return))))
  8269. (lispy-define-key map "H" 'lispy-ace-symbol-replace)
  8270. (lispy-define-key map "m" 'lispy-mark-list)
  8271. ;; dialect-specific
  8272. (lispy-define-key map "e" 'lispy-eval)
  8273. (lispy-define-key map "E" 'lispy-eval-and-insert)
  8274. (lispy-define-key map "G" 'lispy-goto-local)
  8275. (lispy-define-key map "g" 'lispy-goto)
  8276. (lispy-define-key map "F" 'lispy-follow t)
  8277. (lispy-define-key map "D" 'pop-tag-mark)
  8278. (lispy-define-key map "A" 'lispy-beginning-of-defun)
  8279. (lispy-define-key map "_" 'lispy-underscore)
  8280. ;; miscellanea
  8281. (define-key map (kbd "SPC") 'lispy-space)
  8282. (lispy-define-key map "i" 'lispy-tab)
  8283. (lispy-define-key map "I" 'lispy-shifttab)
  8284. (lispy-define-key map "N" 'lispy-narrow)
  8285. (lispy-define-key map "W" 'lispy-widen)
  8286. (lispy-define-key map "c" 'lispy-clone)
  8287. (lispy-define-key map "u" 'lispy-undo)
  8288. (lispy-define-key map "q" 'lispy-ace-paren
  8289. :override '(cond ((bound-and-true-p view-mode)
  8290. (View-quit))))
  8291. (lispy-define-key map "Q" 'lispy-ace-char)
  8292. (lispy-define-key map "v" 'lispy-view)
  8293. (lispy-define-key map "t" 'lispy-teleport
  8294. :override '(cond ((looking-at lispy-outline)
  8295. (end-of-line))))
  8296. (lispy-define-key map "n" 'lispy-new-copy)
  8297. (lispy-define-key map "b" 'lispy-back)
  8298. (lispy-define-key map "B" 'lispy-ediff-regions)
  8299. (lispy-define-key map "x" 'lispy-x)
  8300. (lispy-define-key map "Z" 'lispy-edebug-stop)
  8301. (lispy-define-key map "V" 'lispy-visit)
  8302. (lispy-define-key map "-" 'lispy-ace-subword)
  8303. (lispy-define-key map "." 'lispy-repeat)
  8304. (lispy-define-key map "~" 'lispy-tilde)
  8305. ;; digit argument
  8306. (mapc (lambda (x) (lispy-define-key map (format "%d" x) 'digit-argument))
  8307. (number-sequence 0 9))
  8308. map))
  8309. ;;* Parinfer compat
  8310. (defun lispy--auto-wrap (func arg preceding-syntax-alist)
  8311. "Helper to create versions of the `lispy-pair' commands that wrap by default."
  8312. (cond ((not arg)
  8313. (setq arg -1))
  8314. ((or (eq arg '-)
  8315. (and (numberp arg)
  8316. (= arg -1)))
  8317. (setq arg nil)))
  8318. (let (bounds)
  8319. (when (and (numberp arg)
  8320. (= arg -1)
  8321. (setq bounds (lispy--bounds-dwim))
  8322. (= (point) (cdr bounds)))
  8323. (lispy--delimiter-space-unless preceding-syntax-alist)))
  8324. (funcall func arg))
  8325. (defun lispy-parens-auto-wrap (arg)
  8326. "Like `lispy-parens' but wrap to the end of the line by default.
  8327. With an arg of -1, never wrap."
  8328. (interactive "P")
  8329. (lispy--auto-wrap #'lispy-parens arg lispy-parens-preceding-syntax-alist))
  8330. (defun lispy-brackets-auto-wrap (arg)
  8331. "Like `lispy-brackets' but wrap to the end of the line by default.
  8332. With an arg of -1, never wrap."
  8333. (interactive "P")
  8334. (lispy--auto-wrap #'lispy-brackets arg lispy-brackets-preceding-syntax-alist))
  8335. (defun lispy-braces-auto-wrap (arg)
  8336. "Like `lispy-braces' but wrap to the end of the line by default.
  8337. With an arg of -1, never wrap."
  8338. (interactive "P")
  8339. (lispy--auto-wrap #'lispy-braces arg lispy-braces-preceding-syntax-alist))
  8340. (defun lispy-barf-to-point-nostring (arg)
  8341. "Call `lispy-barf-to-point' with ARG unless in string or comment.
  8342. Self-insert otherwise."
  8343. (interactive "P")
  8344. (if (or (lispy--in-string-or-comment-p)
  8345. (lispy-looking-back "?\\\\"))
  8346. (self-insert-command (prefix-numeric-value arg))
  8347. (lispy-barf-to-point arg)))
  8348. (defun lispy--barf-to-point-or-jump (delimiter arg)
  8349. "If possible, barf to the point for DELIMITER.
  8350. Otherwise, jump to the next occurrence of DELIMITER. If ARG is non-nil, barf
  8351. from the left or jump to the previous occurrence of DELIMITER."
  8352. (if (save-excursion
  8353. (if arg
  8354. (re-search-backward lispy-left nil t)
  8355. (re-search-forward lispy-right nil t))
  8356. (goto-char (match-beginning 0))
  8357. (looking-at delimiter))
  8358. (lispy-barf-to-point arg)
  8359. (if arg
  8360. (re-search-backward delimiter nil t)
  8361. (re-search-forward delimiter nil t))))
  8362. (defun lispy--barf-to-point-or-jump-nostring (delimiter arg)
  8363. "Call `lispy--barf-to-point-or-jump' with DELIMITER and ARG.
  8364. Self-insert when in a string or a comment."
  8365. (if (or (lispy--in-string-or-comment-p)
  8366. (lispy-looking-back "?\\\\"))
  8367. (self-insert-command (prefix-numeric-value arg))
  8368. (lispy--barf-to-point-or-jump delimiter arg)))
  8369. (defun lispy-parens-barf-to-point-or-jump-nostring (arg)
  8370. "Barf to the point when directly inside a \"(...)\" block.
  8371. Otherwise, jump to the next \")\". When ARG is non-nil, barf from the left or
  8372. jump to the previous \"(\". Self-insert when in a string or a comment."
  8373. (interactive "P")
  8374. (if arg
  8375. (lispy--barf-to-point-or-jump "(" arg)
  8376. (lispy--barf-to-point-or-jump-nostring ")" arg)))
  8377. (defun lispy-brackets-barf-to-point-or-jump-nostring (arg)
  8378. "Barf to the point when directly inside a \"[...]\" block.
  8379. Otherwise, jump to the next \"]\". When ARG is non-nil, barf from the left or
  8380. jump to the previous \"[\". Self-insert when in a string or a comment."
  8381. (interactive "P")
  8382. (if arg
  8383. (lispy--barf-to-point-or-jump "\\[" arg)
  8384. (lispy--barf-to-point-or-jump-nostring "\\]" arg)))
  8385. (defun lispy-braces-barf-to-point-or-jump-nostring (arg)
  8386. "Barf to the point when directly inside a \"{...}\" block.
  8387. Otherwise, jump to the next \"}\". When ARG is non-nil, barf from the left or
  8388. jump to the previous \"{\". Self-insert when in a string or a comment."
  8389. (interactive "P")
  8390. (if arg
  8391. (lispy--barf-to-point-or-jump "{" arg)
  8392. (lispy--barf-to-point-or-jump-nostring "}" arg)))
  8393. (defun lispy-delete-backward-or-splice-or-slurp (arg)
  8394. "Call `lispy-delete-backward' unless after a delimiter.
  8395. After an opening delimiter, splice. After a closing delimiter, slurp to the end
  8396. of the line without moving the point. When in a position where slurping will
  8397. not have an effect such as after the final delimiters before the end of a line,
  8398. move backward. In comments and strings, call `lispy-delete-backward'. When after
  8399. the opening quote of a string, delete the entire string. When after the closing
  8400. quote of a string, move backward."
  8401. (interactive "p")
  8402. (let ((string-bounds (lispy--bounds-string)))
  8403. (cond ((and (not string-bounds)
  8404. (save-excursion
  8405. (backward-char)
  8406. (lispy--in-string-p)))
  8407. (backward-char))
  8408. ((and string-bounds
  8409. (= (1- (point)) (car string-bounds)))
  8410. (backward-char)
  8411. (lispy-delete 1))
  8412. ((lispy--in-string-or-comment-p)
  8413. (lispy-delete-backward arg))
  8414. ((looking-back lispy-left (1- (point)))
  8415. (when (looking-at "[[:space:]]")
  8416. (fixup-whitespace))
  8417. (backward-char)
  8418. (save-excursion
  8419. (lispy-different)
  8420. (delete-char -1))
  8421. (lispy--delete-leading-garbage)
  8422. (delete-char 1))
  8423. ((looking-back lispy-right (1- (point)))
  8424. (let ((tick (buffer-chars-modified-tick)))
  8425. (save-excursion
  8426. (lispy-slurp -1))
  8427. (when (= tick (buffer-chars-modified-tick))
  8428. (backward-char arg))))
  8429. (t
  8430. (lispy-delete-backward arg)))))
  8431. (defun lispy-delete-or-splice-or-slurp (arg)
  8432. "Call `lispy-delete' unless before a delimiter.
  8433. Before an opening delimiter, splice. Before a closing delimiter, slurp to the
  8434. end of the line without moving the point. When in a position where slurping will
  8435. not have an effect such as at the final delimiters before the end of a line,
  8436. move forward. In comments and strings, call `lispy-delete'. When before the
  8437. opening quote of a string, delete the entire string. When before the closing
  8438. quote of a string, move forward."
  8439. (interactive "p")
  8440. (let ((string-bounds (lispy--bounds-string)))
  8441. (cond ((and string-bounds
  8442. (= (1+ (point)) (cdr string-bounds)))
  8443. (forward-char))
  8444. ((and string-bounds
  8445. (= (point) (car string-bounds)))
  8446. (lispy-delete 1))
  8447. ((lispy--in-string-or-comment-p)
  8448. (lispy-delete arg))
  8449. ((looking-at lispy-left)
  8450. (save-excursion
  8451. (lispy-different)
  8452. (delete-char -1))
  8453. (lispy--delete-leading-garbage)
  8454. (delete-char 1))
  8455. ((looking-at lispy-right)
  8456. (let ((tick (buffer-chars-modified-tick)))
  8457. (save-excursion
  8458. (forward-char)
  8459. (lispy-slurp -1))
  8460. (when (= tick (buffer-chars-modified-tick))
  8461. (forward-char arg))))
  8462. (t
  8463. (lispy-delete arg)))))
  8464. ;;* Paredit compat
  8465. (defun lispy-close-round-and-newline (arg)
  8466. "Forward to (`lispy-out-forward-newline' ARG).
  8467. Insert \")\" in strings and comments."
  8468. (interactive "p")
  8469. (if (or (lispy--in-string-or-comment-p)
  8470. (lispy-after-string-p "?\\"))
  8471. (insert ")")
  8472. (lispy-out-forward-newline arg)))
  8473. (defun lispy-open-square (arg)
  8474. "Forward to (`lispy-brackets' ARG).
  8475. Insert \"[\" in strings and comments."
  8476. (interactive "P")
  8477. (if (lispy--in-string-or-comment-p)
  8478. (insert "[")
  8479. (lispy-brackets arg)))
  8480. (defun lispy-open-curly (arg)
  8481. "Forward to( `lispy-braces' ARG).
  8482. Insert \"{\" in strings and comments."
  8483. (interactive "P")
  8484. (if (lispy--in-string-or-comment-p)
  8485. (insert "{")
  8486. (lispy-braces arg)))
  8487. (defun lispy-close-square (arg)
  8488. "Forward to function `lispy-right' with ARG.
  8489. Insert \"]\" in strings and comments."
  8490. (interactive "p")
  8491. (if (lispy--in-string-or-comment-p)
  8492. (insert "]")
  8493. (lispy-right arg)))
  8494. (defun lispy-close-curly (arg)
  8495. "Forward to function `lispy-right' with ARG.
  8496. Insert \"}\" in strings and comments."
  8497. (interactive "p")
  8498. (if (lispy--in-string-or-comment-p)
  8499. (insert "}")
  8500. (lispy-right arg)))
  8501. (defun lispy-doublequote (arg)
  8502. "Insert a pair of quotes around the point.
  8503. When ARG is non-nil, unquote the current string."
  8504. (interactive "P")
  8505. (let (bnd)
  8506. (cond ((region-active-p)
  8507. (if arg
  8508. (lispy-unstringify)
  8509. (lispy-stringify)))
  8510. ((and (setq bnd (lispy--bounds-string))
  8511. (not (= (point) (car bnd))))
  8512. (if (= (point) (1- (cdr bnd)))
  8513. (forward-char 1)
  8514. (if arg
  8515. (lispy-unstringify)
  8516. (insert "\\\""))))
  8517. (arg
  8518. (lispy-stringify))
  8519. ((lispy-after-string-p "?\\")
  8520. (self-insert-command 1))
  8521. ((lispy--in-comment-p)
  8522. (insert "\""))
  8523. (t
  8524. (lispy--space-unless "^\\|\\s-\\|\\s(\\|[#]")
  8525. (insert "\"\"")
  8526. (unless (looking-at "\n\\|)\\|}\\|\\]\\|$")
  8527. (just-one-space)
  8528. (backward-char 1))
  8529. (backward-char)))))
  8530. (defun lispy-meta-doublequote (arg)
  8531. "Stringify current expression or forward to (`lispy-meta-doublequote' ARG)."
  8532. (interactive "P")
  8533. (let ((bnd (lispy--bounds-string)))
  8534. (if bnd
  8535. (goto-char (cdr bnd))
  8536. (if (lispy-left-p)
  8537. (lispy-stringify)
  8538. (lispy-doublequote arg)))))
  8539. (defun lispy-forward-delete (arg)
  8540. "Delete ARG sexps."
  8541. (interactive "p")
  8542. (let (bnd)
  8543. (cond ((lispy-left-p)
  8544. (forward-char 1))
  8545. ((looking-at lispy-right)
  8546. (forward-char 1)
  8547. (setq bnd (lispy--bounds-dwim))
  8548. (delete-region (car bnd) (cdr bnd)))
  8549. ((and (setq bnd (lispy--bounds-string))
  8550. (eq (point) (car bnd)))
  8551. (forward-char 1))
  8552. (t
  8553. (lispy-delete arg)))))
  8554. (defun lispy-backward-delete (arg)
  8555. "Delete ARG sexps backward."
  8556. (interactive "p")
  8557. (cond
  8558. ((lispy--in-comment-p)
  8559. (backward-delete-char-untabify arg))
  8560. ((and (eq (char-before) ?\")
  8561. (null (lispy--bounds-string)))
  8562. (backward-char 1))
  8563. ((lispy-looking-back lispy-left)
  8564. (lispy-delete-backward arg)
  8565. (unless (bolp)
  8566. (insert " ")))
  8567. ((lispy-right-p)
  8568. (backward-char 1))
  8569. (t (lispy-delete-backward arg))))
  8570. (defun lispy-wrap-round (arg)
  8571. "Forward to `lispy-parens' with a default ARG of 1."
  8572. (interactive "P")
  8573. (lispy-parens (or arg 1)))
  8574. (defun lispy-wrap-brackets (arg)
  8575. "Forward to `lispy-brackets' with a default ARG of 1."
  8576. (interactive "P")
  8577. (lispy-brackets (or arg 1)))
  8578. (defun lispy-wrap-braces (arg)
  8579. "Forward to `lispy-braces' with a default ARG of 1."
  8580. (interactive "P")
  8581. (lispy-braces (or arg 1)))
  8582. (defun lispy-splice-sexp-killing-backward ()
  8583. "Forward to `lispy-raise'."
  8584. (interactive)
  8585. (let ((bnd (lispy--bounds-list)))
  8586. (if (eq (point) (car bnd))
  8587. (lispy-raise-some)
  8588. (lispy--mark (cons (point) (1- (cdr bnd))))
  8589. (lispy-raise 1)
  8590. (deactivate-mark))))
  8591. (defun lispy-splice-sexp-killing-forward ()
  8592. "Forward to `lispy-raise'."
  8593. (interactive)
  8594. (if (lispy-right-p)
  8595. (lispy-raise-some)
  8596. (let ((bnd (lispy--bounds-list)))
  8597. (if (eq (point) (car bnd))
  8598. (lispy-raise-some)
  8599. (lispy--mark (cons (1+ (car bnd)) (point)))
  8600. (lispy-raise 1)
  8601. (deactivate-mark)))))
  8602. (defun lispy-raise-sexp ()
  8603. "Forward to `lispy-raise'."
  8604. (interactive)
  8605. (if (or (lispy-left-p)
  8606. (lispy-right-p))
  8607. (lispy-raise 1)
  8608. (lispy-mark-symbol)
  8609. (lispy-different)
  8610. (lispy-raise 1)
  8611. (deactivate-mark)))
  8612. (defun lispy-convolute-sexp ()
  8613. "Forward to `lispy-convolute'."
  8614. (interactive)
  8615. (unless (lispy-left-p)
  8616. (lispy--out-backward 1))
  8617. (lispy-convolute 1)
  8618. (lispy--out-backward 1))
  8619. (defun lispy-forward-slurp-sexp (arg)
  8620. "Forward to (`lispy-slurp' ARG)."
  8621. (interactive "p")
  8622. (save-excursion
  8623. (unless (lispy-right-p)
  8624. (lispy--out-forward 1))
  8625. (lispy-slurp arg)))
  8626. (defun lispy-forward-barf-sexp (arg)
  8627. "Forward to (`lispy-barf' ARG)."
  8628. (interactive "p")
  8629. (save-excursion
  8630. (unless (lispy-left-p)
  8631. (lispy--out-forward 1))
  8632. (lispy-barf arg)))
  8633. (defun lispy-backward-slurp-sexp (arg)
  8634. "Forward to (`lispy-slurp' ARG)."
  8635. (interactive "p")
  8636. (save-excursion
  8637. (unless (lispy-left-p)
  8638. (lispy--out-backward 1))
  8639. (lispy-slurp arg)))
  8640. (defun lispy-backward-barf-sexp (arg)
  8641. "Forward to (`lispy-barf' ARG)."
  8642. (interactive "p")
  8643. (save-excursion
  8644. (unless (lispy-left-p)
  8645. (lispy--out-backward 1))
  8646. (lispy-barf arg)))
  8647. (defvar lispy-mode-map-base
  8648. (let ((map (make-sparse-keymap)))
  8649. ;; navigation
  8650. (define-key map (kbd "C-a") 'lispy-move-beginning-of-line)
  8651. (define-key map (kbd "C-e") 'lispy-move-end-of-line)
  8652. (define-key map (kbd "M-n") 'lispy-left)
  8653. ;; killing
  8654. (define-key map (kbd "C-k") 'lispy-kill)
  8655. (define-key map (kbd "M-d") 'lispy-kill-word)
  8656. (define-key map (kbd "M-DEL") 'lispy-backward-kill-word)
  8657. ;; misc
  8658. (define-key map (kbd "(") 'lispy-parens)
  8659. (define-key map (kbd ";") 'lispy-comment)
  8660. (define-key map (kbd "M-q") 'lispy-fill)
  8661. (define-key map (kbd "C-j") 'lispy-newline-and-indent)
  8662. (define-key map (kbd "RET") 'lispy-newline-and-indent-plain)
  8663. ;; tags
  8664. (define-key map (kbd "M-.") 'lispy-goto-symbol)
  8665. (define-key map (kbd "M-,") 'pop-tag-mark)
  8666. map))
  8667. (defvar lispy-mode-map-paredit
  8668. (let ((map (copy-keymap lispy-mode-map-base)))
  8669. (define-key map (kbd "M-)") 'lispy-close-round-and-newline)
  8670. (define-key map (kbd "C-M-n") 'lispy-forward)
  8671. (define-key map (kbd "C-M-p") 'lispy-backward)
  8672. (define-key map (kbd "[") 'lispy-open-square)
  8673. (define-key map (kbd "]") 'lispy-close-square)
  8674. (define-key map (kbd "{") 'lispy-open-curly)
  8675. (define-key map (kbd "}") 'lispy-close-curly)
  8676. (define-key map (kbd ")") 'lispy-right-nostring)
  8677. (define-key map (kbd "\"") 'lispy-doublequote)
  8678. (define-key map (kbd "M-\"") 'lispy-meta-doublequote)
  8679. (define-key map (kbd "C-d") 'lispy-forward-delete)
  8680. (define-key map (kbd "DEL") 'lispy-backward-delete)
  8681. (define-key map (kbd "C-M-f") 'lispy-forward)
  8682. (define-key map (kbd "C-M-b") 'lispy-backward)
  8683. (define-key map (kbd "M-(") 'lispy-wrap-round)
  8684. (define-key map (kbd "M-s") 'lispy-splice)
  8685. (define-key map (kbd "M-<up>") 'lispy-splice-sexp-killing-backward)
  8686. (define-key map (kbd "M-<down>") 'lispy-splice-sexp-killing-forward)
  8687. (define-key map (kbd "M-r") 'lispy-raise-sexp)
  8688. (define-key map (kbd "M-?") 'lispy-convolute-sexp)
  8689. (define-key map (kbd "C-)") 'lispy-forward-slurp-sexp)
  8690. (define-key map (kbd "C-<right>") 'lispy-forward-slurp-sexp)
  8691. (define-key map (kbd "C-}") 'lispy-forward-barf-sexp)
  8692. (define-key map (kbd "C-<left>") 'lispy-forward-barf-sexp)
  8693. (define-key map (kbd "C-(") 'lispy-backward-slurp-sexp)
  8694. (define-key map (kbd "C-M-<left>") 'lispy-backward-slurp-sexp)
  8695. (define-key map (kbd "C-M-<right>") 'lispy-backward-barf-sexp)
  8696. (define-key map (kbd "C-{") 'lispy-backward-barf-sexp)
  8697. (define-key map (kbd "M-S") 'lispy-split)
  8698. (define-key map (kbd "M-J") 'lispy-join)
  8699. (define-key map (kbd "C-M-u") 'lispy-left)
  8700. (define-key map (kbd "C-M-n") 'lispy-right)
  8701. map))
  8702. (defvar lispy-mode-map-parinfer
  8703. (let ((map (copy-keymap lispy-mode-map-base)))
  8704. (define-key map (kbd "(") 'lispy-parens-auto-wrap)
  8705. (define-key map (kbd "[") 'lispy-brackets-auto-wrap)
  8706. (define-key map (kbd "{") 'lispy-braces-auto-wrap)
  8707. (define-key map (kbd "\"") 'lispy-quotes)
  8708. (define-key map (kbd ")") 'lispy-barf-to-point-nostring)
  8709. (define-key map (kbd "]") 'lispy-barf-to-point-nostring)
  8710. (define-key map (kbd "}") 'lispy-barf-to-point-nostring)
  8711. (define-key map (kbd "TAB") 'lispy-indent-adjust-parens)
  8712. (define-key map (kbd "<backtab>") 'lispy-dedent-adjust-parens)
  8713. (define-key map (kbd "DEL") 'lispy-delete-backward-or-splice-or-slurp)
  8714. (define-key map (kbd "C-d") 'lispy-delete-or-splice-or-slurp)
  8715. (define-key map (kbd ":") 'lispy-colon)
  8716. (define-key map (kbd "^") 'lispy-hat)
  8717. (define-key map (kbd "'") 'lispy-tick)
  8718. (define-key map (kbd "`") 'lispy-backtick)
  8719. (define-key map (kbd "#") 'lispy-hash)
  8720. map))
  8721. (defvar lispy-mode-map-evilcp
  8722. (let ((map (copy-keymap lispy-mode-map-base)))
  8723. (define-key map (kbd "M-)") 'lispy-close-round-and-newline)
  8724. (define-key map (kbd "[") 'lispy-open-square)
  8725. (define-key map (kbd "]") 'lispy-close-square)
  8726. (define-key map (kbd "{") 'lispy-open-curly)
  8727. (define-key map (kbd "}") 'lispy-close-curly)
  8728. (define-key map (kbd ")") 'lispy-right-nostring)
  8729. (define-key map (kbd "\"") 'lispy-doublequote)
  8730. (define-key map (kbd "M-\"") 'lispy-meta-doublequote)
  8731. (define-key map (kbd "DEL") 'lispy-backward-delete)
  8732. (define-key map (kbd "M-s") 'lispy-splice)
  8733. (define-key map (kbd "M-<up>") 'lispy-splice-sexp-killing-backward)
  8734. (define-key map (kbd "M-<down>") 'lispy-splice-sexp-killing-backward)
  8735. (define-key map (kbd "M-r") 'lispy-raise-sexp)
  8736. (define-key map (kbd "M-?") 'lispy-convolute-sexp)
  8737. (define-key map (kbd "M-S") 'lispy-split)
  8738. (define-key map (kbd "M-J") 'lispy-join)
  8739. (define-key map (kbd "{") 'lispy-braces)
  8740. (define-key map (kbd "}") 'lispy-brackets)
  8741. (define-key map (kbd "]") 'lispy-forward)
  8742. (define-key map (kbd "[") 'lispy-backward)
  8743. (define-key map (kbd "M-(") 'evil-cp-wrap-next-round)
  8744. (define-key map (kbd "M-{") 'evil-cp-wrap-next-curly)
  8745. (define-key map (kbd "M-}") 'evil-cp-wrap-next-square)
  8746. (define-key map (kbd "<") 'evil-cp-<)
  8747. (define-key map (kbd ">") 'evil-cp->)
  8748. (define-key map (kbd "y") 'lispy-new-copy)
  8749. (define-key map (kbd "<C-return>") 'lispy-open-line)
  8750. (define-key map (kbd "<M-return>") 'lispy-meta-return)
  8751. (define-key map (kbd "M-k") 'lispy-move-up)
  8752. (define-key map (kbd "M-j") 'lispy-move-down)
  8753. (define-key map (kbd "M-o") 'lispy-string-oneline)
  8754. (define-key map (kbd "M-p") 'lispy-clone)
  8755. (define-key map (kbd "M-\"") 'paredit-meta-doublequote)
  8756. map))
  8757. (defvar lispy-mode-map-c-digits
  8758. (let ((map (make-sparse-keymap)))
  8759. (define-key map (kbd "C-1") 'lispy-describe-inline)
  8760. (define-key map (kbd "C-2") 'lispy-arglist-inline)
  8761. (define-key map (kbd "C-3") 'lispy-right)
  8762. (define-key map (kbd "C-4") 'lispy-x)
  8763. (define-key map (kbd "C-7") 'lispy-cursor-down)
  8764. (define-key map (kbd "C-8") 'lispy-parens-down)
  8765. (define-key map (kbd "C-9") 'lispy-out-forward-newline)
  8766. map))
  8767. (declare-function View-quit "view")
  8768. (defvar lispy-mode-map-lispy
  8769. (let ((map (copy-keymap lispy-mode-map-base)))
  8770. ;; navigation
  8771. (define-key map (kbd "]") 'lispy-forward)
  8772. (define-key map (kbd "[") 'lispy-backward)
  8773. (define-key map (kbd ")") 'lispy-right-nostring)
  8774. ;; kill-related
  8775. (define-key map (kbd "C-y") 'lispy-yank)
  8776. (define-key map (kbd "C-d") 'lispy-delete)
  8777. (define-key map (kbd "DEL") 'lispy-delete-backward)
  8778. (define-key map (kbd "M-k") 'lispy-kill-sentence)
  8779. (define-key map (kbd "M-m") 'lispy-mark-symbol)
  8780. (define-key map (kbd "C-,") 'lispy-kill-at-point)
  8781. (define-key map (kbd "C-M-,") 'lispy-mark)
  8782. ;; pairs
  8783. (define-key map (kbd "{") 'lispy-braces)
  8784. (define-key map (kbd "}") 'lispy-brackets)
  8785. (define-key map (kbd "\"") 'lispy-quotes)
  8786. ;; insert
  8787. (define-key map (kbd ":") 'lispy-colon)
  8788. (define-key map (kbd "^") 'lispy-hat)
  8789. (define-key map (kbd "@") 'lispy-at)
  8790. (define-key map (kbd "'") 'lispy-tick)
  8791. (define-key map (kbd "`") 'lispy-backtick)
  8792. (define-key map (kbd "#") 'lispy-hash)
  8793. (define-key map (kbd "M-j") 'lispy-split)
  8794. (define-key map (kbd "M-J") 'lispy-join)
  8795. (define-key map (kbd "<C-return>") 'lispy-open-line)
  8796. (define-key map (kbd "<M-return>") 'lispy-meta-return)
  8797. (define-key map (kbd "M-RET") 'lispy-meta-return)
  8798. ;; misc
  8799. (define-key map (kbd "M-o") 'lispy-string-oneline)
  8800. (define-key map (kbd "M-i") 'lispy-iedit)
  8801. (define-key map (kbd "<backtab>") 'lispy-shifttab)
  8802. ;; outline
  8803. (define-key map (kbd "M-<left>") 'lispy-outline-demote)
  8804. (define-key map (kbd "M-<right>") 'lispy-outline-promote)
  8805. map))
  8806. (defvar lispy-mode-map-oleh
  8807. (let ((map (make-sparse-keymap)))
  8808. (define-key map (kbd "φ") 'lispy-parens)
  8809. (define-key map (kbd "σ") 'lispy-braces)
  8810. (define-key map (kbd "ρ") 'lispy-brackets)
  8811. (define-key map (kbd "θ") 'lispy-quotes)
  8812. (define-key map (kbd "χ") 'lispy-right)
  8813. (define-key map (kbd "C-M-a") 'lispy-beginning-of-defun)
  8814. (define-key map (kbd "<return>") 'lispy-alt-line)
  8815. (define-key map (kbd "C-c C-c") 'lispy-eval-current-outline)
  8816. (define-key map (kbd "RET") 'lispy-newline-and-indent-plain)
  8817. map))
  8818. (defcustom lispy-key-theme '(special lispy c-digits)
  8819. "List of key themes used to compose `lispy-mode-map'."
  8820. :type
  8821. '(set
  8822. (const special)
  8823. (radio
  8824. (const lispy)
  8825. (const paredit)
  8826. (const evilcp))
  8827. (const c-digits)
  8828. (const oleh)))
  8829. (defun lispy-set-key-theme (theme)
  8830. "Set `lispy-mode-map' for according to THEME.
  8831. THEME is a list of choices: 'special, 'lispy, 'paredit, 'evilcp, 'c-digits."
  8832. (setq lispy-mode-map
  8833. (make-composed-keymap
  8834. (delq nil
  8835. (list
  8836. (when (memq 'special theme) lispy-mode-map-special)
  8837. (when (memq 'lispy theme) lispy-mode-map-lispy)
  8838. (when (memq 'paredit theme) lispy-mode-map-paredit)
  8839. (when (memq 'parinfer theme) lispy-mode-map-parinfer)
  8840. (when (memq 'evilcp theme) lispy-mode-map-evilcp)
  8841. (when (memq 'c-digits theme) lispy-mode-map-c-digits)
  8842. (when (memq 'oleh theme) lispy-mode-map-oleh)))))
  8843. (setcdr
  8844. (assq 'lispy-mode minor-mode-map-alist)
  8845. lispy-mode-map))
  8846. (lispy-set-key-theme lispy-key-theme)
  8847. (provide 'lispy)
  8848. ;;; lispy.el ends here