Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1134 lines
45 KiB

4 years ago
  1. ;;; autopair.el --- Automagically pair braces and quotes like TextMate
  2. ;; Copyright (C) 2009,2010 Joao Tavora
  3. ;; Author: Joao Tavora <joaotavora [at] gmail.com>
  4. ;; Keywords: convenience, emulations
  5. ;; Package-Version: 20160304.1237
  6. ;; X-URL: https://github.com/capitaomorte/autopair
  7. ;; URL: https://github.com/capitaomorte/autopair
  8. ;; EmacsWiki: AutoPairs
  9. ;; Package-Requires: ((cl-lib "0.3"))
  10. ;; Version: 0.6.1
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it 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. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  21. ;;; Commentary:
  22. ;;
  23. ;; Another stab at making braces and quotes pair like in
  24. ;; TextMate:
  25. ;;
  26. ;; * Opening braces/quotes are autopaired;
  27. ;; * Closing braces/quotes are autoskipped;
  28. ;; * Backspacing an opening brace/quote autodeletes its adjacent pair.
  29. ;; * Newline between newly-opened brace pairs open an extra indented line.
  30. ;;
  31. ;; Autopair deduces from the current syntax table which characters to
  32. ;; pair, skip or delete.
  33. ;;
  34. ;;; Installation:
  35. ;;
  36. ;; (require 'autopair)
  37. ;; (autopair-global-mode) ;; to enable in all buffers
  38. ;;
  39. ;; To enable autopair in just some types of buffers, comment out the
  40. ;; `autopair-global-mode' and put autopair-mode in some major-mode
  41. ;; hook, like:
  42. ;;
  43. ;; (add-hook 'c-mode-common-hook #'(lambda () (autopair-mode)))
  44. ;;
  45. ;; Alternatively, do use `autopair-global-mode' and create
  46. ;; *exceptions* using the `autopair-dont-activate' local variable (for
  47. ;; emacs < 24), or just using (autopair-mode -1) (for emacs >= 24)
  48. ;; like:
  49. ;;
  50. ;; (add-hook 'c-mode-common-hook
  51. ;; #'(lambda ()
  52. ;; (setq autopair-dont-activate t)
  53. ;; (autopair-mode -1)))
  54. ;;
  55. ;;
  56. ;;; Use:
  57. ;;
  58. ;; The extension works by rebinding the braces and quotes keys, but
  59. ;; can still be minimally intrusive, since the original binding is
  60. ;; always called as if autopair did not exist.
  61. ;;
  62. ;; The decision of which keys to actually rebind is taken at
  63. ;; minor-mode activation time, based on the current major mode's
  64. ;; syntax tables. To achieve this kind of behaviour, an emacs
  65. ;; variable `emulation-mode-map-alists' was used.
  66. ;;
  67. ;; If you set `autopair-pair-criteria' and `autopair-skip-criteria' to
  68. ;; 'help-balance (which, by the way, is the default), braces are not
  69. ;; autopaired/autoskiped in all situations; the decision to autopair
  70. ;; or autoskip a brace is taken according to the following table:
  71. ;;
  72. ;; +---------+------------+-----------+-------------------+
  73. ;; | 1234567 | autopair? | autoskip? | notes |
  74. ;; +---------+------------+-----------+-------------------+
  75. ;; | (()) | yyyyyyy | ---yy-- | balanced |
  76. ;; +---------+------------+-----------+-------------------+
  77. ;; | (())) | ------y | ---yyy- | too many closings |
  78. ;; +---------+------------+-----------+-------------------+
  79. ;; | ((()) | yyyyyyy | ------- | too many openings |
  80. ;; +---------+------------+-----------+-------------------+
  81. ;;
  82. ;; The table is read like this: in a buffer with 7 characters laid out
  83. ;; like the first column, an "y" marks points where an opening brace
  84. ;; is autopaired and in which places would a closing brace be
  85. ;; autoskipped.
  86. ;;
  87. ;; Quote pairing tries to support similar "intelligence", but is less
  88. ;; deterministic. Some inside-string or inside-comment situations may
  89. ;; not always behave how you intend them to.
  90. ;;
  91. ;; The variable `autopair-autowrap' tells autopair to automatically
  92. ;; wrap the selection region with the delimiters you're trying to
  93. ;; insert. This is done conditionally based of syntaxes of the two
  94. ;; ends of the selection region. It is compatible with `cua-mode's
  95. ;; typing-deletes-selection behaviour.
  96. ;;
  97. ;; If you find the paren-blinking annoying, turn `autopair-blink' to
  98. ;; nil.
  99. ;;
  100. ;; For lisp-programming you might also like `autopair-skip-whitespace'.
  101. ;;
  102. ;; For further customization have a look at `autopair-dont-pair',
  103. ;; `autopair-handle-action-fns' and `autopair-extra-pairs'.
  104. ;;
  105. ;; `autopair-dont-pair' lets you define special cases of characters
  106. ;; you don't want paired. Its default value skips pairing
  107. ;; single-quote characters when inside a comment literal, even if the
  108. ;; language syntax tables does pair these characters.
  109. ;;
  110. ;; (defvar autopair-dont-pair `(:string (?') :comment (?'))
  111. ;;
  112. ;; As a further example, to also prevent the '{' (opening brace)
  113. ;; character from being autopaired in C++ comments use this in your
  114. ;; .emacs.
  115. ;;
  116. ;; (add-hook 'c++-mode-hook
  117. ;; #'(lambda ()
  118. ;; (push ?{
  119. ;; (cl-getf autopair-dont-pair :comment))))
  120. ;;
  121. ;; `autopair-handle-action-fns' lets you override/extend the actions
  122. ;; taken by autopair after it decides something must be paired,skipped
  123. ;; or deleted. To work with triple quoting in python mode, you can use
  124. ;; this for example:
  125. ;;
  126. ;; (add-hook 'python-mode-hook
  127. ;; #'(lambda ()
  128. ;; (setq autopair-handle-action-fns
  129. ;; (list #'autopair-default-handle-action
  130. ;; #'autopair-python-triple-quote-action))))
  131. ;;
  132. ;; It's also useful to deal with latex's mode use of the "paired
  133. ;; delimiter" syntax class.
  134. ;;
  135. ;; (add-hook 'latex-mode-hook
  136. ;; #'(lambda ()
  137. ;; (set (make-local-variable 'autopair-handle-action-fns)
  138. ;; (list #'autopair-default-handle-action
  139. ;; #'autopair-latex-mode-paired-delimiter-action))))
  140. ;;
  141. ;; `autopair-extra-pairs' lets you define extra pairing and skipping
  142. ;; behaviour for pairs not programmed into the syntax table. Watch
  143. ;; out, this is work-in-progress, a little unstable and does not help
  144. ;; balancing at all. To have '<' and '>' pair in c++-mode buffers, but
  145. ;; only in code, use:
  146. ;;
  147. ;; (add-hook 'c++-mode-hook
  148. ;; #'(lambda ()
  149. ;; (push '(?< . ?>)
  150. ;; (cl-getf autopair-extra-pairs :code))))
  151. ;;
  152. ;; if you program in emacs-lisp you might also like the following to
  153. ;; pair backtick and quote
  154. ;;
  155. ;; (add-hook 'emacs-lisp-mode-hook
  156. ;; #'(lambda ()
  157. ;; (push '(?` . ?')
  158. ;; (cl-getf autopair-extra-pairs :comment))
  159. ;; (push '(?` . ?')
  160. ;; (cl-getf autopair-extra-pairs :string))))
  161. ;;
  162. ;;; Bugs:
  163. ;;
  164. ;; * Quote pairing/skipping inside comments is not perfect...
  165. ;;
  166. ;; * See the last section on monkey-patching for the `defadvice'
  167. ;; tricks used to make `autopair-autowrap' work with `cua-mode' and
  168. ;; `delete-selection-mode'.
  169. ;;
  170. ;;; Credit:
  171. ;;
  172. ;; Thanks Ed Singleton for early testing.
  173. ;;
  174. ;;; Code:
  175. ;; requires
  176. (require 'cl-lib)
  177. (require 'paren)
  178. (defgroup autopair nil
  179. "Automagically pair braces and quotes"
  180. :group 'convenience)
  181. ;; variables
  182. (defcustom autopair-pair-criteria 'help-balance
  183. "How to decide whether to pair opening brackets or quotes.
  184. Set this to 'always to always pair, or 'help-balance to be more
  185. criterious when pairing."
  186. :group 'autopair
  187. :type '(choice (const :tag "Help balance" help-balance)
  188. (const :tag "Always pair" always)))
  189. (defcustom autopair-skip-criteria 'help-balance
  190. "How to decide whether to skip closing brackets or quotes.
  191. Set this to 'always to always skip, or 'help-balance to be more
  192. criterious when skipping."
  193. :group 'autopair
  194. :type '(choice (const :tag "Help balance" help-balance)
  195. (const :tag "Always skip" always)))
  196. (defcustom autopair-autowrap 'help-balance
  197. "If non-nil autopair attempts to wrap the selected region.
  198. This is also done in an optimistic \"try-to-balance\" fashion.
  199. Set this to to 'help-balance to be more criterious when
  200. wrapping."
  201. :group 'autopair
  202. :type '(choice (const :tag "Do wrap" t)
  203. (const :tag "Do not wrap" nil)
  204. (const :tag "Help Balance" 'help-balance)))
  205. (defvar autopair--emulation-alist nil
  206. "A keymap alist for adding to `emulation-mode-map-alists'.
  207. The alist contains single (t MAP) association, where MAP is a
  208. dynamic keymap set mostly from the major mode's syntax table.")
  209. (unless (eval-when-compile (> emacs-major-version 23))
  210. (defvar autopair-dont-activate nil
  211. "Control activation of `autopair-global-mode'.
  212. Set this to a non-nil value to skip activation of `autopair-mode'
  213. in certain contexts. If however the value satisfies `functionp'
  214. and is a function of no arguments, the function is called and it is
  215. the return value that decides.")
  216. (make-variable-buffer-local 'autopair-dont-activate))
  217. (defvar autopair-extra-pairs nil
  218. "Extra pairs for which to use pairing.
  219. It's a Common-lisp-style even-numbered property list, each pair
  220. of elements being of the form (TYPE , PAIRS). PAIRS is a mixed
  221. list whose elements are cons cells, which look like cells look
  222. like (OPENING . CLOSING). Autopair pairs these like
  223. parenthesis.
  224. TYPE can be one of:
  225. :string : whereby PAIRS will be considered only when inside a
  226. string literal
  227. :comment : whereby PAIRS will be considered only when inside a comment
  228. :code : whereby PAIRS will be considered only when outisde a
  229. string and a comment.
  230. :everywhere : whereby PAIRS will be considered in all situations
  231. In Emacs-lisp, this might be useful
  232. (add-hook 'emacs-lisp-mode-hook
  233. #'(lambda ()
  234. (setq autopair-extra-pairs `(:comment ((?`. ?'))))))
  235. Note that this does *not* work for single characters,
  236. e.x. characters you want to behave as quotes. See the
  237. docs/source comments for more details.")
  238. (make-variable-buffer-local 'autopair-extra-pairs)
  239. (defvar autopair-dont-pair `(:string (?') :comment (?'))
  240. "Characters for which to skip any pairing behaviour.
  241. This variable overrides `autopair-pair-criteria' and
  242. `autopair-extra-pairs'. It does not
  243. (currently) affect the skipping behaviour.
  244. It's a Common-lisp-style even-numbered property list, each pair
  245. of elements being of the form (TYPE , CHARS). CHARS is a list of
  246. characters and TYPE can be one of:
  247. :string : whereby characters in CHARS will not be autopaired when
  248. inside a string literal
  249. :comment : whereby characters in CHARS will not be autopaired when
  250. inside a comment
  251. :never : whereby characters in CHARS won't even have their
  252. bindings replaced by autopair's. This particular option
  253. should be used for troubleshooting and requires
  254. `autopair-mode' to be restarted to have any effect.")
  255. (make-variable-buffer-local 'autopair-dont-pair)
  256. (defvar autopair-action nil
  257. "Autopair action decided on by last interactive autopair command, or nil.
  258. When autopair decides on an action this is a list whose first
  259. three elements are (ACTION PAIR POS-BEFORE).
  260. ACTION is one of `opening', `insert-quote', `skip-quote',
  261. `backspace', `newline' or `paired-delimiter'. PAIR is the pair of
  262. the `autopair--inserted' character, if applicable. POS-BEFORE is
  263. value of point before action command took place .")
  264. (defvar autopair-wrap-action nil
  265. "Autowrap action decided on by autopair, if any.
  266. When autopair decides on an action this is a list whose first
  267. three elements are (ACTION PAIR POS-BEFORE REGION-BEFORE).
  268. ACTION can only be `wrap' currently. PAIR and POS-BEFORE
  269. delimiter are as in `autopair-action'. REGION-BEFORE is a cons
  270. cell with the bounds of the region before the command takes
  271. place")
  272. (defvar autopair-handle-action-fns '()
  273. "Autopair handlers to run *instead* of the default handler.
  274. Each element is a function taking three arguments (ACTION, PAIR
  275. and POS-BEFORE), which are the three elements of the
  276. `autopair-action' variable, which see.
  277. If non-nil, these functions are called *instead* of the single
  278. function `autopair-default-handle-action', so use this variable
  279. to specify special behaviour. To also run the default behaviour,
  280. be sure to include `autopair-default-handle-action' in the
  281. list, or call it from your handlers.")
  282. (make-variable-buffer-local 'autopair-handle-action-fns)
  283. (defvar autopair-handle-wrap-action-fns '()
  284. "Autopair wrap handlers to run *instead* of the default handler.
  285. Each element is a function taking four arguments (ACTION, PAIR,
  286. POS-BEFORE and REGION-BEFORE), which are the three elements of the
  287. `autopair-wrap-action' variable, which see.
  288. If non-nil, these functions are called *instead* of the single
  289. function `autopair-default-handle-wrap-action', so use this
  290. variable to specify special behaviour. To also run the default
  291. behaviour, be sure to include `autopair-default-handle-wrap-action' in
  292. the list, or call it in your handlers.")
  293. (make-variable-buffer-local 'autopair-handle-wrap-action-fns)
  294. (defvar autopair-inserted nil
  295. "Delimiter inserted by last interactive autopair command.
  296. This is calculated with `autopair-calculate-inserted', which see.")
  297. (defun autopair--calculate-inserted ()
  298. "Attempts to guess the delimiter the current command is inserting.
  299. For now, simply returns `last-command-event'"
  300. last-command-event)
  301. ;; minor mode and global mode
  302. ;;
  303. ;;;###autoload
  304. (define-minor-mode autopair-mode
  305. "Automagically pair braces and quotes like in TextMate."
  306. nil " pair" nil
  307. (cond (autopair-mode
  308. ;; Setup the dynamic emulation keymap, i.e. sets `autopair--emulation-alist'
  309. ;;
  310. (autopair--set-emulation-bindings)
  311. (add-to-list 'emulation-mode-map-alists 'autopair--emulation-alist 'append)
  312. ;; Init important vars
  313. ;;
  314. (setq autopair-action nil)
  315. (setq autopair-wrap-action nil)
  316. ;; Add the post command handler
  317. ;;
  318. (add-hook 'post-command-hook 'autopair--post-command-handler nil 'local))
  319. (t
  320. (set (make-local-variable 'autopair--emulation-alist) nil)
  321. (remove-hook 'post-command-hook 'autopair--post-command-handler 'local))))
  322. ;;;###autoload
  323. (define-globalized-minor-mode autopair-global-mode autopair-mode autopair-on)
  324. (when (eval-when-compile (>= emacs-major-version 24))
  325. (defvar autopair--global-mode-emacs24-hack-flag nil)
  326. (defadvice autopair-global-mode-enable-in-buffers (before autopairs-global-mode-emacs24-hack activate)
  327. "Monkey patch for recent emacsen 24.
  328. It's impossible for a globalized minor-mode to see variables set
  329. by major-mode-hooks. However, the auto-generated
  330. `autopair-global-mode-enable-in-buffers' does run after the
  331. major-mode-hooks.
  332. This advice makes sure the emulation keybindings are (re)set
  333. there. It relies on the fact that
  334. `autopair-global-mode-enable-in-buffers' is still called again in
  335. `after-change-major-mode-hook' (but the autopair-mode has already
  336. been turned on before the major-mode hooks kicked in).
  337. We want this advice to only kick in the *second* call to
  338. `autopair-global-mode-enable-in-buffers'."
  339. (dolist (buf autopair-global-mode-buffers)
  340. (when (buffer-live-p buf)
  341. (with-current-buffer buf
  342. (when (and autopair-mode
  343. (not autopair--global-mode-emacs24-hack-flag))
  344. (autopair--set-emulation-bindings)
  345. (set (make-local-variable 'autopair--global-mode-emacs24-hack-flag) t)))))))
  346. (defun autopair-on ()
  347. (unless (or buffer-read-only
  348. (and (not (minibufferp))
  349. (string-match "^ \\*" (buffer-name)))
  350. (eq major-mode 'sldb-mode)
  351. (and (eval-when-compile (< emacs-major-version 24))
  352. (boundp 'autopair-dont-activate)
  353. autopair-dont-activate)
  354. (autopair-mode 1))))
  355. (defun autopair--set-emulation-bindings ()
  356. "Setup keymap MAP with keybindings based on the major-mode's
  357. syntax table and the local value of `autopair-extra-pairs'."
  358. (let ((map (make-sparse-keymap)))
  359. (define-key map [remap delete-backward-char] 'autopair-backspace)
  360. (define-key map [remap backward-delete-char-untabify] 'autopair-backspace)
  361. (define-key map "\177" 'autopair-backspace)
  362. (define-key map "\r" 'autopair-newline)
  363. (dotimes (char 256) ;; only searches the first 256 chars,
  364. ;; TODO: is this enough/toomuch/stupid?
  365. (unless (member char
  366. (cl-getf autopair-dont-pair :never))
  367. (let* ((syntax-entry (aref (syntax-table) char))
  368. (class (and syntax-entry
  369. (syntax-class syntax-entry)))
  370. (pair (and syntax-entry
  371. (cdr syntax-entry))))
  372. (cond ((and (eq class (car (string-to-syntax "(")))
  373. pair)
  374. ;; syntax classes "opening parens" and "close parens"
  375. (define-key map (string char) 'autopair-insert-opening)
  376. (define-key map (string pair) 'autopair-skip-close-maybe))
  377. ((eq class (car (string-to-syntax "\"")))
  378. ;; syntax class "string quote
  379. (define-key map (string char) 'autopair-insert-or-skip-quote))
  380. ((eq class (car (string-to-syntax "$")))
  381. ;; syntax class "paired-delimiter"
  382. ;;
  383. ;; Apropos this class, see Issues 18, 25 and
  384. ;; elisp info node "35.2.1 Table of Syntax
  385. ;; Classes". The fact that it supresses
  386. ;; syntatic properties in the delimited region
  387. ;; dictates that deciding to autopair/autoskip
  388. ;; can't really be as clean as the string
  389. ;; delimiter.
  390. ;;
  391. ;; Apparently, only `TeX-mode' uses this, so
  392. ;; the best is to bind this to
  393. ;; `autopair-insert-or-skip-paired-delimiter'
  394. ;; which defers any decision making to
  395. ;; mode-specific post-command handler
  396. ;; functions.
  397. ;;
  398. (define-key map (string char) 'autopair-insert-or-skip-paired-delimiter))))))
  399. ;; read `autopair-extra-pairs'
  400. ;;
  401. (dolist (pairs-list (cl-remove-if-not #'listp autopair-extra-pairs))
  402. (dolist (pair pairs-list)
  403. (define-key map (string (car pair)) 'autopair-extra-insert-opening)
  404. (define-key map (string (cdr pair)) 'autopair-extra-skip-close-maybe)))
  405. (set (make-local-variable 'autopair--emulation-alist) (list (cons t map)))))
  406. ;; helper functions
  407. ;;
  408. (defun autopair--syntax-ppss ()
  409. "Calculate syntax info relevant to autopair.
  410. A list of four elements is returned:
  411. - SYNTAX-INFO is either the result `syntax-ppss' or the result of
  412. calling `parse-partial-sexp' with the appropriate
  413. bounds (previously calculated with `syntax-ppss'.
  414. - WHERE-SYM can be one of the symbols :string, :comment or :code.
  415. - QUICK-SYNTAX-INFO is always the result returned by `syntax-ppss'.
  416. - BOUNDS are the boudaries of the current string or comment if
  417. we're currently inside one."
  418. (let* ((quick-syntax-info (syntax-ppss))
  419. (string-or-comment-start (nth 8 quick-syntax-info)))
  420. (cond (;; inside a string, recalculate
  421. (nth 3 quick-syntax-info)
  422. (list (parse-partial-sexp (1+ string-or-comment-start) (point))
  423. :string
  424. quick-syntax-info
  425. (cons string-or-comment-start
  426. (condition-case nil
  427. (scan-sexps string-or-comment-start 1)
  428. (scan-error nil)))))
  429. ((nth 4 quick-syntax-info)
  430. (list (parse-partial-sexp (1+ (nth 8 quick-syntax-info)) (point))
  431. :comment
  432. quick-syntax-info))
  433. (t
  434. (list quick-syntax-info
  435. :code
  436. quick-syntax-info)))))
  437. (defun autopair--pair-of (delim &optional closing)
  438. (when (and delim
  439. (integerp delim))
  440. (let ((syntax-entry (aref (syntax-table) delim)))
  441. (cond ((eq (syntax-class syntax-entry) (car (string-to-syntax "(")))
  442. (cdr syntax-entry))
  443. ((or (eq (syntax-class syntax-entry) (car (string-to-syntax "\"")))
  444. (eq (syntax-class syntax-entry) (car (string-to-syntax "$"))))
  445. delim)
  446. ((and (not closing)
  447. (eq (syntax-class syntax-entry) (car (string-to-syntax ")"))))
  448. (cdr syntax-entry))
  449. (autopair-extra-pairs
  450. (cl-some #'(lambda (pair-list)
  451. (cl-some #'(lambda (pair)
  452. (cond ((eq (cdr pair) delim) (car pair))
  453. ((eq (car pair) delim) (cdr pair))))
  454. pair-list))
  455. (cl-remove-if-not #'listp autopair-extra-pairs)))))))
  456. (defun autopair--calculate-wrap-action ()
  457. (when (and transient-mark-mode mark-active)
  458. (when (> (point) (mark))
  459. (exchange-point-and-mark))
  460. (save-excursion
  461. (let* ((region-before (cons (region-beginning)
  462. (region-end)))
  463. (point-before (point))
  464. (start-syntax (syntax-ppss (car region-before)))
  465. (end-syntax (syntax-ppss (cdr region-before))))
  466. (when (or (not (eq autopair-autowrap 'help-balance))
  467. (and (eq (nth 0 start-syntax) (nth 0 end-syntax))
  468. (eq (nth 3 start-syntax) (nth 3 end-syntax))))
  469. (list 'wrap (or (cl-second autopair-action)
  470. (autopair--pair-of autopair-inserted))
  471. point-before
  472. region-before))))))
  473. (defun autopair--original-binding (fallback-keys)
  474. (or (key-binding `[,autopair-inserted])
  475. (key-binding (this-single-command-keys))
  476. (key-binding fallback-keys)))
  477. (defvar autopair--this-command nil)
  478. (defun autopair--fallback (&optional fallback-keys)
  479. (let* ((autopair--emulation-alist nil)
  480. (beyond-cua (let ((cua--keymap-alist nil))
  481. (autopair--original-binding fallback-keys)))
  482. (beyond-autopair (autopair--original-binding fallback-keys)))
  483. (when autopair-autowrap
  484. (setq autopair-wrap-action (autopair--calculate-wrap-action)))
  485. (setq autopair--this-command this-command)
  486. (setq this-original-command beyond-cua)
  487. ;; defer to "paredit-mode" if that is installed and running
  488. (when (and (featurep 'paredit)
  489. (symbolp beyond-cua)
  490. (string-match "paredit" (symbol-name beyond-cua)))
  491. (setq autopair-action nil))
  492. (let ((cua-delete-selection (not autopair-autowrap))
  493. (blink-matching-paren (not autopair-action)))
  494. (call-interactively beyond-autopair))))
  495. (defcustom autopair-skip-whitespace nil
  496. "If non-nil also skip over whitespace when skipping closing delimiters.
  497. If set to 'chomp, this will be most useful in lisp-like languages
  498. where you want lots of )))))...."
  499. :group 'autopair
  500. :type 'boolean)
  501. (defcustom autopair-blink (if (boundp 'blink-matching-paren)
  502. blink-matching-paren
  503. t)
  504. "If non-nil autopair blinks matching delimiters."
  505. :group 'autopair
  506. :type 'boolean)
  507. (defcustom autopair-blink-delay 0.1
  508. "Autopair's blink-the-delimiter delay."
  509. :group 'autopair
  510. :type 'float)
  511. (defun autopair--document-bindings (&optional fallback-keys)
  512. (concat
  513. "Works by scheduling possible autopair behaviour, then calls
  514. original command as if autopair didn't exist"
  515. (when (eq this-command 'describe-key)
  516. (let* ((autopair--emulation-alist nil)
  517. (command (or (key-binding (this-single-command-keys))
  518. (key-binding fallback-keys))))
  519. (when command
  520. (format ", which in this case is `%s'" command))))
  521. "."))
  522. (defun autopair--escaped-p (syntax-info)
  523. (nth 5 syntax-info))
  524. (defun autopair--exception-p (where-sym exception-where-sym blacklist &optional fn)
  525. (and (or (eq exception-where-sym :everywhere)
  526. (eq exception-where-sym where-sym))
  527. (member autopair-inserted
  528. (if fn
  529. (mapcar fn (cl-getf blacklist exception-where-sym))
  530. (cl-getf blacklist exception-where-sym)))))
  531. (defun autopair--forward-sexp (arg)
  532. (forward-sexp arg)
  533. (cond ((cl-plusp arg)
  534. (skip-syntax-backward "'"))
  535. (t
  536. (skip-syntax-forward "'"))))
  537. (defun autopair--find-pair (direction)
  538. "Compute (MATCHED START END) for the pair of the delimiter at point.
  539. With positive DIRECTION consider the delimiter after point and
  540. travel forward, otherwise consider the delimiter is just before
  541. point and travel backward."
  542. (let* ((show-paren-data (and nil
  543. (funcall show-paren-data-function)))
  544. (here (point)))
  545. (cond (show-paren-data
  546. (cl-destructuring-bind (here-beg here-end there-beg there-end mismatch)
  547. show-paren-data
  548. (if (cl-plusp direction)
  549. (list (not mismatch) there-end here-beg)
  550. (list (not mismatch) there-beg here-end))))
  551. (t
  552. (condition-case move-err
  553. (save-excursion
  554. (autopair--forward-sexp (if (cl-plusp direction) 1 -1))
  555. (list (if (cl-plusp direction)
  556. (eq (char-after here)
  557. (autopair--pair-of (char-before (point))))
  558. (eq (char-before here)
  559. (autopair--pair-of (char-after (point)))))
  560. (point) here))
  561. (scan-error
  562. (list nil (nth 2 move-err) here)))))))
  563. (defun autopair--up-list (&optional n)
  564. "Try to up-list forward as much as N lists.
  565. With negative N, up-list backward.
  566. Return a cons of two descritions (MATCHED START END) for the
  567. innermost and outermost lists that enclose point. The outermost
  568. list enclosing point is either the first top-level or mismatched
  569. list found by uplisting."
  570. (save-excursion
  571. (cl-loop with n = (or n (point-max))
  572. for i from 0 below (abs n)
  573. with outermost
  574. with innermost
  575. until outermost
  576. do
  577. (condition-case forward-err
  578. (progn
  579. (scan-sexps (point) (if (cl-plusp n)
  580. (point-max)
  581. (- (point-max))))
  582. (unless innermost
  583. (setq innermost (list t)))
  584. (setq outermost (list t)))
  585. (scan-error
  586. (goto-char
  587. (if (cl-plusp n)
  588. ;; HACK: the reason for this `max' is that some
  589. ;; modes like ruby-mode sometimes mis-report the
  590. ;; scan error when `forward-sexp'eeing too-much, its
  591. ;; (nth 3) should at least one greater than its (nth
  592. ;; 2). We really need to move out of the sexp so
  593. ;; detect this and add 1. If this were fixed we
  594. ;; could move to (nth 3 forward-err) in all
  595. ;; situations.
  596. ;;
  597. (max (1+ (nth 2 forward-err))
  598. (nth 3 forward-err))
  599. (nth 3 forward-err)))
  600. (let ((pair-data (autopair--find-pair (- n))))
  601. (unless innermost
  602. (setq innermost pair-data))
  603. (unless (cl-first pair-data)
  604. (setq outermost pair-data)))))
  605. finally (cl-return (cons innermost outermost)))))
  606. ;; interactive commands and their associated predicates
  607. ;;
  608. (defun autopair-insert-or-skip-quote ()
  609. (interactive)
  610. (setq autopair-inserted (autopair--calculate-inserted))
  611. (let* ((syntax-triplet (autopair--syntax-ppss))
  612. (syntax-info (cl-first syntax-triplet))
  613. (where-sym (cl-second syntax-triplet))
  614. (orig-info (cl-third syntax-triplet))
  615. ;; inside-string may the quote character itself or t if this
  616. ;; is a "generically terminated string"
  617. (inside-string (and (eq where-sym :string)
  618. (cl-fourth orig-info)))
  619. (escaped-p (autopair--escaped-p syntax-info))
  620. )
  621. (cond (;; decides whether to skip the quote...
  622. ;;
  623. (and (not escaped-p)
  624. (eq autopair-inserted (char-after (point)))
  625. (or
  626. ;; ... if we're already inside a string and the
  627. ;; string starts with the character just inserted,
  628. ;; or it's a generically terminated string
  629. (and inside-string
  630. (or (eq inside-string t)
  631. (eq autopair-inserted inside-string)))
  632. ;; ... if we're in a comment and ending a string
  633. ;; (the inside-string criteria does not work
  634. ;; here...)
  635. (and (eq where-sym :comment)
  636. (condition-case nil
  637. (eq autopair-inserted (char-after (scan-sexps (1+ (point)) -1)))
  638. (scan-error nil)))))
  639. (setq autopair-action (list 'skip-quote autopair-inserted (point))))
  640. (;; decides whether to pair, i.e do *not* pair the quote if...
  641. ;;
  642. (not
  643. (or
  644. escaped-p
  645. ;; ... inside a generic string
  646. (eq inside-string t)
  647. ;; ... inside an unterminated string started by this char
  648. (autopair--in-unterminated-string-p syntax-triplet)
  649. ;; ... the position at the end of buffer is inside an
  650. ;; unterminated string
  651. (autopair--in-unterminated-string-p (save-excursion
  652. (goto-char (point-max))
  653. (autopair--syntax-ppss)))
  654. ;; ... comment-disable or string-disable are true at
  655. ;; point. The latter is only useful if we're in a string
  656. ;; terminated by a character other than
  657. ;; `autopair-inserted'.
  658. (cl-some #'(lambda (sym)
  659. (autopair--exception-p where-sym sym autopair-dont-pair))
  660. '(:comment :string))))
  661. (setq autopair-action (list 'insert-quote autopair-inserted (point)))))
  662. (autopair--fallback)))
  663. (put 'autopair-insert-or-skip-quote 'function-documentation
  664. '(concat "Insert or possibly skip over a quoting character.\n\n"
  665. (autopair--document-bindings)))
  666. (defun autopair--in-unterminated-string-p (autopair-triplet)
  667. (let* ((relevant-ppss (cl-third autopair-triplet))
  668. (string-delim (cl-fourth relevant-ppss)))
  669. (and (or (eq t string-delim)
  670. (eq autopair-inserted string-delim))
  671. (condition-case nil (progn (scan-sexps (cl-ninth relevant-ppss) 1) nil) (scan-error t)))))
  672. (defun autopair-insert-opening ()
  673. (interactive)
  674. (setq autopair-inserted (autopair--calculate-inserted))
  675. (when (autopair--pair-p)
  676. (setq autopair-action (list 'opening (autopair--pair-of autopair-inserted) (point))))
  677. (autopair--fallback))
  678. (put 'autopair-insert-opening 'function-documentation
  679. '(concat "Insert opening delimiter and possibly automatically close it.\n\n"
  680. (autopair--document-bindings)))
  681. (defun autopair-skip-close-maybe ()
  682. (interactive)
  683. (setq autopair-inserted (autopair--calculate-inserted))
  684. (when (autopair--skip-p)
  685. (setq autopair-action (list 'closing (autopair--pair-of autopair-inserted) (point))))
  686. (autopair--fallback))
  687. (put 'autopair-skip-close-maybe 'function-documentation
  688. '(concat "Insert or possibly skip over a closing delimiter.\n\n"
  689. (autopair--document-bindings)))
  690. (defun autopair-backspace ()
  691. (interactive)
  692. (setq autopair-inserted (autopair--calculate-inserted))
  693. (when (char-before)
  694. (setq autopair-action (list 'backspace (autopair--pair-of (char-before) 'closing) (point))))
  695. (autopair--fallback (kbd "DEL")))
  696. (put 'autopair-backspace 'function-documentation
  697. '(concat "Possibly delete a pair of paired delimiters.\n\n"
  698. (autopair--document-bindings (kbd "DEL"))))
  699. (defun autopair-newline ()
  700. (interactive)
  701. (setq autopair-inserted (autopair--calculate-inserted))
  702. (let ((pair (autopair--pair-of (char-before))))
  703. (when (and pair
  704. (eq (char-syntax pair) ?\))
  705. (eq (char-after) pair))
  706. (setq autopair-action (list 'newline pair (point))))
  707. (autopair--fallback (kbd "RET"))))
  708. (put 'autopair-newline 'function-documentation
  709. '(concat "Do a smart newline when right between parenthesis.\n
  710. In other words, insert an extra newline along with the one inserted normally
  711. by this command. Then place point after the first, indented.\n\n"
  712. (autopair--document-bindings (kbd "RET"))))
  713. (defun autopair--skip-p ()
  714. (let* ((syntax-triplet (autopair--syntax-ppss))
  715. (syntax-info (cl-first syntax-triplet))
  716. (orig-point (point)))
  717. (cond ((eq autopair-skip-criteria 'help-balance)
  718. (cl-destructuring-bind (innermost . outermost)
  719. (autopair--up-list (- (point-max)))
  720. (cond ((cl-first outermost)
  721. (cl-first innermost))
  722. ((cl-first innermost)
  723. (not (eq (autopair--pair-of (char-after (cl-third outermost)))
  724. autopair-inserted))))))
  725. ((eq autopair-skip-criteria 'need-opening)
  726. (save-excursion
  727. (condition-case err
  728. (progn
  729. (backward-list)
  730. t)
  731. (scan-error nil))))
  732. (t
  733. t))))
  734. (defun autopair--pair-p ()
  735. (let* ((syntax-triplet (autopair--syntax-ppss))
  736. (syntax-info (cl-first syntax-triplet))
  737. (where-sym (cl-second syntax-triplet))
  738. (orig-point (point)))
  739. (and (not (cl-some #'(lambda (sym)
  740. (autopair--exception-p where-sym sym autopair-dont-pair))
  741. '(:string :comment :code :everywhere)))
  742. (cond ((eq autopair-pair-criteria 'help-balance)
  743. (and (not (autopair--escaped-p syntax-info))
  744. (cl-destructuring-bind (innermost . outermost)
  745. (autopair--up-list (point-max))
  746. (cond ((cl-first outermost)
  747. t)
  748. ((not (cl-first innermost))
  749. (not (eq (autopair--pair-of (char-before (cl-third outermost)))
  750. autopair-inserted)))))))
  751. ((eq autopair-pair-criteria 'always)
  752. t)
  753. (t
  754. (not (autopair--escaped-p syntax-info)))))))
  755. ;; post-command-hook stuff
  756. ;;
  757. (defun autopair--post-command-handler ()
  758. "Performs pairing and wrapping based on `autopair-action' and
  759. `autopair-wrap-action'. "
  760. (when (and autopair-wrap-action
  761. (cl-notany #'null autopair-wrap-action))
  762. (if autopair-handle-wrap-action-fns
  763. (condition-case err
  764. (mapc #'(lambda (fn)
  765. (apply fn autopair-wrap-action))
  766. autopair-handle-wrap-action-fns)
  767. (scan-error (progn
  768. (message "[autopair] error running custom `autopair-handle-wrap-action-fns', switching autopair off")
  769. (autopair-mode -1))))
  770. (apply #'autopair-default-handle-wrap-action autopair-wrap-action))
  771. (setq autopair-wrap-action nil))
  772. (when (and autopair-action
  773. (cl-notany #'null autopair-action))
  774. (if autopair-handle-action-fns
  775. (condition-case err
  776. (mapc #'(lambda (fn)
  777. (funcall fn (cl-first autopair-action) (cl-second autopair-action) (cl-third autopair-action)))
  778. autopair-handle-action-fns)
  779. (scan-error (progn
  780. (message "[autopair] error running custom `autopair-handle-action-fns', switching autopair off")
  781. (autopair-mode -1))))
  782. (apply #'autopair-default-handle-action autopair-action))
  783. (setq autopair-action nil)))
  784. (defun autopair--blink-matching-open ()
  785. (let ((blink-matching-paren autopair-blink)
  786. (show-paren-mode nil)
  787. (blink-matching-delay autopair-blink-delay))
  788. (blink-matching-open)))
  789. (defun autopair--blink (&optional pos)
  790. (when autopair-blink
  791. (if pos
  792. (save-excursion
  793. (goto-char pos)
  794. (sit-for autopair-blink-delay))
  795. (sit-for autopair-blink-delay))))
  796. (defun autopair-default-handle-action (action pair pos-before)
  797. ;;(message "action is %s" action)
  798. (condition-case err
  799. (cond (;; automatically insert closing delimiter
  800. (and (eq 'opening action)
  801. (not (eq pair (char-before))))
  802. (insert pair)
  803. (autopair--blink)
  804. (backward-char 1))
  805. (;; automatically insert closing quote delimiter
  806. (eq 'insert-quote action)
  807. (insert pair)
  808. (autopair--blink)
  809. (backward-char 1))
  810. (;; automatically skip oper closer quote delimiter
  811. (and (eq 'skip-quote action)
  812. (eq pair (char-after (point))))
  813. (delete-char 1)
  814. (autopair--blink-matching-open))
  815. (;; skip over newly-inserted-but-existing closing delimiter
  816. ;; (normal case)
  817. (eq 'closing action)
  818. (let ((skipped 0))
  819. (when autopair-skip-whitespace
  820. (setq skipped (save-excursion (skip-chars-forward "\s\n\t"))))
  821. (when (eq autopair-inserted (char-after (+ (point) skipped)))
  822. (backward-delete-char 1)
  823. (unless (zerop skipped) (autopair--blink (+ (point) skipped)))
  824. (if (eq autopair-skip-whitespace 'chomp)
  825. (delete-char skipped)
  826. (forward-char skipped))
  827. (forward-char))
  828. (autopair--blink-matching-open)))
  829. (;; autodelete closing delimiter
  830. (and (eq 'backspace action)
  831. (eq pair (char-after (point))))
  832. (delete-char 1))
  833. (;; opens an extra line after point, then indents
  834. (and (eq 'newline action)
  835. (eq pair (char-after (point))))
  836. (save-excursion
  837. (newline-and-indent))
  838. (indent-according-to-mode)))
  839. (error
  840. (message "[autopair] Ignored error in `autopair-default-handle-action'"))))
  841. (defun autopair-default-handle-wrap-action (action pair pos-before region-before)
  842. "Default handler for the wrapping action in `autopair-wrap'"
  843. (condition-case err
  844. (when (eq 'wrap action)
  845. (let ((delete-active-region nil))
  846. (cond
  847. ((member autopair--this-command '(autopair-insert-opening
  848. autopair-extra-insert-opening))
  849. (goto-char (1+ (cdr region-before)))
  850. (insert pair)
  851. (autopair--blink)
  852. (goto-char (1+ (car region-before))))
  853. (;; wraps
  854. (member autopair--this-command '(autopair-skip-close-maybe
  855. autopair-extra-skip-close-maybe))
  856. (delete-char -1)
  857. (insert pair)
  858. (goto-char (1+ (cdr region-before)))
  859. (insert autopair-inserted))
  860. ((member autopair--this-command '(autopair-insert-or-skip-quote
  861. autopair-insert-or-skip-paired-delimiter))
  862. (goto-char (1+ (cdr region-before)))
  863. (insert pair)
  864. (autopair--blink))
  865. (t
  866. (delete-char -1)
  867. (goto-char (cdr region-before))
  868. (insert autopair-inserted)))
  869. (setq autopair-action nil)))
  870. (error
  871. (message "[autopair] Ignored error in `autopair-default-handle-wrap-action'"))))
  872. ;; example python triple quote helper
  873. ;;
  874. (defun autopair-python-triple-quote-action (action pair pos-before)
  875. (cond ((and (eq 'insert-quote action)
  876. (>= (point) 3)
  877. (string= (buffer-substring (- (point) 3)
  878. (point))
  879. (make-string 3 pair)))
  880. (save-excursion (insert (make-string 2 pair))))
  881. ((and (eq 'backspace action)
  882. (>= (point) 2)
  883. (<= (point) (- (point-max) 2))
  884. (string= (buffer-substring (- (point) 2)
  885. (+ (point) 2))
  886. (make-string 4 pair)))
  887. (delete-region (- (point) 2)
  888. (+ (point) 2)))
  889. ((and (eq 'skip-quote action)
  890. (<= (point) (- (point-max) 2))
  891. (string= (buffer-substring (point)
  892. (+ (point) 2))
  893. (make-string 2 pair)))
  894. (forward-char 2))
  895. (t
  896. t)))
  897. ;; example latex paired-delimiter helper
  898. ;;
  899. (defun autopair-latex-mode-paired-delimiter-action (action pair pos-before)
  900. "Pair or skip latex's \"paired delimiter\" syntax in math mode. Added AucText support, thanks Massimo Lauria"
  901. (when (eq action 'paired-delimiter)
  902. (when (eq (char-before) pair)
  903. (if (and (or
  904. (eq (get-text-property pos-before 'face) 'tex-math)
  905. (eq (get-text-property (- pos-before 1) 'face) 'font-latex-math-face)
  906. (member 'font-latex-math-face (get-text-property (- pos-before 1) 'face)))
  907. (eq (char-after) pair))
  908. (cond ((and (eq (char-after) pair)
  909. (eq (char-after (1+ (point))) pair))
  910. ;; double skip
  911. (delete-char 1)
  912. (forward-char))
  913. ((eq (char-before pos-before) pair)
  914. ;; doube insert
  915. (insert pair)
  916. (backward-char))
  917. (t
  918. ;; simple skip
  919. (delete-char 1)))
  920. (insert pair)
  921. (backward-char)))))
  922. ;; Commands and predicates for the autopair-extra* feature
  923. ;;
  924. (defun autopair-extra-insert-opening ()
  925. (interactive)
  926. (setq autopair-inserted (autopair--calculate-inserted))
  927. (when (autopair--extra-pair-p)
  928. (setq autopair-action (list 'opening (autopair--pair-of autopair-inserted) (point))))
  929. (autopair--fallback))
  930. (put 'autopair-extra-insert-opening 'function-documentation
  931. '(concat "Insert (an extra) opening delimiter and possibly automatically close it.\n\n"
  932. (autopair--document-bindings)))
  933. (defun autopair-extra-skip-close-maybe ()
  934. (interactive)
  935. (setq autopair-inserted (autopair--calculate-inserted))
  936. (when (autopair--extra-skip-p)
  937. (setq autopair-action (list 'closing autopair-inserted (point))))
  938. (autopair--fallback))
  939. (put 'autopair-extra-skip-close-maybe 'function-documentation
  940. '(concat "Insert or possibly skip over a (and extra) closing delimiter.\n\n"
  941. (autopair--document-bindings)))
  942. (defun autopair--extra-pair-p ()
  943. (let* ((syntax-triplet (autopair--syntax-ppss))
  944. (syntax-info (cl-first syntax-triplet))
  945. (where-sym (cl-second syntax-triplet)))
  946. (cl-some #'(lambda (sym)
  947. (autopair--exception-p where-sym sym autopair-extra-pairs #'car))
  948. '(:everywhere :comment :string :code))))
  949. (defun autopair--extra-skip-p ()
  950. (let* ((syntax-triplet (autopair--syntax-ppss))
  951. (syntax-info (cl-first syntax-triplet))
  952. (where-sym (cl-second syntax-triplet))
  953. (orig-point (point)))
  954. (and (eq (char-after (point)) autopair-inserted)
  955. (cl-some #'(lambda (sym)
  956. (autopair--exception-p where-sym sym autopair-extra-pairs #'cdr))
  957. '(:comment :string :code :everywhere))
  958. (save-excursion
  959. (condition-case err
  960. (backward-sexp (point-max))
  961. (scan-error
  962. (goto-char (cl-third err))))
  963. (search-forward (make-string 1 (autopair--pair-of autopair-inserted))
  964. orig-point
  965. 'noerror)))))
  966. ;; Commands and tex-mode specific handler functions for the "paired
  967. ;; delimiter" syntax class.
  968. ;;
  969. (defun autopair-insert-or-skip-paired-delimiter ()
  970. " insert or skip a character paired delimiter"
  971. (interactive)
  972. (setq autopair-inserted (autopair--calculate-inserted))
  973. (setq autopair-action (list 'paired-delimiter autopair-inserted (point)))
  974. (autopair--fallback))
  975. (put 'autopair-insert-or-skip-paired-delimiter 'function-documentation
  976. '(concat "Insert or possibly skip over a character with a syntax-class of \"paired delimiter\"."
  977. (autopair--document-bindings)))
  978. ;; monkey-patching: Compatibility with delete-selection-mode and cua-mode
  979. ;;
  980. ;; Ideally one would be able to use functions as the value of the
  981. ;; 'delete-selection properties of the autopair commands. The function
  982. ;; would return non-nil when no wrapping should/could be performed.
  983. ;;
  984. ;; Until then use some `defadvice' i.e. monkey-patching, which relies
  985. ;; on these features' implementation details.
  986. ;;
  987. (put 'autopair-insert-opening 'delete-selection t)
  988. (put 'autopair-skip-close-maybe 'delete-selection t)
  989. (put 'autopair-insert-or-skip-quote 'delete-selection t)
  990. (put 'autopair-extra-insert-opening 'delete-selection t)
  991. (put 'autopair-extra-skip-close-maybe 'delete-selection t)
  992. (put 'autopair-backspace 'delete-selection 'supersede)
  993. (put 'autopair-newline 'delete-selection t)
  994. (defun autopair--should-autowrap ()
  995. (and autopair-mode
  996. (not (eq this-command 'autopair-backspace))
  997. (symbolp this-command)
  998. (string-match "^autopair" (symbol-name this-command))
  999. (autopair--calculate-wrap-action)))
  1000. (defadvice cua--pre-command-handler-1 (around autopair-override activate)
  1001. "Don't actually do anything if autopair is about to autowrap. "
  1002. (unless (autopair--should-autowrap) ad-do-it))
  1003. (defadvice delete-selection-pre-hook (around autopair-override activate)
  1004. "Don't actually do anything if autopair is about to autowrap. "
  1005. (unless (autopair--should-autowrap) ad-do-it))
  1006. (provide 'autopair)
  1007. ;; Local Variables:
  1008. ;; coding: utf-8
  1009. ;; End:
  1010. ;;; autopair.el ends here