Klimi's new dotfiles with stow.
您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

2929 行
119 KiB

  1. ;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-
  2. ;; Copyright (C) 2005--2017 Taylor R. Campbell
  3. ;; Author: Taylor R. Campbell <campbell+paredit@mumble.net>
  4. ;; Version: 25beta
  5. ;; Package-Version: 20171127.205
  6. ;; Created: 2005-07-31
  7. ;; Keywords: lisp
  8. ;; NOTE: THIS IS A BETA VERSION OF PAREDIT. USE AT YOUR OWN RISK.
  9. ;; THIS FILE IS SUBJECT TO CHANGE, AND NOT SUITABLE FOR DISTRIBUTION
  10. ;; BY PACKAGE MANAGERS SUCH AS APT, PKGSRC, MACPORTS, &C.
  11. ;; Paredit is free software: you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation, either version 3 of the License, or
  14. ;; (at your option) any later version.
  15. ;;
  16. ;; Paredit is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;; GNU General Public License for more details.
  20. ;;
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with paredit. If not, see <http://www.gnu.org/licenses/>.
  23. ;;; The currently released version of paredit is available at
  24. ;;; <https://mumble.net/~campbell/emacs/paredit.el>.
  25. ;;;
  26. ;;; The latest beta version of paredit is available at
  27. ;;; <https://mumble.net/~campbell/emacs/paredit-beta.el>.
  28. ;;;
  29. ;;; The Git repository for paredit is available at
  30. ;;; <https://mumble.net/~campbell/git/paredit.git>
  31. ;;;
  32. ;;; Release notes are available at
  33. ;;; <https://mumble.net/~campbell/emacs/paredit.release>.
  34. ;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
  35. ;;; directory of your choice, and adding to your .emacs file:
  36. ;;;
  37. ;;; (add-to-list 'load-path "/path/to/elisp")
  38. ;;; (autoload 'enable-paredit-mode "paredit"
  39. ;;; "Turn on pseudo-structural editing of Lisp code."
  40. ;;; t)
  41. ;;;
  42. ;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET',
  43. ;;; or always enable it in a major mode `M' (e.g., `lisp') with:
  44. ;;;
  45. ;;; (add-hook 'M-mode-hook 'enable-paredit-mode)
  46. ;;;
  47. ;;; Customize paredit using `eval-after-load':
  48. ;;;
  49. ;;; (eval-after-load 'paredit
  50. ;;; '(progn
  51. ;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)")
  52. ;;; 'paredit-dwim)))
  53. ;;;
  54. ;;; Send questions, bug reports, comments, feature suggestions, &c.,
  55. ;;; via email to the author's surname at mumble.net.
  56. ;;;
  57. ;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or
  58. ;;; later.
  59. ;;; The paredit minor mode, Paredit Mode, binds common character keys,
  60. ;;; such as `(', `)', `"', and `\', to commands that carefully insert
  61. ;;; S-expression structures in the buffer:
  62. ;;;
  63. ;;; ( inserts `()', leaving the point in the middle;
  64. ;;; ) moves the point over the next closing delimiter;
  65. ;;; " inserts `""' if outside a string, or inserts an escaped
  66. ;;; double-quote if in the middle of a string, or moves over the
  67. ;;; closing double-quote if at the end of a string; and
  68. ;;; \ prompts for the character to escape, to avoid inserting lone
  69. ;;; backslashes that may break structure.
  70. ;;;
  71. ;;; In comments, these keys insert themselves. If necessary, you can
  72. ;;; insert these characters literally outside comments by pressing
  73. ;;; `C-q' before these keys, in case a mistake has broken the
  74. ;;; structure.
  75. ;;;
  76. ;;; These key bindings are designed so that when typing new code in
  77. ;;; Paredit Mode, you can generally type exactly the same sequence of
  78. ;;; keys you would have typed without Paredit Mode.
  79. ;;;
  80. ;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d',
  81. ;;; and `C-k', to commands that respect S-expression structures in the
  82. ;;; buffer:
  83. ;;;
  84. ;;; DEL deletes the previous character, unless it is a delimiter: DEL
  85. ;;; will move the point backward over a closing delimiter, and
  86. ;;; will delete a delimiter pair together if between an open and
  87. ;;; closing delimiter;
  88. ;;;
  89. ;;; C-d deletes the next character in much the same manner; and
  90. ;;;
  91. ;;; C-k kills all S-expressions that begin anywhere between the point
  92. ;;; and the end of the line or the closing delimiter of the
  93. ;;; enclosing list, whichever is first.
  94. ;;;
  95. ;;; If necessary, you can delete a character, kill a line, &c.,
  96. ;;; irrespective of S-expression structure, by pressing `C-u' before
  97. ;;; these keys, in case a mistake has broken the structure.
  98. ;;;
  99. ;;; Finally, Paredit Mode binds some keys to complex S-expression
  100. ;;; editing operations. For example, `C-<right>' makes the enclosing
  101. ;;; list slurp up an S-expression to its right (here `|' denotes the
  102. ;;; point):
  103. ;;;
  104. ;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux))
  105. ;;;
  106. ;;; Some paredit commands automatically reindent code. When they do,
  107. ;;; they try to indent as locally as possible, to avoid interfering
  108. ;;; with any indentation you might have manually written. Only the
  109. ;;; advanced S-expression manipulation commands automatically reindent,
  110. ;;; and only the forms that they immediately operated upon (and their
  111. ;;; subforms).
  112. ;;;
  113. ;;; This code is written for clarity, not efficiency. It frequently
  114. ;;; walks over S-expressions redundantly. If you have problems with
  115. ;;; the time it takes to execute some of the commands, let me know.
  116. ;;; This assumes Unix-style LF line endings.
  117. (defconst paredit-version 25)
  118. (defconst paredit-beta-p t)
  119. (eval-and-compile
  120. (defun paredit-xemacs-p ()
  121. ;; No idea where I got this definition from. Edward O'Connor
  122. ;; (hober in #emacs) suggested the current definition.
  123. ;; (and (boundp 'running-xemacs)
  124. ;; running-xemacs)
  125. (featurep 'xemacs))
  126. (defun paredit-gnu-emacs-p ()
  127. ;++ This could probably be improved.
  128. (not (paredit-xemacs-p)))
  129. (defmacro xcond (&rest clauses)
  130. "Exhaustive COND.
  131. Signal an error if no clause matches."
  132. `(cond ,@clauses
  133. (t (error "XCOND lost."))))
  134. (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
  135. (defvar paredit-sexp-error-type
  136. (with-temp-buffer
  137. (insert "(")
  138. (condition-case condition
  139. (backward-sexp)
  140. (error (if (eq (car condition) 'error)
  141. (paredit-warn "%s%s%s%s%s"
  142. "Paredit is unable to discriminate"
  143. " S-expression parse errors from"
  144. " other errors. "
  145. " This may cause obscure problems. "
  146. " Please upgrade Emacs."))
  147. (car condition)))))
  148. (defmacro paredit-handle-sexp-errors (body &rest handler)
  149. `(condition-case ()
  150. ,body
  151. (,paredit-sexp-error-type ,@handler)))
  152. (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
  153. (defmacro paredit-ignore-sexp-errors (&rest body)
  154. `(paredit-handle-sexp-errors (progn ,@body)
  155. nil))
  156. (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
  157. (defmacro paredit-preserving-column (&rest body)
  158. "Evaluate BODY and restore point to former column, relative to code.
  159. Assumes BODY will change only indentation.
  160. If point was on code, it moves with the code.
  161. If point was on indentation, it stays in indentation."
  162. (let ((column (make-symbol "column"))
  163. (indentation (make-symbol "indentation")))
  164. `(let ((,column (current-column))
  165. (,indentation (paredit-current-indentation)))
  166. (let ((value (progn ,@body)))
  167. (paredit-restore-column ,column ,indentation)
  168. value))))
  169. (put 'paredit-preserving-column 'lisp-indent-function 0)
  170. nil)
  171. ;;;; Minor Mode Definition
  172. (defvar paredit-lighter " Paredit"
  173. "Mode line lighter Paredit Mode.")
  174. (defvar paredit-mode-map (make-sparse-keymap)
  175. "Keymap for the paredit minor mode.")
  176. (defvar paredit-override-check-parens-function
  177. (lambda (condition) condition nil)
  178. "Function to tell whether unbalanced text should inhibit Paredit Mode.")
  179. ;;;###autoload
  180. (define-minor-mode paredit-mode
  181. "Minor mode for pseudo-structurally editing Lisp code.
  182. With a prefix argument, enable Paredit Mode even if there are
  183. unbalanced parentheses in the buffer.
  184. Paredit behaves badly if parentheses are unbalanced, so exercise
  185. caution when forcing Paredit Mode to be enabled, and consider
  186. fixing unbalanced parentheses instead.
  187. \\<paredit-mode-map>"
  188. :lighter paredit-lighter
  189. ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode.
  190. (if (and paredit-mode
  191. (not current-prefix-arg))
  192. (condition-case condition
  193. (check-parens)
  194. (error
  195. (if (not (funcall paredit-override-check-parens-function condition))
  196. (progn (setq paredit-mode nil)
  197. (signal (car condition) (cdr condition))))))))
  198. (defun paredit-override-check-parens-interactively (condition)
  199. (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition)))
  200. ;;;###autoload
  201. (defun enable-paredit-mode ()
  202. "Turn on pseudo-structural editing of Lisp code."
  203. (interactive)
  204. (paredit-mode +1))
  205. (defun disable-paredit-mode ()
  206. "Turn off pseudo-structural editing of Lisp code."
  207. (interactive)
  208. (paredit-mode -1))
  209. (defvar paredit-backward-delete-key
  210. (xcond ((paredit-xemacs-p) "BS")
  211. ((paredit-gnu-emacs-p) "DEL")))
  212. (defvar paredit-forward-delete-keys
  213. (xcond ((paredit-xemacs-p) '("DEL"))
  214. ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
  215. ;;;; Paredit Keys
  216. ;;; Separating the definition and initialization of this variable
  217. ;;; simplifies the development of paredit, since re-evaluating DEFVAR
  218. ;;; forms doesn't actually do anything.
  219. (defvar paredit-commands nil
  220. "List of paredit commands with their keys and examples.")
  221. ;;; Each specifier is of the form:
  222. ;;; (key[s] function (example-input example-output) ...)
  223. ;;; where key[s] is either a single string suitable for passing to KBD
  224. ;;; or a list of such strings. Entries in this list may also just be
  225. ;;; strings, in which case they are headings for the next entries.
  226. (progn (setq paredit-commands
  227. `(
  228. "Basic Insertion Commands"
  229. ("(" paredit-open-round
  230. ("(a b |c d)"
  231. "(a b (|) c d)")
  232. ("(foo \"bar |baz\" quux)"
  233. "(foo \"bar (|baz\" quux)"))
  234. (")" paredit-close-round
  235. ("(a b |c )" "(a b c)|")
  236. ("; Hello,| world!"
  237. "; Hello,)| world!"))
  238. ("M-)" paredit-close-round-and-newline
  239. ("(defun f (x| ))"
  240. "(defun f (x)\n |)")
  241. ("; (Foo.|"
  242. "; (Foo.)|"))
  243. ("[" paredit-open-square
  244. ("(a b |c d)"
  245. "(a b [|] c d)")
  246. ("(foo \"bar |baz\" quux)"
  247. "(foo \"bar [|baz\" quux)"))
  248. ("]" paredit-close-square
  249. ("(define-key keymap [frob| ] 'frobnicate)"
  250. "(define-key keymap [frob]| 'frobnicate)")
  251. ("; [Bar.|"
  252. "; [Bar.]|"))
  253. ("\"" paredit-doublequote
  254. ("(frob grovel |full lexical)"
  255. "(frob grovel \"|\" full lexical)"
  256. "(frob grovel \"\"| full lexical)")
  257. ("(foo \"bar |baz\" quux)"
  258. "(foo \"bar \\\"|baz\" quux)")
  259. ("(frob grovel) ; full |lexical"
  260. "(frob grovel) ; full \"|lexical"))
  261. ("M-\"" paredit-meta-doublequote
  262. ("(foo \"bar |baz\" quux)"
  263. "(foo \"bar baz\"| quux)")
  264. ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
  265. ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
  266. "\\\\ quux\\\")\" zot)")))
  267. ("\\" paredit-backslash
  268. ("(string #|)\n ; Character to escape: x"
  269. "(string #\\x|)")
  270. ("\"foo|bar\"\n ; Character to escape: \""
  271. "\"foo\\\"|bar\""))
  272. (";" paredit-semicolon
  273. ("|(frob grovel)"
  274. ";|(frob grovel)")
  275. ("(frob |grovel)"
  276. "(frob ;|grovel\n )")
  277. ("(frob |grovel (bloit\n zargh))"
  278. "(frob ;|grovel\n (bloit\n zargh))")
  279. ("(frob grovel) |"
  280. "(frob grovel) ;|"))
  281. ("M-;" paredit-comment-dwim
  282. ("(foo |bar) ; baz"
  283. "(foo bar) ; |baz")
  284. ("(frob grovel)|"
  285. "(frob grovel) ;|")
  286. ("(zot (foo bar)\n|\n (baz quux))"
  287. "(zot (foo bar)\n ;; |\n (baz quux))")
  288. ("(zot (foo bar) |(baz quux))"
  289. "(zot (foo bar)\n ;; |\n (baz quux))")
  290. ("|(defun hello-world ...)"
  291. ";;; |\n(defun hello-world ...)"))
  292. ("C-j" paredit-newline
  293. ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
  294. ,(concat "(let ((n (frobbotz)))"
  295. "\n |(display (+ n 1)"
  296. "\n port))")))
  297. "Deleting & Killing"
  298. (("C-d" ,@paredit-forward-delete-keys)
  299. paredit-forward-delete
  300. ("(quu|x \"zot\")" "(quu| \"zot\")")
  301. ("(quux |\"zot\")"
  302. "(quux \"|zot\")"
  303. "(quux \"|ot\")")
  304. ("(foo (|) bar)" "(foo | bar)")
  305. ("|(foo bar)" "(|foo bar)"))
  306. (,paredit-backward-delete-key
  307. paredit-backward-delete
  308. ("(\"zot\" q|uux)" "(\"zot\" |uux)")
  309. ("(\"zot\"| quux)"
  310. "(\"zot|\" quux)"
  311. "(\"zo|\" quux)")
  312. ("(foo (|) bar)" "(foo | bar)")
  313. ("(foo bar)|" "(foo bar|)"))
  314. ("C-k" paredit-kill
  315. ("(foo bar)| ; Useless comment!"
  316. "(foo bar)|")
  317. ("(|foo bar) ; Useful comment!"
  318. "(|) ; Useful comment!")
  319. ("|(foo bar) ; Useless line!"
  320. "|")
  321. ("(foo \"|bar baz\"\n quux)"
  322. "(foo \"|\"\n quux)"))
  323. ("M-d" paredit-forward-kill-word
  324. ("|(foo bar) ; baz"
  325. "(| bar) ; baz"
  326. "(|) ; baz"
  327. "() ;|")
  328. (";;;| Frobnicate\n(defun frobnicate ...)"
  329. ";;;|\n(defun frobnicate ...)"
  330. ";;;\n(| frobnicate ...)"))
  331. (,(concat "M-" paredit-backward-delete-key)
  332. paredit-backward-kill-word
  333. ("(foo bar) ; baz\n(quux)|"
  334. "(foo bar) ; baz\n(|)"
  335. "(foo bar) ; |\n()"
  336. "(foo |) ; \n()"
  337. "(|) ; \n()"))
  338. "Movement & Navigation"
  339. ("C-M-f" paredit-forward
  340. ("(foo |(bar baz) quux)"
  341. "(foo (bar baz)| quux)")
  342. ("(foo (bar)|)"
  343. "(foo (bar))|"))
  344. ("C-M-b" paredit-backward
  345. ("(foo (bar baz)| quux)"
  346. "(foo |(bar baz) quux)")
  347. ("(|(foo) bar)"
  348. "|((foo) bar)"))
  349. ("C-M-u" paredit-backward-up)
  350. ("C-M-d" paredit-forward-down)
  351. ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD-
  352. ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have
  353. ; no need given C-M-f & C-M-b.
  354. "Depth-Changing Commands"
  355. ("M-(" paredit-wrap-round
  356. ("(foo |bar baz)"
  357. "(foo (|bar) baz)"))
  358. ("M-s" paredit-splice-sexp
  359. ("(foo (bar| baz) quux)"
  360. "(foo bar| baz quux)"))
  361. (("M-<up>" "ESC <up>")
  362. paredit-splice-sexp-killing-backward
  363. ("(foo (let ((x 5)) |(sqrt n)) bar)"
  364. "(foo |(sqrt n) bar)"))
  365. (("M-<down>" "ESC <down>")
  366. paredit-splice-sexp-killing-forward
  367. ("(a (b c| d e) f)"
  368. "(a b c| f)"))
  369. ("M-r" paredit-raise-sexp
  370. ("(dynamic-wind in (lambda () |body) out)"
  371. "(dynamic-wind in |body out)"
  372. "|body"))
  373. ("M-?" paredit-convolute-sexp
  374. ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))"
  375. "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))"))
  376. "Barfage & Slurpage"
  377. (("C-)" "C-<right>")
  378. paredit-forward-slurp-sexp
  379. ("(foo (bar |baz) quux zot)"
  380. "(foo (bar |baz quux) zot)")
  381. ("(a b ((c| d)) e f)"
  382. "(a b ((c| d) e) f)"))
  383. (("C-}" "C-<left>")
  384. paredit-forward-barf-sexp
  385. ("(foo (bar |baz quux) zot)"
  386. "(foo (bar |baz) quux zot)"))
  387. (("C-(" "C-M-<left>" "ESC C-<left>")
  388. paredit-backward-slurp-sexp
  389. ("(foo bar (baz| quux) zot)"
  390. "(foo (bar baz| quux) zot)")
  391. ("(a b ((c| d)) e f)"
  392. "(a (b (c| d)) e f)"))
  393. (("C-{" "C-M-<right>" "ESC C-<right>")
  394. paredit-backward-barf-sexp
  395. ("(foo (bar baz |quux) zot)"
  396. "(foo bar (baz |quux) zot)"))
  397. "Miscellaneous Commands"
  398. ("M-S" paredit-split-sexp
  399. ("(hello| world)"
  400. "(hello)| (world)")
  401. ("\"Hello, |world!\""
  402. "\"Hello, \"| \"world!\""))
  403. ("M-J" paredit-join-sexps
  404. ("(hello)| (world)"
  405. "(hello| world)")
  406. ("\"Hello, \"| \"world!\""
  407. "\"Hello, |world!\"")
  408. ("hello-\n| world"
  409. "hello-|world"))
  410. ("C-c C-M-l" paredit-recenter-on-sexp)
  411. ("M-q" paredit-reindent-defun)
  412. ))
  413. nil) ; end of PROGN
  414. ;;;;; Command Examples
  415. (eval-and-compile
  416. (defmacro paredit-do-commands (vars string-case &rest body)
  417. (let ((spec (nth 0 vars))
  418. (keys (nth 1 vars))
  419. (fn (nth 2 vars))
  420. (examples (nth 3 vars)))
  421. `(dolist (,spec paredit-commands)
  422. (if (stringp ,spec)
  423. ,string-case
  424. (let ((,keys (let ((k (car ,spec)))
  425. (cond ((stringp k) (list k))
  426. ((listp k) k)
  427. (t (error "Invalid paredit command %s."
  428. ,spec)))))
  429. (,fn (cadr ,spec))
  430. (,examples (cddr ,spec)))
  431. ,@body)))))
  432. (put 'paredit-do-commands 'lisp-indent-function 2))
  433. (defun paredit-define-keys ()
  434. (paredit-do-commands (spec keys fn examples)
  435. nil ; string case
  436. (dolist (key keys)
  437. (define-key paredit-mode-map (read-kbd-macro key) fn))))
  438. (defun paredit-function-documentation (fn)
  439. (let ((original-doc (get fn 'paredit-original-documentation))
  440. (doc (documentation fn 'function-documentation)))
  441. (or original-doc
  442. (progn (put fn 'paredit-original-documentation doc)
  443. doc))))
  444. (defun paredit-annotate-mode-with-examples ()
  445. (let ((contents
  446. (list (paredit-function-documentation 'paredit-mode))))
  447. (paredit-do-commands (spec keys fn examples)
  448. (push (concat "\n \n" spec "\n")
  449. contents)
  450. (let ((name (symbol-name fn)))
  451. (if (string-match (symbol-name 'paredit-) name)
  452. (push (concat "\n\n\\[" name "]\t" name
  453. (if examples
  454. (mapconcat (lambda (example)
  455. (concat
  456. "\n"
  457. (mapconcat 'identity
  458. example
  459. "\n --->\n")
  460. "\n"))
  461. examples
  462. "")
  463. "\n (no examples)\n"))
  464. contents))))
  465. (put 'paredit-mode 'function-documentation
  466. (apply 'concat (reverse contents))))
  467. ;; PUT returns the huge string we just constructed, which we don't
  468. ;; want it to return.
  469. nil)
  470. (defun paredit-annotate-functions-with-examples ()
  471. (paredit-do-commands (spec keys fn examples)
  472. nil ; string case
  473. (put fn 'function-documentation
  474. (concat (paredit-function-documentation fn)
  475. "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
  476. (mapconcat (lambda (example)
  477. (concat "\n"
  478. (mapconcat 'identity
  479. example
  480. "\n ->\n")
  481. "\n"))
  482. examples
  483. "")))))
  484. ;;;;; HTML Examples
  485. (defun paredit-insert-html-examples ()
  486. "Insert HTML for a paredit quick reference table."
  487. (interactive)
  488. (let ((insert-lines
  489. (lambda (&rest lines) (dolist (line lines) (insert line) (newline))))
  490. (initp nil))
  491. (paredit-do-commands (spec keys fn examples)
  492. (progn (if initp
  493. (funcall insert-lines "</table>")
  494. (setq initp t))
  495. (funcall insert-lines (concat "<h3>" spec "</h3>"))
  496. (funcall insert-lines "<table>"))
  497. (let ((name (symbol-name fn))
  498. (keys
  499. (mapconcat (lambda (key)
  500. (concat "<tt>" (paredit-html-quote key) "</tt>"))
  501. keys
  502. ", ")))
  503. (funcall insert-lines "<tr>")
  504. (funcall insert-lines (concat " <th align=\"left\">" keys "</th>"))
  505. (funcall insert-lines (concat " <th align=\"left\">" name "</th>"))
  506. (funcall insert-lines "</tr>")
  507. (funcall insert-lines
  508. "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>")
  509. (dolist (example examples)
  510. (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>")
  511. (examples
  512. (mapconcat 'paredit-html-quote
  513. example
  514. (concat "</pre></td></tr>"
  515. "<tr><th>&darr;</th></tr>"
  516. "<tr><td><pre>")))
  517. (suffix "</pre></td></tr></table></td></tr></table></td>"))
  518. (funcall insert-lines (concat prefix examples suffix))))
  519. (funcall insert-lines "</tr></table></td></tr>")))
  520. (funcall insert-lines "</table>")))
  521. (defun paredit-html-quote (string)
  522. (with-temp-buffer
  523. (dotimes (i (length string))
  524. (insert (let ((c (elt string i)))
  525. (cond ((eq c ?\<) "&lt;")
  526. ((eq c ?\>) "&gt;")
  527. ((eq c ?\&) "&amp;")
  528. ((eq c ?\') "&apos;")
  529. ((eq c ?\") "&quot;")
  530. (t c)))))
  531. (buffer-string)))
  532. ;;;; Delimiter Insertion
  533. (eval-and-compile
  534. (defun paredit-conc-name (&rest strings)
  535. (intern (apply 'concat strings)))
  536. (defmacro define-paredit-pair (open close name)
  537. `(progn
  538. (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
  539. ,(concat "Insert a balanced " name " pair.
  540. With a prefix argument N, put the closing " name " after N
  541. S-expressions forward.
  542. If the region is active, `transient-mark-mode' is enabled, and the
  543. region's start and end fall in the same parenthesis depth, insert a
  544. " name " pair around the region.
  545. If in a string or a comment, insert a single " name ".
  546. If in a character literal, do nothing. This prevents changing what was
  547. in the character literal to a meaningful delimiter unintentionally.")
  548. (interactive "P")
  549. (cond ((or (paredit-in-string-p)
  550. (paredit-in-comment-p))
  551. (insert ,open))
  552. ((not (paredit-in-char-p))
  553. (paredit-insert-pair n ,open ,close 'goto-char)
  554. (save-excursion (backward-up-list) (indent-sexp)))))
  555. (defun ,(paredit-conc-name "paredit-close-" name) ()
  556. ,(concat "Move past one closing delimiter and reindent.
  557. \(Agnostic to the specific closing delimiter.)
  558. If in a string or comment, insert a single closing " name ".
  559. If in a character literal, do nothing. This prevents changing what was
  560. in the character literal to a meaningful delimiter unintentionally.")
  561. (interactive)
  562. (paredit-move-past-close ,close))
  563. (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
  564. ,(concat "Move past one closing delimiter, add a newline,"
  565. " and reindent.
  566. If there was a margin comment after the closing delimiter, preserve it
  567. on the same line.")
  568. (interactive)
  569. (paredit-move-past-close-and-newline ,close))
  570. (defun ,(paredit-conc-name "paredit-wrap-" name)
  571. (&optional argument)
  572. ,(concat "Wrap the following S-expression.
  573. See `paredit-wrap-sexp' for more details.")
  574. (interactive "P")
  575. (paredit-wrap-sexp argument ,open ,close))
  576. (add-to-list 'paredit-wrap-commands
  577. ',(paredit-conc-name "paredit-wrap-" name)))))
  578. (defvar paredit-wrap-commands '(paredit-wrap-sexp)
  579. "List of paredit commands that wrap S-expressions.
  580. Used by `paredit-yank-pop'; for internal paredit use only.")
  581. (define-paredit-pair ?\( ?\) "round")
  582. (define-paredit-pair ?\[ ?\] "square")
  583. (define-paredit-pair ?\{ ?\} "curly")
  584. (define-paredit-pair ?\< ?\> "angled")
  585. ;;; Aliases for the old names.
  586. (defalias 'paredit-open-parenthesis 'paredit-open-round)
  587. (defalias 'paredit-close-parenthesis 'paredit-close-round)
  588. (defalias 'paredit-close-parenthesis-and-newline
  589. 'paredit-close-round-and-newline)
  590. (defalias 'paredit-open-bracket 'paredit-open-square)
  591. (defalias 'paredit-close-bracket 'paredit-close-square)
  592. (defalias 'paredit-close-bracket-and-newline
  593. 'paredit-close-square-and-newline)
  594. (defun paredit-move-past-close (close)
  595. (paredit-move-past-close-and close
  596. (lambda ()
  597. (paredit-blink-paren-match nil))))
  598. (defun paredit-move-past-close-and-newline (close)
  599. (paredit-move-past-close-and close
  600. (lambda ()
  601. (let ((comment.point (paredit-find-comment-on-line)))
  602. (newline)
  603. (if comment.point
  604. (save-excursion
  605. (forward-line -1)
  606. (end-of-line)
  607. (indent-to (cdr comment.point))
  608. (insert (car comment.point)))))
  609. (lisp-indent-line)
  610. (paredit-ignore-sexp-errors (indent-sexp))
  611. (paredit-blink-paren-match t))))
  612. (defun paredit-move-past-close-and (close if-moved)
  613. (if (or (paredit-in-string-p)
  614. (paredit-in-comment-p))
  615. (insert close)
  616. (if (paredit-in-char-p) (forward-char))
  617. (paredit-move-past-close-and-reindent close)
  618. (funcall if-moved)))
  619. (defun paredit-find-comment-on-line ()
  620. "Find a margin comment on the current line.
  621. Return nil if there is no such comment or if there is anything but
  622. whitespace until such a comment.
  623. If such a comment exists, delete the comment (including all leading
  624. whitespace) and return a cons whose car is the comment as a string
  625. and whose cdr is the point of the comment's initial semicolon,
  626. relative to the start of the line."
  627. (save-excursion
  628. (paredit-skip-whitespace t (point-at-eol))
  629. (and (eq ?\; (char-after))
  630. (not (eq ?\; (char-after (1+ (point)))))
  631. (not (or (paredit-in-string-p)
  632. (paredit-in-char-p)))
  633. (let* ((start ;Move to before the semicolon.
  634. (progn (backward-char) (point)))
  635. (comment
  636. (buffer-substring start (point-at-eol))))
  637. (paredit-skip-whitespace nil (point-at-bol))
  638. (delete-region (point) (point-at-eol))
  639. (cons comment (- start (point-at-bol)))))))
  640. (defun paredit-insert-pair (n open close forward)
  641. (let* ((regionp
  642. (and (paredit-region-active-p)
  643. (paredit-region-safe-for-insert-p)))
  644. (end
  645. (and regionp
  646. (not n)
  647. (prog1 (region-end) (goto-char (region-beginning))))))
  648. (let ((spacep (paredit-space-for-delimiter-p nil open)))
  649. (if spacep (insert " "))
  650. (insert open)
  651. (save-excursion
  652. ;; Move past the desired region.
  653. (cond (n
  654. (funcall forward
  655. (paredit-scan-sexps-hack (point)
  656. (prefix-numeric-value n))))
  657. (regionp
  658. (funcall forward (+ end (if spacep 2 1)))))
  659. ;; The string case can happen if we are inserting string
  660. ;; delimiters. The comment case may happen by moving to the
  661. ;; end of a buffer that has a comment with no trailing newline.
  662. (if (and (not (paredit-in-string-p))
  663. (paredit-in-comment-p))
  664. (newline))
  665. (insert close)
  666. (if (paredit-space-for-delimiter-p t close)
  667. (insert " "))))))
  668. ;++ This needs a better name...
  669. (defun paredit-scan-sexps-hack (point n)
  670. (save-excursion
  671. (goto-char point)
  672. (let ((direction (if (< 0 n) +1 -1))
  673. (magnitude (abs n))
  674. (count 0))
  675. (catch 'exit
  676. (while (< count magnitude)
  677. (let ((p
  678. (paredit-handle-sexp-errors (scan-sexps (point) direction)
  679. nil)))
  680. (if (not p) (throw 'exit nil))
  681. (goto-char p))
  682. (setq count (+ count 1)))))
  683. (point)))
  684. (defun paredit-region-safe-for-insert-p ()
  685. (save-excursion
  686. (let ((beginning (region-beginning))
  687. (end (region-end)))
  688. (goto-char beginning)
  689. (let* ((beginning-state (paredit-current-parse-state))
  690. (end-state
  691. (parse-partial-sexp beginning end nil nil beginning-state)))
  692. (and (= (nth 0 beginning-state) ; 0. depth in parens
  693. (nth 0 end-state))
  694. (eq (nth 3 beginning-state) ; 3. non-nil if inside a
  695. (nth 3 end-state)) ; string
  696. (eq (nth 4 beginning-state) ; 4. comment status, yada
  697. (nth 4 end-state))
  698. (eq (nth 5 beginning-state) ; 5. t if following char
  699. (nth 5 end-state))))))) ; quote
  700. (defvar paredit-space-for-delimiter-predicates nil
  701. "List of predicates for whether to put space by delimiter at point.
  702. Each predicate is a function that is is applied to two arguments, ENDP
  703. and DELIMITER, and that returns a boolean saying whether to put a
  704. space next to the delimiter -- before/after the delimiter if ENDP is
  705. false/true, respectively.
  706. If any predicate returns false, no space is inserted: every predicate
  707. has veto power.
  708. Each predicate may assume that the point is not at the beginning/end of
  709. the buffer, and that the point is preceded/followed by a word
  710. constituent, symbol constituent, string quote, or delimiter matching
  711. DELIMITER, if ENDP is false/true, respectively.
  712. Each predicate should examine only text before/after the point if ENDP is
  713. false/true, respectively.")
  714. (defun paredit-space-for-delimiter-p (endp delimiter)
  715. ;; If at the buffer limit, don't insert a space. If there is a word,
  716. ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
  717. ;; close when want an open the string or an open when we want to
  718. ;; close the string), do insert a space.
  719. (and (not (if endp (eobp) (bobp)))
  720. (memq (char-syntax (if endp (char-after) (char-before)))
  721. (list ?w ?_ ?\"
  722. (let ((matching (matching-paren delimiter)))
  723. (and matching (char-syntax matching)))
  724. (and (not endp)
  725. (eq ?\" (char-syntax delimiter))
  726. ?\) )))
  727. (catch 'exit
  728. (dolist (predicate paredit-space-for-delimiter-predicates)
  729. (if (not (funcall predicate endp delimiter))
  730. (throw 'exit nil)))
  731. t)))
  732. (defun paredit-move-past-close-and-reindent (close)
  733. (let ((open (paredit-missing-close)))
  734. (if open
  735. (if (eq close (matching-paren open))
  736. (save-excursion
  737. (message "Missing closing delimiter: %c" close)
  738. (insert close))
  739. (error "Mismatched missing closing delimiter: %c ... %c"
  740. open close))))
  741. (up-list)
  742. (if (catch 'return ; This CATCH returns T if it
  743. (while t ; should delete leading spaces
  744. (save-excursion ; and NIL if not.
  745. (let ((before-paren (1- (point))))
  746. (back-to-indentation)
  747. (cond ((not (eq (point) before-paren))
  748. ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
  749. ;; here -- we must return from SAVE-EXCURSION
  750. ;; first.
  751. (throw 'return t))
  752. ((save-excursion (forward-line -1)
  753. (end-of-line)
  754. (paredit-in-comment-p))
  755. ;; Moving the closing delimiter any further
  756. ;; would put it into a comment, so we just
  757. ;; indent the closing delimiter where it is and
  758. ;; abort the loop, telling its continuation that
  759. ;; no leading whitespace should be deleted.
  760. (lisp-indent-line)
  761. (throw 'return nil))
  762. (t (delete-indentation)))))))
  763. (paredit-delete-leading-whitespace)))
  764. (defun paredit-missing-close ()
  765. (save-excursion
  766. (paredit-handle-sexp-errors (backward-up-list)
  767. (error "Not inside a list."))
  768. (let ((open (char-after)))
  769. (paredit-handle-sexp-errors (progn (forward-sexp) nil)
  770. open))))
  771. (defun paredit-delete-leading-whitespace ()
  772. ;; This assumes that we're on the closing delimiter already.
  773. (save-excursion
  774. (backward-char)
  775. (while (let ((syn (char-syntax (char-before))))
  776. (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
  777. ;; The above line is a perfect example of why the
  778. ;; following test is necessary.
  779. (not (paredit-in-char-p (1- (point))))))
  780. (delete-char -1))))
  781. (defun paredit-blink-paren-match (another-line-p)
  782. (if (and blink-matching-paren
  783. (or (not show-paren-mode) another-line-p))
  784. (paredit-ignore-sexp-errors
  785. (save-excursion
  786. (backward-sexp)
  787. (forward-sexp)
  788. ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
  789. ;; locally here.
  790. (let ((show-paren-mode nil))
  791. (blink-matching-open))))))
  792. (defun paredit-doublequote (&optional n)
  793. "Insert a pair of double-quotes.
  794. With a prefix argument N, wrap the following N S-expressions in
  795. double-quotes, escaping intermediate characters if necessary.
  796. If the region is active, `transient-mark-mode' is enabled, and the
  797. region's start and end fall in the same parenthesis depth, insert a
  798. pair of double-quotes around the region, again escaping intermediate
  799. characters if necessary.
  800. Inside a comment, insert a literal double-quote.
  801. At the end of a string, move past the closing double-quote.
  802. In the middle of a string, insert a backslash-escaped double-quote.
  803. If in a character literal, do nothing. This prevents accidentally
  804. changing a what was in the character literal to become a meaningful
  805. delimiter unintentionally."
  806. (interactive "P")
  807. (cond ((paredit-in-string-p)
  808. (if (eq (point) (- (paredit-enclosing-string-end) 1))
  809. (forward-char) ; Just move past the closing quote.
  810. ;; Don't split a \x into an escaped backslash and a string end.
  811. (if (paredit-in-string-escape-p) (forward-char))
  812. (insert ?\\ ?\" )))
  813. ((paredit-in-comment-p)
  814. (insert ?\" ))
  815. ((not (paredit-in-char-p))
  816. (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
  817. (defun paredit-meta-doublequote (&optional n)
  818. "Move to the end of the string.
  819. If not in a string, act as `paredit-doublequote'; if not prefix argument
  820. is specified and the region is not active or `transient-mark-mode' is
  821. disabled, the default is to wrap one S-expression, however, not zero."
  822. (interactive "P")
  823. (if (not (paredit-in-string-p))
  824. (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
  825. (goto-char (paredit-enclosing-string-end))))
  826. (defun paredit-meta-doublequote-and-newline (&optional n)
  827. "Move to the end of the string, insert a newline, and indent.
  828. If not in a string, act as `paredit-doublequote'; if not prefix argument
  829. is specified and the region is not active or `transient-mark-mode' is
  830. disabled, the default is to wrap one S-expression, however, not zero."
  831. (interactive "P")
  832. (if (not (paredit-in-string-p))
  833. (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
  834. (progn (goto-char (paredit-enclosing-string-end))
  835. (newline)
  836. (lisp-indent-line)
  837. (paredit-ignore-sexp-errors (indent-sexp)))))
  838. (defun paredit-forward-for-quote (end)
  839. (let ((state (paredit-current-parse-state)))
  840. (while (< (point) end)
  841. (let ((new-state (parse-partial-sexp (point) (1+ (point))
  842. nil nil state)))
  843. (if (paredit-in-string-p new-state)
  844. (if (not (paredit-in-string-escape-p))
  845. (setq state new-state)
  846. ;; Escape character: turn it into an escaped escape
  847. ;; character by appending another backslash.
  848. (insert ?\\ )
  849. ;; Now the point is after both escapes, and we want to
  850. ;; rescan from before the first one to after the second
  851. ;; one.
  852. (setq state
  853. (parse-partial-sexp (- (point) 2) (point)
  854. nil nil state))
  855. ;; Advance the end point, since we just inserted a new
  856. ;; character.
  857. (setq end (1+ end)))
  858. ;; String: escape by inserting a backslash before the quote.
  859. (backward-char)
  860. (insert ?\\ )
  861. ;; The point is now between the escape and the quote, and we
  862. ;; want to rescan from before the escape to after the quote.
  863. (setq state
  864. (parse-partial-sexp (1- (point)) (1+ (point))
  865. nil nil state))
  866. ;; Advance the end point for the same reason as above.
  867. (setq end (1+ end)))))))
  868. ;;;; Escape Insertion
  869. (defun paredit-backslash ()
  870. "Insert a backslash followed by a character to escape."
  871. (interactive)
  872. (cond ((paredit-in-string-p) (paredit-backslash-interactive))
  873. ((paredit-in-comment-p) (insert ?\\))
  874. ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive))
  875. (t (paredit-backslash-interactive))))
  876. (defun paredit-backslash-interactive ()
  877. (insert ?\\ )
  878. ;; Read a character to insert after the backslash. If anything
  879. ;; goes wrong -- the user hits delete (entering the rubout
  880. ;; `character'), aborts with C-g, or enters non-character input
  881. ;; -- then delete the backslash to avoid a dangling escape.
  882. (let ((delete-p t))
  883. (unwind-protect
  884. (let ((char (read-char "Character to escape: " t)))
  885. (if (not (eq char ?\^?))
  886. (progn (message "Character to escape: %c" char)
  887. (insert char)
  888. (setq delete-p nil))))
  889. (if delete-p
  890. (progn (message "Deleting escape.")
  891. (delete-char -1))))))
  892. (defun paredit-newline ()
  893. "Insert a newline and indent it.
  894. This is like `newline-and-indent', but it not only indents the line
  895. that the point is on but also the S-expression following the point,
  896. if there is one.
  897. Move forward one character first if on an escaped character.
  898. If in a string, just insert a literal newline.
  899. If in a comment and if followed by invalid structure, call
  900. `indent-new-comment-line' to keep the invalid structure in a
  901. comment."
  902. (interactive)
  903. (cond ((paredit-in-string-p)
  904. (newline))
  905. ((paredit-in-comment-p)
  906. (if (paredit-region-ok-p (point) (point-at-eol))
  907. (progn (newline-and-indent)
  908. (paredit-ignore-sexp-errors (indent-sexp)))
  909. (indent-new-comment-line)))
  910. (t
  911. (if (paredit-in-char-p)
  912. (forward-char))
  913. (newline-and-indent)
  914. ;; Indent the following S-expression, but don't signal an
  915. ;; error if there's only a closing delimiter after the point.
  916. (paredit-ignore-sexp-errors (indent-sexp)))))
  917. (defun paredit-reindent-defun (&optional argument)
  918. "Reindent the definition that the point is on.
  919. If the point is in a string or a comment, fill the paragraph instead,
  920. and with a prefix argument, justify as well."
  921. (interactive "P")
  922. (if (or (paredit-in-string-p)
  923. (paredit-in-comment-p))
  924. (lisp-fill-paragraph argument)
  925. (paredit-preserving-column
  926. (save-excursion
  927. (end-of-defun)
  928. (beginning-of-defun)
  929. (indent-sexp)))))
  930. ;;;; Comment Insertion
  931. (defun paredit-semicolon (&optional n)
  932. "Insert a semicolon.
  933. With a prefix argument N, insert N semicolons.
  934. If in a string, do just that and nothing else.
  935. If in a character literal, move to the beginning of the character
  936. literal before inserting the semicolon.
  937. If the enclosing list ends on the line after the point, break the line
  938. after the last S-expression following the point.
  939. If a list begins on the line after the point but ends on a different
  940. line, break the line after the last S-expression following the point
  941. before the list."
  942. (interactive "p")
  943. (if (or (paredit-in-string-p) (paredit-in-comment-p))
  944. (insert (make-string (or n 1) ?\; ))
  945. (if (paredit-in-char-p)
  946. (backward-char 2))
  947. (let ((line-break-point (paredit-semicolon-find-line-break-point)))
  948. (if line-break-point
  949. (paredit-semicolon-with-line-break line-break-point (or n 1))
  950. (insert (make-string (or n 1) ?\; ))))))
  951. (defun paredit-semicolon-find-line-break-point ()
  952. (and (not (eolp)) ;Implies (not (eobp)).
  953. (let ((eol (point-at-eol)))
  954. (save-excursion
  955. (catch 'exit
  956. (while t
  957. (let ((line-break-point (point)))
  958. (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t)
  959. nil)
  960. ;; Successfully advanced by an S-expression.
  961. ;; If that S-expression started on this line
  962. ;; and ended on another one, break here.
  963. (cond ((not (eq eol (point-at-eol)))
  964. (throw 'exit
  965. (and (save-excursion
  966. (backward-sexp)
  967. (eq eol (point-at-eol)))
  968. line-break-point)))
  969. ((eobp)
  970. (throw 'exit nil))))
  971. ((save-excursion
  972. (paredit-skip-whitespace t (point-at-eol))
  973. (or (eolp) (eobp) (eq (char-after) ?\;)))
  974. ;; Can't move further, but there's no closing
  975. ;; delimiter we're about to clobber -- either
  976. ;; it's on the next line or we're at the end of
  977. ;; the buffer. Don't break the line.
  978. (throw 'exit nil))
  979. (t
  980. ;; Can't move because we hit a delimiter at the
  981. ;; end of this line. Break here.
  982. (throw 'exit line-break-point))))))))))
  983. (defun paredit-semicolon-with-line-break (line-break-point n)
  984. (let ((line-break-marker (make-marker)))
  985. (set-marker line-break-marker line-break-point)
  986. (set-marker-insertion-type line-break-marker t)
  987. (insert (make-string (or n 1) ?\; ))
  988. (save-excursion
  989. (goto-char line-break-marker)
  990. (set-marker line-break-marker nil)
  991. (newline)
  992. (lisp-indent-line)
  993. ;; This step is redundant if we are inside a list, but even if we
  994. ;; are at the top level, we want at least to indent whatever we
  995. ;; bumped off the line.
  996. (paredit-ignore-sexp-errors (indent-sexp))
  997. (paredit-indent-sexps))))
  998. ;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
  999. ;;; in which there is no `comment-or-uncomment-region'.
  1000. (autoload 'comment-forward "newcomment")
  1001. (autoload 'comment-normalize-vars "newcomment")
  1002. (autoload 'comment-region "newcomment")
  1003. (autoload 'comment-search-forward "newcomment")
  1004. (autoload 'uncomment-region "newcomment")
  1005. (defun paredit-initialize-comment-dwim ()
  1006. (require 'newcomment)
  1007. (if (not (fboundp 'comment-or-uncomment-region))
  1008. (defalias 'comment-or-uncomment-region
  1009. (lambda (beginning end &optional argument)
  1010. (interactive "*r\nP")
  1011. (if (save-excursion (goto-char beginning)
  1012. (comment-forward (point-max))
  1013. (<= end (point)))
  1014. (uncomment-region beginning end argument)
  1015. (comment-region beginning end argument)))))
  1016. (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
  1017. (comment-normalize-vars))
  1018. (defun paredit-comment-dwim (&optional argument)
  1019. "Call the Lisp comment command you want (Do What I Mean).
  1020. This is like `comment-dwim', but it is specialized for Lisp editing.
  1021. If transient mark mode is enabled and the mark is active, comment or
  1022. uncomment the selected region, depending on whether it was entirely
  1023. commented not not already.
  1024. If there is already a comment on the current line, with no prefix
  1025. argument, indent to that comment; with a prefix argument, kill that
  1026. comment.
  1027. Otherwise, insert a comment appropriate for the context and ensure that
  1028. any code following the comment is moved to the next line.
  1029. At the top level, where indentation is calculated to be at column 0,
  1030. insert a triple-semicolon comment; within code, where the indentation
  1031. is calculated to be non-zero, and on the line there is either no code
  1032. at all or code after the point, insert a double-semicolon comment;
  1033. and if the point is after all code on the line, insert a single-
  1034. semicolon margin comment at `comment-column'."
  1035. (interactive "*P")
  1036. (paredit-initialize-comment-dwim)
  1037. (cond ((paredit-region-active-p)
  1038. (comment-or-uncomment-region (region-beginning)
  1039. (region-end)
  1040. argument))
  1041. ((paredit-comment-on-line-p)
  1042. (if argument
  1043. (comment-kill (if (integerp argument) argument nil))
  1044. (comment-indent)))
  1045. (t (paredit-insert-comment))))
  1046. (defun paredit-comment-on-line-p ()
  1047. "True if there is a comment on the line following point.
  1048. This is expected to be called only in `paredit-comment-dwim'; do not
  1049. call it elsewhere."
  1050. (save-excursion
  1051. (beginning-of-line)
  1052. (let ((comment-p nil))
  1053. ;; Search forward for a comment beginning. If there is one, set
  1054. ;; COMMENT-P to true; if not, it will be nil.
  1055. (while (progn
  1056. (setq comment-p ;t -> no error
  1057. (comment-search-forward (point-at-eol) t))
  1058. (and comment-p
  1059. (or (paredit-in-string-p)
  1060. (paredit-in-char-p (1- (point))))))
  1061. (forward-char))
  1062. comment-p)))
  1063. (defun paredit-insert-comment ()
  1064. (let ((code-after-p
  1065. (save-excursion (paredit-skip-whitespace t (point-at-eol))
  1066. (not (eolp))))
  1067. (code-before-p
  1068. (save-excursion (paredit-skip-whitespace nil (point-at-bol))
  1069. (not (bolp)))))
  1070. (cond ((and (bolp)
  1071. (let ((indent
  1072. (let ((indent (calculate-lisp-indent)))
  1073. (if (consp indent) (car indent) indent))))
  1074. (and indent (zerop indent))))
  1075. ;; Top-level comment
  1076. (if code-after-p (save-excursion (newline)))
  1077. (insert ";;; "))
  1078. ((or code-after-p (not code-before-p))
  1079. ;; Code comment
  1080. (if code-before-p
  1081. (newline-and-indent)
  1082. (lisp-indent-line))
  1083. (insert ";; ")
  1084. (if code-after-p
  1085. (save-excursion
  1086. (newline)
  1087. (lisp-indent-line)
  1088. (paredit-indent-sexps))))
  1089. (t
  1090. ;; Margin comment
  1091. (indent-to comment-column 1) ; 1 -> force one leading space
  1092. (insert ?\; )))))
  1093. ;;;; Character Deletion
  1094. (defun paredit-forward-delete (&optional argument)
  1095. "Delete a character forward or move forward over a delimiter.
  1096. If on an opening S-expression delimiter, move forward into the
  1097. S-expression.
  1098. If on a closing S-expression delimiter, refuse to delete unless the
  1099. S-expression is empty, in which case delete the whole S-expression.
  1100. With a numeric prefix argument N, delete N characters forward.
  1101. With a `C-u' prefix argument, simply delete a character forward,
  1102. without regard for delimiter balancing."
  1103. (interactive "P")
  1104. (cond ((or (consp argument) (eobp))
  1105. (delete-char +1))
  1106. ((integerp argument)
  1107. (if (< argument 0)
  1108. (paredit-backward-delete argument)
  1109. (while (> argument 0)
  1110. (paredit-forward-delete)
  1111. (setq argument (- argument 1)))))
  1112. ((paredit-in-string-p)
  1113. (paredit-forward-delete-in-string))
  1114. ((paredit-in-comment-p)
  1115. (paredit-forward-delete-in-comment))
  1116. ((paredit-in-char-p) ; Escape -- delete both chars.
  1117. (delete-char -1)
  1118. (delete-char +1))
  1119. ((eq (char-after) ?\\ ) ; ditto
  1120. (delete-char +2))
  1121. ((let ((syn (char-syntax (char-after))))
  1122. (or (eq syn ?\( )
  1123. (eq syn ?\" )))
  1124. (if (save-excursion
  1125. (paredit-handle-sexp-errors (progn (forward-sexp) t)
  1126. nil))
  1127. (forward-char)
  1128. (message "Deleting spurious opening delimiter.")
  1129. (delete-char +1)))
  1130. ((and (not (paredit-in-char-p (1- (point))))
  1131. (eq (char-syntax (char-after)) ?\) )
  1132. (eq (char-before) (matching-paren (char-after))))
  1133. (delete-char -1) ; Empty list -- delete both
  1134. (delete-char +1)) ; delimiters.
  1135. ((eq ?\; (char-after))
  1136. (paredit-forward-delete-comment-start))
  1137. ((eq (char-syntax (char-after)) ?\) )
  1138. (if (paredit-handle-sexp-errors
  1139. (save-excursion (forward-char) (backward-sexp) t)
  1140. nil)
  1141. (message "End of list!")
  1142. (progn
  1143. (message "Deleting spurious closing delimiter.")
  1144. (delete-char +1))))
  1145. ;; Just delete a single character, if it's not a closing
  1146. ;; delimiter. (The character literal case is already handled
  1147. ;; by now.)
  1148. (t (delete-char +1))))
  1149. (defun paredit-forward-delete-in-string ()
  1150. (let ((start+end (paredit-string-start+end-points)))
  1151. (cond ((not (eq (point) (cdr start+end)))
  1152. ;; If it's not the close-quote, it's safe to delete. But
  1153. ;; first handle the case that we're in a string escape.
  1154. (cond ((paredit-in-string-escape-p)
  1155. ;; We're right after the backslash, so backward
  1156. ;; delete it before deleting the escaped character.
  1157. (delete-char -1))
  1158. ((eq (char-after) ?\\ )
  1159. ;; If we're not in a string escape, but we are on a
  1160. ;; backslash, it must start the escape for the next
  1161. ;; character, so delete the backslash before deleting
  1162. ;; the next character.
  1163. (delete-char +1)))
  1164. (delete-char +1))
  1165. ((eq (1- (point)) (car start+end))
  1166. ;; If it is the close-quote, delete only if we're also right
  1167. ;; past the open-quote (i.e. it's empty), and then delete
  1168. ;; both quotes. Otherwise we refuse to delete it.
  1169. (delete-char -1)
  1170. (delete-char +1)))))
  1171. (defun paredit-check-forward-delete-in-comment ()
  1172. ;; Point is in a comment, possibly at eol. We are about to delete
  1173. ;; some characters forward; if we are at eol, we are about to delete
  1174. ;; the line break. Refuse to do so if if moving the next line into
  1175. ;; the comment would break structure.
  1176. (if (eolp)
  1177. (let ((next-line-start (point-at-bol 2))
  1178. (next-line-end (point-at-eol 2)))
  1179. (paredit-check-region next-line-start next-line-end))))
  1180. (defun paredit-forward-delete-in-comment ()
  1181. (paredit-check-forward-delete-in-comment)
  1182. (delete-char +1))
  1183. (defun paredit-forward-delete-comment-start ()
  1184. ;; Point precedes a comment start (not at eol). Refuse to delete a
  1185. ;; comment start if the comment contains unbalanced junk.
  1186. (paredit-check-region (+ (point) 1) (point-at-eol))
  1187. (delete-char +1))
  1188. (defun paredit-backward-delete (&optional argument)
  1189. "Delete a character backward or move backward over a delimiter.
  1190. If on a closing S-expression delimiter, move backward into the
  1191. S-expression.
  1192. If on an opening S-expression delimiter, refuse to delete unless the
  1193. S-expression is empty, in which case delete the whole S-expression.
  1194. With a numeric prefix argument N, delete N characters backward.
  1195. With a `C-u' prefix argument, simply delete a character backward,
  1196. without regard for delimiter balancing."
  1197. (interactive "P")
  1198. (cond ((or (consp argument) (bobp))
  1199. ;++ Should this untabify?
  1200. (delete-char -1))
  1201. ((integerp argument)
  1202. (if (< argument 0)
  1203. (paredit-forward-delete (- 0 argument))
  1204. (while (> argument 0)
  1205. (paredit-backward-delete)
  1206. (setq argument (- argument 1)))))
  1207. ((paredit-in-string-p)
  1208. (paredit-backward-delete-in-string))
  1209. ((paredit-in-comment-p)
  1210. (paredit-backward-delete-in-comment))
  1211. ((paredit-in-char-p) ; Escape -- delete both chars.
  1212. (delete-char -1)
  1213. (delete-char +1))
  1214. ((paredit-in-char-p (1- (point)))
  1215. (delete-char -2)) ; ditto
  1216. ((let ((syn (char-syntax (char-before))))
  1217. (or (eq syn ?\) )
  1218. (eq syn ?\" )))
  1219. (if (save-excursion
  1220. (paredit-handle-sexp-errors (progn (backward-sexp) t)
  1221. nil))
  1222. (backward-char)
  1223. (message "Deleting spurious closing delimiter.")
  1224. (delete-char -1)))
  1225. ((and (eq (char-syntax (char-before)) ?\( )
  1226. (eq (char-after) (matching-paren (char-before))))
  1227. (delete-char -1) ; Empty list -- delete both
  1228. (delete-char +1)) ; delimiters.
  1229. ((bolp)
  1230. (paredit-backward-delete-maybe-comment-end))
  1231. ((eq (char-syntax (char-before)) ?\( )
  1232. (if (paredit-handle-sexp-errors
  1233. (save-excursion (backward-char) (forward-sexp) t)
  1234. nil)
  1235. (message "Beginning of list!")
  1236. (progn
  1237. (message "Deleting spurious closing delimiter.")
  1238. (delete-char -1))))
  1239. ;; Delete it, unless it's an opening delimiter. The case of
  1240. ;; character literals is already handled by now.
  1241. (t
  1242. ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed
  1243. ;; `backward-delete-char' and `backward-delete-char-untabify'
  1244. ;; semantically so that they delete the region in transient
  1245. ;; mark mode.
  1246. (let ((delete-active-region nil))
  1247. (backward-delete-char-untabify +1)))))
  1248. (defun paredit-backward-delete-in-string ()
  1249. (let ((start+end (paredit-string-start+end-points)))
  1250. (cond ((not (eq (1- (point)) (car start+end)))
  1251. ;; If it's not the open-quote, it's safe to delete.
  1252. (if (paredit-in-string-escape-p)
  1253. ;; If we're on a string escape, since we're about to
  1254. ;; delete the backslash, we must first delete the
  1255. ;; escaped char.
  1256. (delete-char +1))
  1257. (delete-char -1)
  1258. (if (paredit-in-string-escape-p)
  1259. ;; If, after deleting a character, we find ourselves in
  1260. ;; a string escape, we must have deleted the escaped
  1261. ;; character, and the backslash is behind the point, so
  1262. ;; backward delete it.
  1263. (delete-char -1)))
  1264. ((eq (point) (cdr start+end))
  1265. ;; If it is the open-quote, delete only if we're also right
  1266. ;; past the close-quote (i.e. it's empty), and then delete
  1267. ;; both quotes. Otherwise we refuse to delete it.
  1268. (delete-char -1)
  1269. (delete-char +1)))))
  1270. (defun paredit-backward-delete-in-comment ()
  1271. ;; Point is in a comment, possibly just after the comment start.
  1272. ;; Refuse to delete a comment start if the comment contains
  1273. ;; unbalanced junk.
  1274. (if (save-excursion
  1275. (backward-char)
  1276. ;; Must call `paredit-in-string-p' before
  1277. ;; `paredit-in-comment-p'.
  1278. (not (or (paredit-in-string-p) (paredit-in-comment-p))))
  1279. (paredit-check-region (point) (point-at-eol)))
  1280. (backward-delete-char-untabify +1))
  1281. (defun paredit-backward-delete-maybe-comment-end ()
  1282. ;; Point is at bol, possibly just after a comment end (i.e., the
  1283. ;; previous line may have had a line comment). Refuse to delete a
  1284. ;; comment end if moving the current line into the previous line's
  1285. ;; comment would break structure.
  1286. (if (save-excursion
  1287. (backward-char)
  1288. (and (not (paredit-in-string-p)) (paredit-in-comment-p)))
  1289. (paredit-check-region (point-at-eol) (point-at-bol)))
  1290. (delete-char -1))
  1291. ;;;; Killing
  1292. (defun paredit-kill (&optional argument)
  1293. "Kill a line as if with `kill-line', but respecting delimiters.
  1294. In a string, act exactly as `kill-line' but do not kill past the
  1295. closing string delimiter.
  1296. On a line with no S-expressions on it starting after the point or
  1297. within a comment, act exactly as `kill-line'.
  1298. Otherwise, kill all S-expressions that start after the point.
  1299. With a `C-u' prefix argument, just do the standard `kill-line'.
  1300. With a numeric prefix argument N, do `kill-line' that many times."
  1301. (interactive "P")
  1302. (cond (argument
  1303. (kill-line (if (integerp argument) argument 1)))
  1304. ((paredit-in-string-p)
  1305. (paredit-kill-line-in-string))
  1306. ((paredit-in-comment-p)
  1307. (paredit-kill-line-in-comment))
  1308. ((save-excursion (paredit-skip-whitespace t (point-at-eol))
  1309. (or (eolp) (eq (char-after) ?\; )))
  1310. ;** Be careful about trailing backslashes.
  1311. (if (paredit-in-char-p)
  1312. (backward-char))
  1313. (kill-line))
  1314. (t (paredit-kill-sexps-on-line))))
  1315. (defun paredit-kill-line-in-string ()
  1316. (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
  1317. (eolp))
  1318. (kill-line)
  1319. (save-excursion
  1320. ;; Be careful not to split an escape sequence.
  1321. (if (paredit-in-string-escape-p)
  1322. (backward-char))
  1323. (kill-region (point)
  1324. (min (point-at-eol)
  1325. (cdr (paredit-string-start+end-points)))))))
  1326. (defun paredit-kill-line-in-comment ()
  1327. ;; The variable `kill-whole-line' is not relevant: the point is in a
  1328. ;; comment, and hence not at the beginning of the line.
  1329. (paredit-check-forward-delete-in-comment)
  1330. (kill-line))
  1331. (defun paredit-kill-sexps-on-line ()
  1332. (if (paredit-in-char-p) ; Move past the \ and prefix.
  1333. (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
  1334. (let ((beginning (point))
  1335. (eol (point-at-eol)))
  1336. (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
  1337. ;; If we got to the end of the list and it's on the same line,
  1338. ;; move backward past the closing delimiter before killing. (This
  1339. ;; allows something like killing the whitespace in ( ).)
  1340. (if end-of-list-p (progn (up-list) (backward-char)))
  1341. (if kill-whole-line
  1342. (paredit-kill-sexps-on-whole-line beginning)
  1343. (kill-region beginning
  1344. ;; If all of the S-expressions were on one line,
  1345. ;; i.e. we're still on that line after moving past
  1346. ;; the last one, kill the whole line, including
  1347. ;; any comments; otherwise just kill to the end of
  1348. ;; the last S-expression we found. Be sure,
  1349. ;; though, not to kill any closing parentheses.
  1350. (if (and (not end-of-list-p)
  1351. (eq (point-at-eol) eol))
  1352. eol
  1353. (point)))))))
  1354. ;;; Please do not try to understand this code unless you have a VERY
  1355. ;;; good reason to do so. I gave up trying to figure it out well
  1356. ;;; enough to explain it, long ago.
  1357. (defun paredit-forward-sexps-to-kill (beginning eol)
  1358. (let ((end-of-list-p nil)
  1359. (firstp t))
  1360. ;; Move to the end of the last S-expression that started on this
  1361. ;; line, or to the closing delimiter if the last S-expression in
  1362. ;; this list is on the line.
  1363. (catch 'return
  1364. (while t
  1365. ;; This and the `kill-whole-line' business below fix a bug that
  1366. ;; inhibited any S-expression at the very end of the buffer
  1367. ;; (with no trailing newline) from being deleted. It's a
  1368. ;; bizarre fix that I ought to document at some point, but I am
  1369. ;; too busy at the moment to do so.
  1370. (if (and kill-whole-line (eobp)) (throw 'return nil))
  1371. (save-excursion
  1372. (paredit-handle-sexp-errors (forward-sexp)
  1373. (up-list)
  1374. (setq end-of-list-p (eq (point-at-eol) eol))
  1375. (throw 'return nil))
  1376. (if (or (and (not firstp)
  1377. (not kill-whole-line)
  1378. (eobp))
  1379. (paredit-handle-sexp-errors
  1380. (progn (backward-sexp) nil)
  1381. t)
  1382. (not (eq (point-at-eol) eol)))
  1383. (throw 'return nil)))
  1384. (forward-sexp)
  1385. (if (and firstp
  1386. (not kill-whole-line)
  1387. (eobp))
  1388. (throw 'return nil))
  1389. (setq firstp nil)))
  1390. end-of-list-p))
  1391. (defun paredit-kill-sexps-on-whole-line (beginning)
  1392. (kill-region beginning
  1393. (or (save-excursion ; Delete trailing indentation...
  1394. (paredit-skip-whitespace t)
  1395. (and (not (eq (char-after) ?\; ))
  1396. (point)))
  1397. ;; ...or just use the point past the newline, if
  1398. ;; we encounter a comment.
  1399. (point-at-eol)))
  1400. (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
  1401. (bolp))
  1402. ;; Nothing but indentation before the point, so indent it.
  1403. (lisp-indent-line))
  1404. ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
  1405. ;; Insert a space to avoid invalid joining if necessary.
  1406. ((let ((syn-before (char-syntax (char-before)))
  1407. (syn-after (char-syntax (char-after))))
  1408. (or (and (eq syn-before ?\) ) ; Separate opposing
  1409. (eq syn-after ?\( )) ; parentheses,
  1410. (and (eq syn-before ?\" ) ; string delimiter
  1411. (eq syn-after ?\" )) ; pairs,
  1412. (and (memq syn-before '(?_ ?w)) ; or word or symbol
  1413. (memq syn-after '(?_ ?w))))) ; constituents.
  1414. (insert " "))))
  1415. ;;;;; Killing Words
  1416. ;;; This is tricky and asymmetrical because backward parsing is
  1417. ;;; extraordinarily difficult or impossible, so we have to implement
  1418. ;;; killing in both directions by parsing forward.
  1419. (defun paredit-forward-kill-word ()
  1420. "Kill a word forward, skipping over intervening delimiters."
  1421. (interactive)
  1422. (let ((beginning (point)))
  1423. (skip-syntax-forward " -")
  1424. (let* ((parse-state (paredit-current-parse-state))
  1425. (state (paredit-kill-word-state parse-state 'char-after)))
  1426. (while (not (or (eobp)
  1427. (eq ?w (char-syntax (char-after)))))
  1428. (setq parse-state
  1429. (progn (forward-char 1) (paredit-current-parse-state))
  1430. ;; (parse-partial-sexp (point) (1+ (point))
  1431. ;; nil nil parse-state)
  1432. )
  1433. (let* ((old-state state)
  1434. (new-state
  1435. (paredit-kill-word-state parse-state 'char-after)))
  1436. (cond ((not (eq old-state new-state))
  1437. (setq parse-state
  1438. (paredit-kill-word-hack old-state
  1439. new-state
  1440. parse-state))
  1441. (setq state
  1442. (paredit-kill-word-state parse-state
  1443. 'char-after))
  1444. (setq beginning (point)))))))
  1445. (goto-char beginning)
  1446. (kill-word 1)))
  1447. (defun paredit-backward-kill-word ()
  1448. "Kill a word backward, skipping over any intervening delimiters."
  1449. (interactive)
  1450. (if (not (or (bobp)
  1451. (eq (char-syntax (char-before)) ?w)))
  1452. (let ((end (point)))
  1453. (backward-word 1)
  1454. (forward-word 1)
  1455. (goto-char (min end (point)))
  1456. (let* ((parse-state (paredit-current-parse-state))
  1457. (state
  1458. (paredit-kill-word-state parse-state 'char-before)))
  1459. (while (and (< (point) end)
  1460. (progn
  1461. (setq parse-state
  1462. (parse-partial-sexp (point) (1+ (point))
  1463. nil nil parse-state))
  1464. (or (eq state
  1465. (paredit-kill-word-state parse-state
  1466. 'char-before))
  1467. (progn (backward-char 1) nil)))))
  1468. (if (and (eq state 'comment)
  1469. (eq ?\# (char-after (point)))
  1470. (eq ?\| (char-before (point))))
  1471. (backward-char 1)))))
  1472. (backward-kill-word 1))
  1473. ;;;;;; Word-Killing Auxiliaries
  1474. (defun paredit-kill-word-state (parse-state adjacent-char-fn)
  1475. (cond ((paredit-in-comment-p parse-state) 'comment)
  1476. ((paredit-in-string-p parse-state) 'string)
  1477. ((memq (char-syntax (funcall adjacent-char-fn))
  1478. '(?\( ?\) ))
  1479. 'delimiter)
  1480. (t 'other)))
  1481. ;;; This optionally advances the point past any comment delimiters that
  1482. ;;; should probably not be touched, based on the last state change and
  1483. ;;; the characters around the point. It returns a new parse state,
  1484. ;;; starting from the PARSE-STATE parameter.
  1485. (defun paredit-kill-word-hack (old-state new-state parse-state)
  1486. (cond ((and (not (eq old-state 'comment))
  1487. (not (eq new-state 'comment))
  1488. (not (paredit-in-string-escape-p))
  1489. (eq ?\# (char-before))
  1490. (eq ?\| (char-after)))
  1491. (forward-char 1)
  1492. (paredit-current-parse-state)
  1493. ;; (parse-partial-sexp (point) (1+ (point))
  1494. ;; nil nil parse-state)
  1495. )
  1496. ((and (not (eq old-state 'comment))
  1497. (eq new-state 'comment)
  1498. (eq ?\; (char-before)))
  1499. (skip-chars-forward ";")
  1500. (paredit-current-parse-state)
  1501. ;; (parse-partial-sexp (point) (save-excursion
  1502. ;; (skip-chars-forward ";"))
  1503. ;; nil nil parse-state)
  1504. )
  1505. (t parse-state)))
  1506. (defun paredit-copy-as-kill ()
  1507. "Save in the kill ring the region that `paredit-kill' would kill."
  1508. (interactive)
  1509. (cond ((paredit-in-string-p)
  1510. (paredit-copy-as-kill-in-string))
  1511. ((paredit-in-comment-p)
  1512. (copy-region-as-kill (point) (point-at-eol)))
  1513. ((save-excursion (paredit-skip-whitespace t (point-at-eol))
  1514. (or (eolp) (eq (char-after) ?\; )))
  1515. ;** Be careful about trailing backslashes.
  1516. (save-excursion
  1517. (if (paredit-in-char-p)
  1518. (backward-char))
  1519. (copy-region-as-kill (point) (point-at-eol))))
  1520. (t (paredit-copy-sexps-as-kill))))
  1521. (defun paredit-copy-as-kill-in-string ()
  1522. (save-excursion
  1523. (if (paredit-in-string-escape-p)
  1524. (backward-char))
  1525. (copy-region-as-kill (point)
  1526. (min (point-at-eol)
  1527. (cdr (paredit-string-start+end-points))))))
  1528. (defun paredit-copy-sexps-as-kill ()
  1529. (save-excursion
  1530. (if (paredit-in-char-p)
  1531. (backward-char 2))
  1532. (let ((beginning (point))
  1533. (eol (point-at-eol)))
  1534. (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
  1535. (if end-of-list-p (progn (up-list) (backward-char)))
  1536. (copy-region-as-kill beginning
  1537. (cond (kill-whole-line
  1538. (or (save-excursion
  1539. (paredit-skip-whitespace t)
  1540. (and (not (eq (char-after) ?\; ))
  1541. (point)))
  1542. (point-at-eol)))
  1543. ((and (not end-of-list-p)
  1544. (eq (point-at-eol) eol))
  1545. eol)
  1546. (t
  1547. (point))))))))
  1548. ;;;; Deleting Regions
  1549. (defun paredit-delete-region (start end)
  1550. "Delete the text between point and mark, like `delete-region'.
  1551. If that text is unbalanced, signal an error instead.
  1552. With a prefix argument, skip the balance check."
  1553. (interactive "r")
  1554. (if (and start end (not current-prefix-arg))
  1555. (paredit-check-region-for-delete start end))
  1556. (setq this-command 'delete-region)
  1557. (delete-region start end))
  1558. (defun paredit-kill-region (start end)
  1559. "Kill the text between point and mark, like `kill-region'.
  1560. If that text is unbalanced, signal an error instead.
  1561. With a prefix argument, skip the balance check."
  1562. (interactive "r")
  1563. (if (and start end (not current-prefix-arg))
  1564. (paredit-check-region-for-delete start end))
  1565. (setq this-command 'kill-region)
  1566. (kill-region start end))
  1567. (defun paredit-check-region-for-delete (start end)
  1568. "Signal an error deleting text between START and END is unsafe."
  1569. (save-excursion
  1570. (goto-char start)
  1571. (let* ((start-state (paredit-current-parse-state))
  1572. (end-state (parse-partial-sexp start end nil nil start-state)))
  1573. (paredit-check-region-for-delete:depth start start-state end end-state)
  1574. (paredit-check-region-for-delete:string start start-state end end-state)
  1575. (paredit-check-region-for-delete:comment start start-state end end-state)
  1576. (paredit-check-region-for-delete:char-quote start start-state
  1577. end end-state))))
  1578. (defun paredit-check-region-for-delete:depth (start start-state end end-state)
  1579. (let ((start-depth (nth 0 start-state))
  1580. (end-depth (nth 0 end-state)))
  1581. (if (not (= start-depth end-depth))
  1582. (error "Mismatched parenthesis depth: %S at start, %S at end."
  1583. start-depth
  1584. end-depth))))
  1585. (defun paredit-check-region-for-delete:string (start start-state end end-state)
  1586. (let ((start-string-p (nth 3 start-state))
  1587. (end-string-p (nth 3 end-state)))
  1588. (if (not (eq start-string-p end-string-p))
  1589. (error "Mismatched string state: start %sin string, end %sin string."
  1590. (if start-string-p "" "not ")
  1591. (if end-string-p "" "not ")))))
  1592. (defun paredit-check-region-for-delete:comment
  1593. (start start-state end end-state)
  1594. (let ((start-comment-state (nth 4 start-state))
  1595. (end-comment-state (nth 4 end-state)))
  1596. (if (not (or (eq start-comment-state end-comment-state)
  1597. ;; If we are moving text into or out of a line
  1598. ;; comment, make sure that the text is balanced. (The
  1599. ;; comment state may be a number, not t or nil at all,
  1600. ;; for nestable comments, which are not handled by
  1601. ;; this heuristic (or any of paredit, really).)
  1602. (and (or (and (eq start-comment-state nil)
  1603. (eq end-comment-state t))
  1604. (and (eq start-comment-state t)
  1605. (eq end-comment-state nil)))
  1606. (save-excursion
  1607. (goto-char end)
  1608. (paredit-region-ok-p (point) (point-at-eol))))))
  1609. (error "Mismatched comment state: %s"
  1610. (cond ((and (integerp start-comment-state)
  1611. (integerp end-comment-state))
  1612. (format "depth %S at start, depth %S at end."
  1613. start-comment-state
  1614. end-comment-state))
  1615. ((integerp start-comment-state)
  1616. "start in nested comment, end otherwise.")
  1617. ((integerp end-comment-state)
  1618. "end in nested comment, start otherwise.")
  1619. (start-comment-state
  1620. "start in comment, end not in comment.")
  1621. (end-comment-state
  1622. "end in comment, start not in comment.")
  1623. (t
  1624. (format "start %S, end %S."
  1625. start-comment-state
  1626. end-comment-state)))))))
  1627. (defun paredit-check-region-for-delete:char-quote
  1628. (start start-state end end-state)
  1629. (let ((start-char-quote (nth 5 start-state))
  1630. (end-char-quote (nth 5 end-state)))
  1631. (if (not (eq start-char-quote end-char-quote))
  1632. (let ((phrase "character quotation"))
  1633. (error "Mismatched %s: start %sin %s, end %sin %s."
  1634. phrase
  1635. (if start-char-quote "" "not ")
  1636. phrase
  1637. (if end-char-quote "" "not ")
  1638. phrase)))))
  1639. ;;;; Point Motion
  1640. (eval-and-compile
  1641. (defmacro defun-motion (name bvl doc &rest body)
  1642. `(defun ,name ,bvl
  1643. ,doc
  1644. ,(xcond ((paredit-xemacs-p)
  1645. '(interactive "_"))
  1646. ((paredit-gnu-emacs-p)
  1647. ;++ Not sure this is sufficient for the `^'.
  1648. (if (fboundp 'handle-shift-selection)
  1649. '(interactive "^p")
  1650. '(interactive "p"))))
  1651. ,@body)))
  1652. (defun-motion paredit-forward (&optional arg)
  1653. "Move forward an S-expression, or up an S-expression forward.
  1654. If there are no more S-expressions in this one before the closing
  1655. delimiter, move past that closing delimiter; otherwise, move forward
  1656. past the S-expression following the point."
  1657. (let ((n (or arg 1)))
  1658. (cond ((< 0 n) (dotimes (i n) (paredit-move-forward)))
  1659. ((< n 0) (dotimes (i (- n)) (paredit-move-backward))))))
  1660. (defun-motion paredit-backward (&optional arg)
  1661. "Move backward an S-expression, or up an S-expression backward.
  1662. If there are no more S-expressions in this one before the opening
  1663. delimiter, move past that opening delimiter backward; otherwise, move
  1664. move backward past the S-expression preceding the point."
  1665. (let ((n (or arg 1)))
  1666. (cond ((< 0 n) (dotimes (i n) (paredit-move-backward)))
  1667. ((< n 0) (dotimes (i (- n)) (paredit-move-forward))))))
  1668. (defun paredit-move-forward ()
  1669. (cond ((paredit-in-string-p)
  1670. (let ((end (paredit-enclosing-string-end)))
  1671. ;; `forward-sexp' and `up-list' may move into the next string
  1672. ;; in the buffer. Don't do that; move out of the current one.
  1673. (if (paredit-handle-sexp-errors
  1674. (progn (paredit-handle-sexp-errors (forward-sexp)
  1675. (up-list))
  1676. (<= end (point)))
  1677. t)
  1678. (goto-char end))))
  1679. ((paredit-in-char-p)
  1680. (forward-char))
  1681. (t
  1682. (paredit-handle-sexp-errors (forward-sexp)
  1683. (up-list)))))
  1684. (defun paredit-move-backward ()
  1685. (cond ((paredit-in-string-p)
  1686. (let ((start (paredit-enclosing-string-start)))
  1687. (if (paredit-handle-sexp-errors
  1688. (progn (paredit-handle-sexp-errors (backward-sexp)
  1689. (backward-up-list))
  1690. (<= (point) start))
  1691. t)
  1692. (goto-char start))))
  1693. ((paredit-in-char-p)
  1694. ;++ Corner case: a buffer of `\|x'. What to do?
  1695. (backward-char 2))
  1696. (t
  1697. (paredit-handle-sexp-errors (backward-sexp)
  1698. (backward-up-list)))))
  1699. ;;;; Window Positioning
  1700. (defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp)
  1701. (defun paredit-recenter-on-sexp (&optional n)
  1702. "Recenter the screen on the S-expression following the point.
  1703. With a prefix argument N, encompass all N S-expressions forward."
  1704. (interactive "P")
  1705. (let* ((p (point))
  1706. (end-point (progn (forward-sexp n) (point)))
  1707. (start-point (progn (goto-char end-point) (backward-sexp n) (point))))
  1708. ;; Point is at beginning of first S-expression.
  1709. (let ((p-visible nil) (start-visible nil))
  1710. (save-excursion
  1711. (forward-line (/ (count-lines start-point end-point) 2))
  1712. (recenter)
  1713. (setq p-visible (pos-visible-in-window-p p))
  1714. (setq start-visible (pos-visible-in-window-p start-point)))
  1715. (cond ((not start-visible)
  1716. ;; Implies (not p-visible). Put the start at the top of
  1717. ;; the screen.
  1718. (recenter 0))
  1719. (p-visible
  1720. ;; Go back to p if we can.
  1721. (goto-char p))))))
  1722. (defun paredit-recenter-on-defun ()
  1723. "Recenter the screen on the definition at point."
  1724. (interactive)
  1725. (save-excursion
  1726. (beginning-of-defun)
  1727. (paredit-recenter-on-sexp)))
  1728. (defun paredit-focus-on-defun ()
  1729. "Moves display to the top of the definition at point."
  1730. (interactive)
  1731. (beginning-of-defun)
  1732. (recenter 0))
  1733. ;;;; Generalized Upward/Downward Motion
  1734. (defun paredit-up/down (n vertical-direction)
  1735. (let ((horizontal-direction (if (< 0 n) +1 -1)))
  1736. (while (/= n 0)
  1737. (goto-char
  1738. (paredit-next-up/down-point horizontal-direction vertical-direction))
  1739. (setq n (- n horizontal-direction)))))
  1740. (defun paredit-next-up/down-point (horizontal-direction vertical-direction)
  1741. (let ((state (paredit-current-parse-state))
  1742. (scan-lists
  1743. (lambda ()
  1744. (scan-lists (point) horizontal-direction vertical-direction))))
  1745. (cond ((paredit-in-string-p state)
  1746. (let ((start+end (paredit-string-start+end-points state)))
  1747. (if (< 0 vertical-direction)
  1748. (if (< 0 horizontal-direction)
  1749. (+ 1 (cdr start+end))
  1750. (car start+end))
  1751. ;; We could let the user try to descend into lists
  1752. ;; within the string, but that would be asymmetric
  1753. ;; with the up case, which rises out of the whole
  1754. ;; string and not just out of a list within the
  1755. ;; string, so this case will just be an error.
  1756. (error "Can't descend further into string."))))
  1757. ((< 0 vertical-direction)
  1758. ;; When moving up, just try to rise up out of the list.
  1759. (or (funcall scan-lists)
  1760. (buffer-end horizontal-direction)))
  1761. ((< vertical-direction 0)
  1762. ;; When moving down, look for a string closer than a list,
  1763. ;; and use that if we find it.
  1764. (let* ((list-start
  1765. (paredit-handle-sexp-errors (funcall scan-lists) nil))
  1766. (string-start
  1767. (paredit-find-next-string-start horizontal-direction
  1768. list-start)))
  1769. (if (and string-start list-start)
  1770. (if (< 0 horizontal-direction)
  1771. (min string-start list-start)
  1772. (max string-start list-start))
  1773. (or string-start
  1774. ;; Scan again: this is a kludgey way to report the
  1775. ;; error if there really was one.
  1776. (funcall scan-lists)
  1777. (buffer-end horizontal-direction)))))
  1778. (t
  1779. (error "Vertical direction must be nonzero in `%s'."
  1780. 'paredit-up/down)))))
  1781. (defun paredit-find-next-string-start (horizontal-direction limit)
  1782. (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp))
  1783. (next-char (if (< 0 horizontal-direction) 'char-after 'char-before))
  1784. (pastp (if (< 0 horizontal-direction) '> '<)))
  1785. (paredit-handle-sexp-errors
  1786. (save-excursion
  1787. (catch 'exit
  1788. (while t
  1789. (if (or (funcall buffer-limit-p)
  1790. (and limit (funcall pastp (point) limit)))
  1791. (throw 'exit nil))
  1792. (forward-sexp horizontal-direction)
  1793. (save-excursion
  1794. (backward-sexp horizontal-direction)
  1795. (if (eq ?\" (char-syntax (funcall next-char)))
  1796. (throw 'exit (+ (point) horizontal-direction)))))))
  1797. nil)))
  1798. (defun-motion paredit-forward-down (&optional argument)
  1799. "Move forward down into a list.
  1800. With a positive argument, move forward down that many levels.
  1801. With a negative argument, move backward down that many levels."
  1802. (paredit-up/down (or argument +1) -1))
  1803. (defun-motion paredit-backward-up (&optional argument)
  1804. "Move backward up out of the enclosing list.
  1805. With a positive argument, move backward up that many levels.
  1806. With a negative argument, move forward up that many levels.
  1807. If in a string initially, that counts as one level."
  1808. (paredit-up/down (- 0 (or argument +1)) +1))
  1809. (defun-motion paredit-forward-up (&optional argument)
  1810. "Move forward up out of the enclosing list.
  1811. With a positive argument, move forward up that many levels.
  1812. With a negative argument, move backward up that many levels.
  1813. If in a string initially, that counts as one level."
  1814. (paredit-up/down (or argument +1) +1))
  1815. (defun-motion paredit-backward-down (&optional argument)
  1816. "Move backward down into a list.
  1817. With a positive argument, move backward down that many levels.
  1818. With a negative argument, move forward down that many levels."
  1819. (paredit-up/down (- 0 (or argument +1)) -1))
  1820. ;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
  1821. (defun paredit-wrap-sexp (&optional argument open close)
  1822. "Wrap the following S-expression.
  1823. If a `C-u' prefix argument is given, wrap all S-expressions following
  1824. the point until the end of the buffer or of the enclosing list.
  1825. If a numeric prefix argument N is given, wrap N S-expressions.
  1826. Automatically indent the newly wrapped S-expression.
  1827. As a special case, if the point is at the end of a list, simply insert
  1828. a parenthesis pair, rather than inserting a lone opening delimiter
  1829. and then signalling an error, in the interest of preserving
  1830. structure.
  1831. By default OPEN and CLOSE are round delimiters."
  1832. (interactive "P")
  1833. (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
  1834. (let ((open (or open ?\( ))
  1835. (close (or close ?\) )))
  1836. (paredit-handle-sexp-errors
  1837. ((lambda (n) (paredit-insert-pair n open close 'goto-char))
  1838. (cond ((integerp argument) argument)
  1839. ((consp argument) (paredit-count-sexps-forward))
  1840. ((paredit-region-active-p) nil)
  1841. (t 1)))
  1842. (insert close)
  1843. (backward-char)))
  1844. (save-excursion (backward-up-list) (indent-sexp)))
  1845. (defun paredit-yank-pop (&optional argument)
  1846. "Replace just-yanked text with the next item in the kill ring.
  1847. If this command follows a `yank', just run `yank-pop'.
  1848. If this command follows a `paredit-wrap-sexp', or any other paredit
  1849. wrapping command (see `paredit-wrap-commands'), run `yank' and
  1850. reindent the enclosing S-expression.
  1851. If this command is repeated, run `yank-pop' and reindent the enclosing
  1852. S-expression.
  1853. The argument is passed on to `yank' or `yank-pop'; see their
  1854. documentation for details."
  1855. (interactive "*p")
  1856. (cond ((eq last-command 'yank)
  1857. (yank-pop argument))
  1858. ((memq last-command paredit-wrap-commands)
  1859. (yank argument)
  1860. ;; `yank' futzes with `this-command'.
  1861. (setq this-command 'paredit-yank-pop)
  1862. (save-excursion (backward-up-list) (indent-sexp)))
  1863. ((eq last-command 'paredit-yank-pop)
  1864. ;; Pretend we just did a `yank', so that we can use
  1865. ;; `yank-pop' without duplicating its definition.
  1866. (setq last-command 'yank)
  1867. (yank-pop argument)
  1868. ;; Return to our original state.
  1869. (setq last-command 'paredit-yank-pop)
  1870. (setq this-command 'paredit-yank-pop)
  1871. (save-excursion (backward-up-list) (indent-sexp)))
  1872. (t (error "Last command was not a yank or a wrap: %s" last-command))))
  1873. (defun paredit-splice-sexp (&optional argument)
  1874. "Splice the list that the point is on by removing its delimiters.
  1875. With a prefix argument as in `C-u', kill all S-expressions backward in
  1876. the current list before splicing all S-expressions forward into the
  1877. enclosing list.
  1878. With two prefix arguments as in `C-u C-u', kill all S-expressions
  1879. forward in the current list before splicing all S-expressions
  1880. backward into the enclosing list.
  1881. With a numerical prefix argument N, kill N S-expressions backward in
  1882. the current list before splicing the remaining S-expressions into the
  1883. enclosing list. If N is negative, kill forward.
  1884. Inside a string, unescape all backslashes, or signal an error if doing
  1885. so would invalidate the buffer's structure."
  1886. (interactive "P")
  1887. (if (paredit-in-string-p)
  1888. (paredit-splice-string argument)
  1889. (if (paredit-in-comment-p)
  1890. (error "Can't splice comment."))
  1891. (paredit-handle-sexp-errors (paredit-enclosing-list-start)
  1892. (error "Can't splice top level."))
  1893. (paredit-kill-surrounding-sexps-for-splice argument)
  1894. (let ((delete-start (paredit-enclosing-list-start))
  1895. (delete-end
  1896. (let ((limit
  1897. (save-excursion
  1898. (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
  1899. (point))))
  1900. (save-excursion
  1901. (backward-up-list)
  1902. (forward-char +1)
  1903. (paredit-skip-whitespace t limit)
  1904. (point)))))
  1905. (let ((end-marker (make-marker)))
  1906. (save-excursion
  1907. (up-list)
  1908. (delete-char -1)
  1909. (set-marker end-marker (point)))
  1910. (delete-region delete-start delete-end)
  1911. (paredit-splice-reindent delete-start (marker-position end-marker))))))
  1912. (defun paredit-splice-reindent (start end)
  1913. (paredit-preserving-column
  1914. ;; If we changed the first subform of the enclosing list, we must
  1915. ;; reindent the whole enclosing list.
  1916. (if (paredit-handle-sexp-errors
  1917. (save-excursion
  1918. (backward-up-list)
  1919. (down-list)
  1920. (paredit-ignore-sexp-errors (forward-sexp))
  1921. (< start (point)))
  1922. nil)
  1923. (save-excursion (backward-up-list) (indent-sexp))
  1924. (paredit-indent-region start end))))
  1925. (defun paredit-kill-surrounding-sexps-for-splice (argument)
  1926. (cond ((or (paredit-in-string-p)
  1927. (paredit-in-comment-p))
  1928. (error "Invalid context for splicing S-expressions."))
  1929. ((or (not argument) (eq argument 0)) nil)
  1930. ((or (numberp argument) (eq argument '-))
  1931. ;; Kill S-expressions before/after the point by saving the
  1932. ;; point, moving across them, and killing the region.
  1933. (let* ((argument (if (eq argument '-) -1 argument))
  1934. (saved (paredit-point-at-sexp-boundary (- argument))))
  1935. (goto-char saved)
  1936. (paredit-ignore-sexp-errors (backward-sexp argument))
  1937. (paredit-hack-kill-region saved (point))))
  1938. ((consp argument)
  1939. (let ((v (car argument)))
  1940. (if (= v 4) ;One `C-u'.
  1941. ;; Move backward until we hit the open paren; then
  1942. ;; kill that selected region.
  1943. (let ((end (point)))
  1944. (paredit-ignore-sexp-errors
  1945. (while (not (bobp))
  1946. (backward-sexp)))
  1947. (paredit-hack-kill-region (point) end))
  1948. ;; Move forward until we hit the close paren; then
  1949. ;; kill that selected region.
  1950. (let ((beginning (point)))
  1951. (paredit-ignore-sexp-errors
  1952. (while (not (eobp))
  1953. (forward-sexp)))
  1954. (paredit-hack-kill-region beginning (point))))))
  1955. (t (error "Bizarre prefix argument `%s'." argument))))
  1956. (defun paredit-splice-sexp-killing-backward (&optional n)
  1957. "Splice the list the point is on by removing its delimiters, and
  1958. also kill all S-expressions before the point in the current list.
  1959. With a prefix argument N, kill only the preceding N S-expressions."
  1960. (interactive "P")
  1961. (paredit-splice-sexp (if n
  1962. (prefix-numeric-value n)
  1963. '(4))))
  1964. (defun paredit-splice-sexp-killing-forward (&optional n)
  1965. "Splice the list the point is on by removing its delimiters, and
  1966. also kill all S-expressions after the point in the current list.
  1967. With a prefix argument N, kill only the following N S-expressions."
  1968. (interactive "P")
  1969. (paredit-splice-sexp (if n
  1970. (- (prefix-numeric-value n))
  1971. '(16))))
  1972. (defun paredit-raise-sexp (&optional argument)
  1973. "Raise the following S-expression in a tree, deleting its siblings.
  1974. With a prefix argument N, raise the following N S-expressions. If N
  1975. is negative, raise the preceding N S-expressions.
  1976. If the point is on an S-expression, such as a string or a symbol, not
  1977. between them, that S-expression is considered to follow the point."
  1978. (interactive "P")
  1979. (save-excursion
  1980. (cond ((paredit-in-string-p)
  1981. (goto-char (car (paredit-string-start+end-points))))
  1982. ((paredit-in-char-p)
  1983. (backward-sexp))
  1984. ((paredit-in-comment-p)
  1985. (error "No S-expression to raise in comment.")))
  1986. ;; Select the S-expressions we want to raise in a buffer substring.
  1987. (let* ((n (prefix-numeric-value argument))
  1988. (bound (scan-sexps (point) n))
  1989. (sexps
  1990. (if (< n 0)
  1991. (buffer-substring bound (paredit-point-at-sexp-end))
  1992. (buffer-substring (paredit-point-at-sexp-start) bound))))
  1993. ;; Move up to the list we're raising those S-expressions out of and
  1994. ;; delete it.
  1995. (backward-up-list)
  1996. (delete-region (point) (scan-sexps (point) 1))
  1997. (let* ((indent-start (point))
  1998. (indent-end (save-excursion (insert sexps) (point))))
  1999. ;; If the expression spans multiple lines, its indentation is
  2000. ;; probably broken, so reindent it -- but don't reindent
  2001. ;; anything that we didn't touch outside the expression.
  2002. ;;
  2003. ;; XXX What if the *column* of the starting point was preserved
  2004. ;; too? Should we avoid reindenting in that case?
  2005. (if (not (eq (save-excursion (goto-char indent-start) (point-at-eol))
  2006. (save-excursion (goto-char indent-end) (point-at-eol))))
  2007. (indent-region indent-start indent-end nil))))))
  2008. ;;; The effects of convolution on the surrounding whitespace are pretty
  2009. ;;; random. If you have better suggestions, please let me know.
  2010. (defun paredit-convolute-sexp (&optional n)
  2011. "Convolute S-expressions.
  2012. Save the S-expressions preceding point and delete them.
  2013. Splice the S-expressions following point.
  2014. Wrap the enclosing list in a new list prefixed by the saved text.
  2015. With a prefix argument N, move up N lists before wrapping."
  2016. (interactive "p")
  2017. (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
  2018. ;; Make sure we can move up before destroying anything.
  2019. (save-excursion (backward-up-list n) (backward-up-list))
  2020. (let (open close) ;++ Is this a good idea?
  2021. (let ((prefix
  2022. (let ((end (point)))
  2023. (paredit-ignore-sexp-errors
  2024. (while (not (bobp)) (backward-sexp)))
  2025. (prog1 (buffer-substring (point) end)
  2026. (backward-up-list)
  2027. (save-excursion (forward-sexp)
  2028. (setq close (char-before))
  2029. (delete-char -1))
  2030. (setq open (char-after))
  2031. (delete-region (point) end)
  2032. ;; I'm not sure this makes sense...
  2033. (if (not (eolp)) (just-one-space))))))
  2034. (backward-up-list n)
  2035. (paredit-insert-pair 1 open close 'goto-char)
  2036. (insert prefix)
  2037. ;; I'm not sure this makes sense either...
  2038. (if (not (eolp)) (just-one-space))
  2039. (save-excursion
  2040. (backward-up-list)
  2041. (paredit-ignore-sexp-errors (indent-sexp))))))
  2042. (defun paredit-splice-string (argument)
  2043. (let ((original-point (point))
  2044. (start+end (paredit-string-start+end-points)))
  2045. (let ((start (car start+end))
  2046. (end (cdr start+end)))
  2047. ;; START and END both lie before the respective quote
  2048. ;; characters, which we want to delete; thus we increment START
  2049. ;; by one to extract the string, and we increment END by one to
  2050. ;; delete the string.
  2051. (let* ((escaped-string
  2052. (cond ((not (consp argument))
  2053. (buffer-substring (1+ start) end))
  2054. ((= 4 (car argument))
  2055. (buffer-substring original-point end))
  2056. (t
  2057. (buffer-substring (1+ start) original-point))))
  2058. (unescaped-string
  2059. (paredit-unescape-string escaped-string)))
  2060. (if (not unescaped-string)
  2061. (error "Unspliceable string.")
  2062. (save-excursion
  2063. (goto-char start)
  2064. (delete-region start (1+ end))
  2065. (insert unescaped-string))
  2066. (if (not (and (consp argument)
  2067. (= 4 (car argument))))
  2068. (goto-char (- original-point 1))))))))
  2069. (defun paredit-unescape-string (string)
  2070. (with-temp-buffer
  2071. (insert string)
  2072. (goto-char (point-min))
  2073. (while (and (not (eobp))
  2074. ;; nil -> no bound; t -> no errors.
  2075. (search-forward "\\" nil t))
  2076. (delete-char -1)
  2077. (forward-char))
  2078. (paredit-handle-sexp-errors
  2079. (progn (scan-sexps (point-min) (point-max))
  2080. (buffer-string))
  2081. nil)))
  2082. ;;;; Slurpage & Barfage
  2083. (defun paredit-forward-slurp-sexp (&optional argument)
  2084. "Add the S-expression following the current list into that list
  2085. by moving the closing delimiter.
  2086. Automatically reindent the newly slurped S-expression with respect to
  2087. its new enclosing form.
  2088. If in a string, move the opening double-quote forward by one
  2089. S-expression and escape any intervening characters as necessary,
  2090. without altering any indentation or formatting."
  2091. (interactive "P")
  2092. (save-excursion
  2093. (cond ((paredit-in-comment-p)
  2094. (error "Invalid context for slurping S-expressions."))
  2095. ((numberp argument)
  2096. (if (< argument 0)
  2097. (paredit-forward-barf-sexp (- 0 argument))
  2098. (while (< 0 argument)
  2099. (paredit-forward-slurp-sexp)
  2100. (setq argument (- argument 1)))))
  2101. ((paredit-in-string-p)
  2102. ;; If there is anything to slurp into the string, take that.
  2103. ;; Otherwise, try to slurp into the enclosing list.
  2104. (if (save-excursion
  2105. (goto-char (paredit-enclosing-string-end))
  2106. (paredit-handle-sexp-errors (progn (forward-sexp) nil)
  2107. t))
  2108. (progn
  2109. (goto-char (paredit-enclosing-string-end))
  2110. (paredit-forward-slurp-into-list argument))
  2111. (paredit-forward-slurp-into-string argument)))
  2112. (t
  2113. (paredit-forward-slurp-into-list argument)))))
  2114. (defun paredit-forward-slurp-into-list (&optional argument)
  2115. (let ((nestedp nil))
  2116. (save-excursion
  2117. (up-list) ; Up to the end of the list to
  2118. (let ((close (char-before))) ; save and delete the closing
  2119. (delete-char -1) ; delimiter.
  2120. (let ((start (point)))
  2121. (catch 'return ; Go to the end of the desired
  2122. (while t ; S-expression, going up a
  2123. (paredit-handle-sexp-errors ; list if it's not in this,
  2124. (progn (forward-sexp)
  2125. (if argument
  2126. (paredit-ignore-sexp-errors
  2127. (while (not (eobp))
  2128. (forward-sexp))))
  2129. (throw 'return nil))
  2130. (setq nestedp t)
  2131. (up-list)
  2132. (setq close ; adjusting for mixed
  2133. (prog1 (char-before) ; delimiters as necessary,
  2134. (delete-char -1)
  2135. (insert close))))))
  2136. (insert close) ; to insert that delimiter.
  2137. (indent-region start (point) nil))))
  2138. (if (and (not nestedp)
  2139. (eq (save-excursion (paredit-skip-whitespace nil) (point))
  2140. (save-excursion (backward-up-list) (forward-char) (point)))
  2141. (eq (save-excursion (forward-sexp) (backward-sexp) (point))
  2142. (save-excursion (paredit-skip-whitespace t) (point))))
  2143. (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
  2144. (save-excursion (paredit-skip-whitespace t) (point))))))
  2145. (defun paredit-forward-slurp-into-string (&optional argument)
  2146. (let ((start (paredit-enclosing-string-start))
  2147. (end (paredit-enclosing-string-end)))
  2148. (goto-char end)
  2149. ;; Signal any errors that we might get first, before mucking with
  2150. ;; the buffer's contents.
  2151. (save-excursion (forward-sexp))
  2152. (let ((close (char-before)))
  2153. ;; Skip intervening whitespace if we're slurping into an empty
  2154. ;; string. XXX What about nonempty strings?
  2155. (if (and (= (+ start 2) end)
  2156. (eq (save-excursion (paredit-skip-whitespace t) (point))
  2157. (save-excursion (forward-sexp) (backward-sexp) (point))))
  2158. (delete-region (- (point) 1)
  2159. (save-excursion (paredit-skip-whitespace t) (point)))
  2160. (delete-char -1))
  2161. (paredit-forward-for-quote
  2162. (save-excursion
  2163. (forward-sexp)
  2164. (if argument
  2165. (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil)))
  2166. (point)))
  2167. (insert close))))
  2168. (defun paredit-forward-barf-sexp (&optional argument)
  2169. "Remove the last S-expression in the current list from that list
  2170. by moving the closing delimiter.
  2171. Automatically reindent the newly barfed S-expression with respect to
  2172. its new enclosing form."
  2173. (interactive "P")
  2174. (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp)
  2175. (if (and (numberp argument) (< argument 0))
  2176. (paredit-forward-slurp-sexp (- 0 argument))
  2177. (let ((start (point)) (end nil))
  2178. (save-excursion
  2179. (up-list) ; Up to the end of the list to
  2180. (let ((close (char-before))) ; save and delete the closing
  2181. (delete-char -1) ; delimiter.
  2182. (setq end (point))
  2183. (paredit-ignore-sexp-errors ; Go back to where we want to
  2184. (if (or (not argument) ; insert the delimiter.
  2185. (numberp argument))
  2186. (backward-sexp argument)
  2187. (while (paredit-handle-sexp-errors
  2188. (save-excursion (backward-sexp) (<= start (point)))
  2189. nil)
  2190. (backward-sexp))))
  2191. (paredit-skip-whitespace nil) ; Skip leading whitespace.
  2192. (cond ((bobp)
  2193. ;++ We'll have deleted the close, but there's no open.
  2194. ;++ Is that OK?
  2195. (error "Barfing all subexpressions with no open-paren?"))
  2196. ((paredit-in-comment-p) ; Don't put the close-paren in
  2197. (newline))) ; a comment.
  2198. (insert close))
  2199. ;; Reindent all of the newly barfed S-expressions. Start at the
  2200. ;; start of the first barfed S-expression, not at the close we
  2201. ;; just inserted.
  2202. (forward-sexp)
  2203. (backward-sexp)
  2204. (if (or (not argument) (numberp argument))
  2205. (paredit-forward-and-indent argument)
  2206. (indent-region (point) end))))))
  2207. (defun paredit-backward-slurp-sexp (&optional argument)
  2208. "Add the S-expression preceding the current list into that list
  2209. by moving the closing delimiter.
  2210. Automatically reindent the whole form into which new S-expression was
  2211. slurped.
  2212. If in a string, move the opening double-quote backward by one
  2213. S-expression and escape any intervening characters as necessary,
  2214. without altering any indentation or formatting."
  2215. (interactive "P")
  2216. (save-excursion
  2217. (cond ((paredit-in-comment-p)
  2218. (error "Invalid context for slurping S-expressions."))
  2219. ((numberp argument)
  2220. (if (< argument 0)
  2221. (paredit-backward-barf-sexp (- 0 argument))
  2222. (while (< 0 argument)
  2223. (paredit-backward-slurp-sexp)
  2224. (setq argument (- argument 1)))))
  2225. ((paredit-in-string-p)
  2226. ;; If there is anything to slurp into the string, take that.
  2227. ;; Otherwise, try to slurp into the enclosing list.
  2228. (if (save-excursion
  2229. (goto-char (paredit-enclosing-string-start))
  2230. (paredit-handle-sexp-errors (progn (backward-sexp) nil)
  2231. t))
  2232. (progn
  2233. (goto-char (paredit-enclosing-string-start))
  2234. (paredit-backward-slurp-into-list argument))
  2235. (paredit-backward-slurp-into-string argument)))
  2236. (t
  2237. (paredit-backward-slurp-into-list argument)))))
  2238. (defun paredit-backward-slurp-into-list (&optional argument)
  2239. (let ((nestedp nil))
  2240. (save-excursion
  2241. (backward-up-list)
  2242. (let ((open (char-after)))
  2243. (delete-char +1)
  2244. (catch 'return
  2245. (while t
  2246. (paredit-handle-sexp-errors
  2247. (progn (backward-sexp)
  2248. (if argument
  2249. (paredit-ignore-sexp-errors
  2250. (while (not (bobp))
  2251. (backward-sexp))))
  2252. (throw 'return nil))
  2253. (setq nestedp t)
  2254. (backward-up-list)
  2255. (setq open
  2256. (prog1 (char-after)
  2257. (save-excursion (insert open) (delete-char +1)))))))
  2258. (insert open))
  2259. ;; Reindent the line at the beginning of wherever we inserted the
  2260. ;; opening delimiter, and then indent the whole S-expression.
  2261. (backward-up-list)
  2262. (lisp-indent-line)
  2263. (indent-sexp))
  2264. ;; If we slurped into an empty list, don't leave dangling space:
  2265. ;; (foo |).
  2266. (if (and (not nestedp)
  2267. (eq (save-excursion (paredit-skip-whitespace nil) (point))
  2268. (save-excursion (backward-sexp) (forward-sexp) (point)))
  2269. (eq (save-excursion (up-list) (backward-char) (point))
  2270. (save-excursion (paredit-skip-whitespace t) (point))))
  2271. (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
  2272. (save-excursion (paredit-skip-whitespace t) (point))))))
  2273. (defun paredit-backward-slurp-into-string (&optional argument)
  2274. (let ((start (paredit-enclosing-string-start))
  2275. (end (paredit-enclosing-string-end)))
  2276. (goto-char start)
  2277. ;; Signal any errors that we might get first, before mucking with
  2278. ;; the buffer's contents.
  2279. (save-excursion (backward-sexp))
  2280. (let ((open (char-after))
  2281. (target (point)))
  2282. ;; Skip intervening whitespace if we're slurping into an empty
  2283. ;; string. XXX What about nonempty strings?
  2284. (if (and (= (+ start 2) end)
  2285. (eq (save-excursion (paredit-skip-whitespace nil) (point))
  2286. (save-excursion (backward-sexp) (forward-sexp) (point))))
  2287. (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
  2288. (+ (point) 1))
  2289. (delete-char +1))
  2290. (backward-sexp)
  2291. (if argument
  2292. (paredit-ignore-sexp-errors
  2293. (while (not (bobp))
  2294. (backward-sexp))))
  2295. (insert open)
  2296. (paredit-forward-for-quote target))))
  2297. (defun paredit-backward-barf-sexp (&optional argument)
  2298. "Remove the first S-expression in the current list from that list
  2299. by moving the closing delimiter.
  2300. Automatically reindent the barfed S-expression and the form from which
  2301. it was barfed."
  2302. (interactive "P")
  2303. (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp)
  2304. (if (and (numberp argument) (< argument 0))
  2305. (paredit-backward-slurp-sexp (- 0 argument))
  2306. (let ((end (make-marker)))
  2307. (set-marker end (point))
  2308. (save-excursion
  2309. (backward-up-list)
  2310. (let ((open (char-after)))
  2311. (delete-char +1)
  2312. (paredit-ignore-sexp-errors
  2313. (paredit-forward-and-indent
  2314. (if (or (not argument) (numberp argument))
  2315. argument
  2316. (let ((n 0))
  2317. (save-excursion
  2318. (while (paredit-handle-sexp-errors
  2319. (save-excursion
  2320. (forward-sexp)
  2321. (<= (point) end))
  2322. nil)
  2323. (forward-sexp)
  2324. (setq n (+ n 1))))
  2325. n))))
  2326. (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; ))
  2327. (forward-line 1))
  2328. (if (eobp)
  2329. ;++ We'll have deleted the close, but there's no open.
  2330. ;++ Is that OK?
  2331. (error "Barfing all subexpressions with no close-paren?"))
  2332. ;** Don't use `insert' here. Consider, e.g., barfing from
  2333. ;** (foo|)
  2334. ;** and how `save-excursion' works.
  2335. (insert-before-markers open))
  2336. (backward-up-list)
  2337. (lisp-indent-line)
  2338. (indent-sexp)))))
  2339. ;;;; Splitting & Joining
  2340. (defun paredit-split-sexp ()
  2341. "Split the list or string the point is on into two."
  2342. (interactive)
  2343. (cond ((paredit-in-string-p)
  2344. (insert "\"")
  2345. (save-excursion (insert " \"")))
  2346. ((or (paredit-in-comment-p)
  2347. (paredit-in-char-p))
  2348. (error "Invalid context for splitting S-expression."))
  2349. (t
  2350. (let ((open (save-excursion (backward-up-list) (char-after)))
  2351. (close (save-excursion (up-list) (char-before))))
  2352. (delete-horizontal-space)
  2353. (insert close)
  2354. (save-excursion
  2355. (insert ?\ )
  2356. (insert open)
  2357. (backward-char)
  2358. (indent-sexp))))))
  2359. (defun paredit-join-sexps ()
  2360. "Join the S-expressions adjacent on either side of the point.
  2361. Both must be lists, strings, or atoms; error if there is a mismatch."
  2362. (interactive)
  2363. (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment."))
  2364. ((paredit-in-string-p) (error "Nothing to join in a string."))
  2365. ((paredit-in-char-p) (error "Can't join characters.")))
  2366. (let ((left-point (paredit-point-at-sexp-end))
  2367. (right-point (paredit-point-at-sexp-start)))
  2368. (let ((left-char (char-before left-point))
  2369. (right-char (char-after right-point)))
  2370. (let ((left-syntax (char-syntax left-char))
  2371. (right-syntax (char-syntax right-char)))
  2372. (cond ((< right-point left-point)
  2373. (error "Can't join a datum with itself."))
  2374. ((and (eq left-syntax ?\) )
  2375. (eq right-syntax ?\( )
  2376. (eq left-char (matching-paren right-char))
  2377. (eq right-char (matching-paren left-char)))
  2378. (paredit-join-lists-internal left-point right-point)
  2379. (paredit-preserving-column
  2380. (save-excursion
  2381. (backward-up-list)
  2382. (indent-sexp))))
  2383. ((and (eq left-syntax ?\" )
  2384. (eq right-syntax ?\" ))
  2385. ;; Delete any intermediate formatting.
  2386. (delete-region (1- left-point) (1+ right-point)))
  2387. ((and (memq left-syntax '(?w ?_)) ; Word or symbol
  2388. (memq right-syntax '(?w ?_)))
  2389. (delete-region left-point right-point))
  2390. (t (error "Mismatched S-expressions to join.")))))))
  2391. (defun paredit-join-lists-internal (left-point right-point)
  2392. (save-excursion
  2393. ;; Leave intermediate formatting alone.
  2394. (goto-char right-point)
  2395. (delete-char +1)
  2396. (goto-char left-point)
  2397. (delete-char -1)
  2398. ;; Kludge: Add an extra space in several conditions.
  2399. (if (or
  2400. ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar).
  2401. (and (not (eolp))
  2402. (save-excursion
  2403. (paredit-skip-whitespace t (point-at-eol))
  2404. (eq (char-after) ?\;)))
  2405. ;; (foo)|(bar) => (foo| bar), not (foo|bar).
  2406. (and (= left-point right-point)
  2407. (not (or (eq ?\ (char-syntax (char-before)))
  2408. (eq ?\ (char-syntax (char-after)))))))
  2409. (insert ?\ ))))
  2410. ;++ How ought paredit-join to handle comments intervening symbols or strings?
  2411. ;++ Idea:
  2412. ;++
  2413. ;++ "foo" | ;bar
  2414. ;++ "baz" ;quux
  2415. ;++
  2416. ;++ =>
  2417. ;++
  2418. ;++ "foo|baz" ;bar
  2419. ;++ ;quux
  2420. ;++
  2421. ;++ The point should stay where it is relative to the comments, and the
  2422. ;++ the comments' columns should all be preserved, perhaps. Hmmmm...
  2423. ;++ What about this?
  2424. ;++
  2425. ;++ "foo" ;bar
  2426. ;++ | ;baz
  2427. ;++ "quux" ;zot
  2428. ;++ Should rename:
  2429. ;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point
  2430. ;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point
  2431. ;;;; Variations on the Lurid Theme
  2432. ;;; I haven't the imagination to concoct clever names for these.
  2433. (defun paredit-add-to-previous-list ()
  2434. "Add the S-expression following point to the list preceding point."
  2435. (interactive)
  2436. (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
  2437. (save-excursion
  2438. (down-list -1) ;++ backward-down-list...
  2439. (paredit-forward-slurp-sexp)))
  2440. (defun paredit-add-to-next-list ()
  2441. "Add the S-expression preceding point to the list following point.
  2442. If no S-expression precedes point, move up the tree until one does."
  2443. (interactive)
  2444. (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
  2445. (save-excursion
  2446. (down-list)
  2447. (paredit-backward-slurp-sexp)))
  2448. (defun paredit-join-with-previous-list ()
  2449. "Join the list the point is on with the previous list in the buffer."
  2450. (interactive)
  2451. (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
  2452. (save-excursion
  2453. (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
  2454. (backward-up-list)
  2455. t))
  2456. (paredit-join-sexps)))
  2457. (defun paredit-join-with-next-list ()
  2458. "Join the list the point is on with the next list in the buffer."
  2459. (interactive)
  2460. (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
  2461. (save-excursion
  2462. (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
  2463. (up-list)
  2464. t))
  2465. (paredit-join-sexps)))
  2466. ;;;; Utilities
  2467. (defun paredit-in-string-escape-p ()
  2468. "True if the point is on a character escape of a string.
  2469. This is true only if the character is preceded by an odd number of
  2470. backslashes.
  2471. This assumes that `paredit-in-string-p' has already returned true."
  2472. (let ((oddp nil))
  2473. (save-excursion
  2474. (while (eq (char-before) ?\\ )
  2475. (setq oddp (not oddp))
  2476. (backward-char)))
  2477. oddp))
  2478. (defun paredit-in-char-p (&optional position)
  2479. "True if point is on a character escape outside a string."
  2480. (save-excursion
  2481. (goto-char (or position (point)))
  2482. (paredit-in-string-escape-p)))
  2483. (defun paredit-skip-whitespace (trailing-p &optional limit)
  2484. "Skip past any whitespace, or until the point LIMIT is reached.
  2485. If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
  2486. whitespace."
  2487. (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
  2488. " \t\n " ; This should skip using the syntax table, but LF
  2489. limit)) ; is a comment end, not newline, in Lisp mode.
  2490. (defalias 'paredit-region-active-p
  2491. (xcond ((paredit-xemacs-p) 'region-active-p)
  2492. ((paredit-gnu-emacs-p)
  2493. (lambda ()
  2494. (and mark-active transient-mark-mode)))))
  2495. (defun paredit-hack-kill-region (start end)
  2496. "Kill the region between START and END.
  2497. Do not append to any current kill, and
  2498. do not let the next kill append to this one."
  2499. (interactive "r") ;Eh, why not?
  2500. ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
  2501. ;; command was a kill. It also checks LAST-COMMAND to see whether it
  2502. ;; should append. If we bind these locally, any modifications to
  2503. ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
  2504. ;; indicate that it should append.
  2505. (let ((this-command nil)
  2506. (last-command nil))
  2507. (kill-region start end)))
  2508. ;;;;; Reindentation utilities
  2509. ;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use
  2510. ;++ `paredit-indent-region' rather than `indent-region'?
  2511. (defun paredit-indent-sexps ()
  2512. "If in a list, indent all following S-expressions in the list."
  2513. (let* ((start (point))
  2514. (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil)))
  2515. (if end
  2516. (indent-region start end nil))))
  2517. (defun paredit-forward-and-indent (&optional n)
  2518. "Move forward by N S-expressions, indenting them with `indent-region'."
  2519. (let ((start (point)))
  2520. (forward-sexp n)
  2521. (indent-region start (point) nil)))
  2522. (defun paredit-indent-region (start end)
  2523. "Indent the region from START to END.
  2524. Don't reindent the line starting at START, however."
  2525. (if (not (<= start end))
  2526. (error "Incorrectly related points: %S, %S" start end))
  2527. (save-excursion
  2528. (goto-char start)
  2529. (let ((bol (point-at-bol)))
  2530. ;; Skip all S-expressions that end on the starting line, but
  2531. ;; don't go past `end'.
  2532. (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol))))
  2533. (paredit-handle-sexp-errors
  2534. (catch 'exit
  2535. (while t
  2536. (save-excursion
  2537. (forward-sexp)
  2538. (if (not (eq bol (point-at-bol)))
  2539. (throw 'exit t))
  2540. (if (not (< (point) end))
  2541. (throw 'exit nil)))
  2542. (forward-sexp)))
  2543. nil))
  2544. (progn
  2545. ;; Point is still on the same line, but precedes an
  2546. ;; S-expression that ends on a different line.
  2547. (if (not (eq bol (point-at-bol)))
  2548. (error "Internal error -- we moved forward a line!"))
  2549. (goto-char (+ 1 (point-at-eol)))
  2550. (if (not (<= (point) end))
  2551. (error "Internal error -- we frobnitzed the garfnut!"))
  2552. (indent-region (point) end nil))))))
  2553. ;;;;; S-expression Parsing Utilities
  2554. ;++ These routines redundantly traverse S-expressions a great deal.
  2555. ;++ If performance issues arise, this whole section will probably have
  2556. ;++ to be refactored to preserve the state longer, like paredit.scm
  2557. ;++ does, rather than to traverse the definition N times for every key
  2558. ;++ stroke as it presently does.
  2559. (defun paredit-current-parse-state ()
  2560. "Return parse state of point from beginning of defun."
  2561. (let ((point (point)))
  2562. (beginning-of-defun)
  2563. ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
  2564. ;; argument (unless parsing stops due to an error, but we assume it
  2565. ;; won't in paredit-mode).
  2566. (parse-partial-sexp (point) point)))
  2567. (defun paredit-in-string-p (&optional state)
  2568. "True if the parse state is within a double-quote-delimited string.
  2569. If no parse state is supplied, compute one from the beginning of the
  2570. defun to the point."
  2571. ;; 3. non-nil if inside a string (the terminator character, really)
  2572. (and (nth 3 (or state (paredit-current-parse-state)))
  2573. t))
  2574. (defun paredit-string-start+end-points (&optional state)
  2575. "Return a cons of the points of open and close quotes of the string.
  2576. The string is determined from the parse state STATE, or the parse state
  2577. from the beginning of the defun to the point.
  2578. This assumes that `paredit-in-string-p' has already returned true, i.e.
  2579. that the point is already within a string."
  2580. (save-excursion
  2581. ;; 8. character address of start of comment or string; nil if not
  2582. ;; in one
  2583. (let ((start (nth 8 (or state (paredit-current-parse-state)))))
  2584. (goto-char start)
  2585. (forward-sexp 1)
  2586. (cons start (1- (point))))))
  2587. (defun paredit-enclosing-string-start ()
  2588. (car (paredit-string-start+end-points)))
  2589. (defun paredit-enclosing-string-end ()
  2590. (+ 1 (cdr (paredit-string-start+end-points))))
  2591. (defun paredit-enclosing-list-start ()
  2592. (save-excursion
  2593. (backward-up-list)
  2594. (point)))
  2595. (defun paredit-enclosing-list-end ()
  2596. (save-excursion
  2597. (up-list)
  2598. (point)))
  2599. (defun paredit-in-comment-p (&optional state)
  2600. "True if parse state STATE is within a comment.
  2601. If no parse state is supplied, compute one from the beginning of the
  2602. defun to the point."
  2603. ;; 4. nil if outside a comment, t if inside a non-nestable comment,
  2604. ;; else an integer (the current comment nesting)
  2605. (and (nth 4 (or state (paredit-current-parse-state)))
  2606. t))
  2607. (defun paredit-prefix-numeric-value (argument)
  2608. ;++ Kludgerific.
  2609. (cond ((integerp argument) argument)
  2610. ((eq argument '-) -1)
  2611. ((consp argument)
  2612. (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u
  2613. ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u
  2614. (t (error "Invalid prefix argument: %S" argument))))
  2615. ((paredit-region-active-p)
  2616. (save-excursion
  2617. (save-restriction
  2618. (narrow-to-region (region-beginning) (region-end))
  2619. (cond ((= (point) (point-min)) (paredit-count-sexps-forward))
  2620. ((= (point) (point-max)) (paredit-count-sexps-backward))
  2621. (t
  2622. (error "Point %S is not start or end of region: %S..%S"
  2623. (point) (region-beginning) (region-end)))))))
  2624. (t 1)))
  2625. (defun paredit-count-sexps-forward ()
  2626. (save-excursion
  2627. (let ((n 0) (p nil)) ;hurk
  2628. (paredit-ignore-sexp-errors
  2629. (while (setq p (scan-sexps (point) +1))
  2630. (goto-char p)
  2631. (setq n (+ n 1))))
  2632. n)))
  2633. (defun paredit-count-sexps-backward ()
  2634. (save-excursion
  2635. (let ((n 0) (p nil)) ;hurk
  2636. (paredit-ignore-sexp-errors
  2637. (while (setq p (scan-sexps (point) -1))
  2638. (goto-char p)
  2639. (setq n (+ n 1))))
  2640. n)))
  2641. (defun paredit-point-at-sexp-boundary (n)
  2642. (cond ((< n 0) (paredit-point-at-sexp-start))
  2643. ((= n 0) (point))
  2644. ((> n 0) (paredit-point-at-sexp-end))))
  2645. (defun paredit-point-at-sexp-start ()
  2646. (save-excursion
  2647. (forward-sexp)
  2648. (backward-sexp)
  2649. (point)))
  2650. (defun paredit-point-at-sexp-end ()
  2651. (save-excursion
  2652. (backward-sexp)
  2653. (forward-sexp)
  2654. (point)))
  2655. (defun paredit-lose-if-not-in-sexp (command)
  2656. (if (or (paredit-in-string-p)
  2657. (paredit-in-comment-p)
  2658. (paredit-in-char-p))
  2659. (error "Invalid context for command `%s'." command)))
  2660. (defun paredit-check-region (start end)
  2661. "Signal an error if text between `start' and `end' is unbalanced."
  2662. ;; `narrow-to-region' will move the point, so avoid calling it if we
  2663. ;; don't need to. We don't want to use `save-excursion' because we
  2664. ;; want the point to move if `check-parens' reports an error.
  2665. (if (not (paredit-region-ok-p start end))
  2666. (save-restriction
  2667. (narrow-to-region start end)
  2668. (check-parens))))
  2669. (defun paredit-region-ok-p (start end)
  2670. "Return true iff the region between `start' and `end' is balanced.
  2671. This is independent of context -- it doesn't check what state the
  2672. text at `start' is in."
  2673. (save-excursion
  2674. (paredit-handle-sexp-errors
  2675. (progn
  2676. (save-restriction
  2677. (narrow-to-region start end)
  2678. (scan-sexps (point-min) (point-max)))
  2679. t)
  2680. nil)))
  2681. (defun paredit-current-indentation ()
  2682. (save-excursion
  2683. (back-to-indentation)
  2684. (current-column)))
  2685. (defun paredit-restore-column (column indentation)
  2686. ;; Preserve the point's position either in the indentation or in the
  2687. ;; code: if on code, move with the code; if in indentation, leave it
  2688. ;; in the indentation, either where it was (if still on indentation)
  2689. ;; or at the end of the indentation (if the code moved far enough
  2690. ;; left).
  2691. (let ((indentation* (paredit-current-indentation)))
  2692. (goto-char
  2693. (+ (point-at-bol)
  2694. (cond ((not (< column indentation))
  2695. (+ column (- indentation* indentation)))
  2696. ((<= indentation* column) indentation*)
  2697. (t column))))))
  2698. ;;;; Initialization
  2699. (paredit-define-keys)
  2700. (paredit-annotate-mode-with-examples)
  2701. (paredit-annotate-functions-with-examples)
  2702. (provide 'paredit)
  2703. ;;; Local Variables:
  2704. ;;; outline-regexp: " \n;;;;+"
  2705. ;;; End:
  2706. ;;; paredit.el ends here