code.delx.au - gnu-emacs/blob - lisp/elec-pair.el

   1 ;;; elec-pair.el --- Automatic parenthesis pairing  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: João Távora <joaotavora@gmail.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 (require 'electric)
  27
  28 ;;; Electric pairing.
  29
  30 (defcustom electric-pair-pairs
  31   '((?\" . ?\"))
  32   "Alist of pairs that should be used regardless of major mode.
  33
  34 Pairs of delimiters in this list are a fallback in case they have
  35 no syntax relevant to `electric-pair-mode' in the mode's syntax
  36 table.
  37
  38 See also the variable `electric-pair-text-pairs'."
  39   :version "24.1"
  40   :group 'electricity
  41   :type '(repeat (cons character character)))
  42
  43 ;;;###autoload
  44 (defcustom electric-pair-text-pairs
  45   '((?\" . ?\" ))
  46   "Alist of pairs that should always be used in comments and strings.
  47
  48 Pairs of delimiters in this list are a fallback in case they have
  49 no syntax relevant to `electric-pair-mode' in the syntax table
  50 defined in `electric-pair-text-syntax-table'"
  51   :version "24.4"
  52   :group 'electricity
  53   :type '(repeat (cons character character)))
  54
  55 (defcustom electric-pair-skip-self #'electric-pair-default-skip-self
  56   "If non-nil, skip char instead of inserting a second closing paren.
  57
  58 When inserting a closing paren character right before the same character,
  59 just skip that character instead, so that hitting ( followed by ) results
  60 in \"()\" rather than \"())\".
  61
  62 This can be convenient for people who find it easier to hit ) than C-f.
  63
  64 Can also be a function of one argument (the closer char just
  65 inserted), in which case that function's return value is
  66 considered instead."
  67   :version "24.1"
  68   :group 'electricity
  69   :type '(choice
  70           (const :tag "Never skip" nil)
  71           (const :tag "Help balance" electric-pair-default-skip-self)
  72           (const :tag "Always skip" t)
  73           function))
  74
  75 (defcustom electric-pair-inhibit-predicate
  76   #'electric-pair-default-inhibit
  77   "Predicate to prevent insertion of a matching pair.
  78
  79 The function is called with a single char (the opening char just inserted).
  80 If it returns non-nil, then `electric-pair-mode' will not insert a matching
  81 closer."
  82   :version "24.4"
  83   :group 'electricity
  84   :type '(choice
  85           (const :tag "Conservative" electric-pair-conservative-inhibit)
  86           (const :tag "Help balance" electric-pair-default-inhibit)
  87           (const :tag "Always pair" ignore)
  88           function))
  89
  90 (defcustom electric-pair-preserve-balance t
  91   "Non-nil if default pairing and skipping should help balance parentheses.
  92
  93 The default values of `electric-pair-inhibit-predicate' and
  94 `electric-pair-skip-self' check this variable before delegating to other
  95 predicates responsible for making decisions on whether to pair/skip some
  96 characters based on the actual state of the buffer's parentheses and
  97 quotes."
  98   :version "24.4"
  99   :group 'electricity
 100   :type 'boolean)
 101
 102 (defcustom electric-pair-delete-adjacent-pairs t
 103   "If non-nil, backspacing an open paren also deletes adjacent closer.
 104
 105 Can also be a function of no arguments, in which case that function's
 106 return value is considered instead."
 107   :version "24.4"
 108   :group 'electricity
 109   :type '(choice
 110           (const :tag "Yes" t)
 111           (const :tag "No" nil)
 112           function))
 113
 114 (defcustom electric-pair-open-newline-between-pairs t
 115   "If non-nil, a newline between adjacent parentheses opens an extra one.
 116
 117 Can also be a function of no arguments, in which case that function's
 118 return value is considered instead."
 119   :version "24.4"
 120   :group 'electricity
 121   :type '(choice
 122           (const :tag "Yes" t)
 123           (const :tag "No" nil)
 124           function))
 125
 126 (defcustom electric-pair-skip-whitespace t
 127   "If non-nil skip whitespace when skipping over closing parens.
 128
 129 The specific kind of whitespace skipped is given by the variable
 130 `electric-pair-skip-whitespace-chars'.
 131
 132 The symbol `chomp' specifies that the skipped-over whitespace
 133 should be deleted.
 134
 135 Can also be a function of no arguments, in which case that function's
 136 return value is considered instead."
 137   :version "24.4"
 138   :group 'electricity
 139   :type '(choice
 140           (const :tag "Yes, jump over whitespace" t)
 141           (const :tag "Yes, and delete whitespace" chomp)
 142           (const :tag "No, no whitespace skipping" nil)
 143           function))
 144
 145 (defcustom electric-pair-skip-whitespace-chars (list ?\t ?\s ?\n)
 146   "Whitespace characters considered by `electric-pair-skip-whitespace'."
 147   :version "24.4"
 148   :group 'electricity
 149   :type '(choice (set (const :tag "Space" ?\s)
 150                       (const :tag "Tab" ?\t)
 151                       (const :tag "Newline" ?\n))
 152                  (list character)))
 153
 154 (defun electric-pair--skip-whitespace ()
 155   "Skip whitespace forward, not crossing comment or string boundaries."
 156   (let ((saved (point))
 157         (string-or-comment (nth 8 (syntax-ppss))))
 158     (skip-chars-forward (apply #'string electric-pair-skip-whitespace-chars))
 159     (unless (eq string-or-comment (nth 8 (syntax-ppss)))
 160       (goto-char saved))))
 161
 162 (defvar electric-pair-text-syntax-table prog-mode-syntax-table
 163   "Syntax table used when pairing inside comments and strings.
 164
 165 `electric-pair-mode' considers this syntax table only when point in inside
 166 quotes or comments.  If lookup fails here, `electric-pair-text-pairs' will
 167 be considered.")
 168
 169 (defun electric-pair-backward-delete-char (n &optional killflag untabify)
 170   "Delete characters backward, and maybe also two adjacent paired delimiters.
 171
 172 Remaining behavior is given by `backward-delete-char' or, if UNTABIFY is
 173 non-nil, `backward-delete-char-untabify'."
 174   (interactive "*p\nP")
 175   (let* ((prev (char-before))
 176          (next (char-after))
 177          (syntax-info (and prev
 178                            (electric-pair-syntax-info prev)))
 179          (syntax (car syntax-info))
 180          (pair (cadr syntax-info)))
 181     (when (and next pair
 182                (if (functionp electric-pair-delete-adjacent-pairs)
 183                    (funcall electric-pair-delete-adjacent-pairs)
 184                  electric-pair-delete-adjacent-pairs)
 185                (memq syntax '(?\( ?\" ?\$))
 186                (eq pair next))
 187       (delete-char 1 killflag))
 188     (if untabify
 189         (backward-delete-char-untabify n killflag)
 190         (backward-delete-char n killflag))))
 191
 192 (defun electric-pair-backward-delete-char-untabify (n &optional killflag)
 193   "Delete characters backward, and maybe also two adjacent paired delimiters.
 194
 195 Remaining behavior is given by `backward-delete-char-untabify'."
 196   (interactive "*p\nP")
 197   (electric-pair-backward-delete-char n killflag t))
 198
 199 (defun electric-pair-conservative-inhibit (char)
 200   (or
 201    ;; I find it more often preferable not to pair when the
 202    ;; same char is next.
 203    (eq char (char-after))
 204    ;; Don't pair up when we insert the second of "" or of ((.
 205    (and (eq char (char-before))
 206         (eq char (char-before (1- (point)))))
 207    ;; I also find it often preferable not to pair next to a word.
 208    (eq (char-syntax (following-char)) ?w)))
 209
 210 (defun electric-pair-syntax-info (command-event)
 211   "Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
 212
 213 SYNTAX is COMMAND-EVENT's syntax character.  PAIR is
 214 COMMAND-EVENT's pair.  UNCONDITIONAL indicates the variables
 215 `electric-pair-pairs' or `electric-pair-text-pairs' were used to
 216 lookup syntax.  STRING-OR-COMMENT-START indicates that point is
 217 inside a comment or string."
 218   (let* ((pre-string-or-comment (or (bobp)
 219                                     (nth 8 (save-excursion
 220                                              (syntax-ppss (1- (point)))))))
 221          (post-string-or-comment (nth 8 (syntax-ppss (point))))
 222          (string-or-comment (and post-string-or-comment
 223                                  pre-string-or-comment))
 224          (table (if string-or-comment
 225                     electric-pair-text-syntax-table
 226                   (syntax-table)))
 227          (table-syntax-and-pair (with-syntax-table table
 228                                   (list (char-syntax command-event)
 229                                         (or (matching-paren command-event)
 230                                             command-event))))
 231          (fallback (if string-or-comment
 232                        (append electric-pair-text-pairs
 233                                electric-pair-pairs)
 234                      electric-pair-pairs))
 235          (direct (assq command-event fallback))
 236          (reverse (rassq command-event fallback)))
 237     (cond
 238      ((memq (car table-syntax-and-pair)
 239             '(?\" ?\( ?\) ?\$))
 240       (append table-syntax-and-pair (list nil string-or-comment)))
 241      (direct (if (eq (car direct) (cdr direct))
 242                  (list ?\" command-event t string-or-comment)
 243                (list ?\( (cdr direct) t string-or-comment)))
 244      (reverse (list ?\) (car reverse) t string-or-comment)))))
 245
 246 (defun electric-pair--insert (char)
 247   (let ((last-command-event char)
 248         (blink-matching-paren nil)
 249         (electric-pair-mode nil))
 250     (self-insert-command 1)))
 251
 252 (defun electric-pair--syntax-ppss (&optional pos where)
 253   "Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
 254
 255 WHERE is a list defaulting to '(string comment) and indicates
 256 when to fallback to `parse-partial-sexp'."
 257   (let* ((pos (or pos (point)))
 258          (where (or where '(string comment)))
 259          (quick-ppss (syntax-ppss))
 260          (quick-ppss-at-pos (syntax-ppss pos)))
 261     (if (or (and (nth 3 quick-ppss) (memq 'string where))
 262             (and (nth 4 quick-ppss) (memq 'comment where)))
 263         (with-syntax-table electric-pair-text-syntax-table
 264           (parse-partial-sexp (1+ (nth 8 quick-ppss)) pos))
 265       ;; HACK! cc-mode apparently has some `syntax-ppss' bugs
 266       (if (memq major-mode '(c-mode c++ mode))
 267           (parse-partial-sexp (point-min) pos)
 268         quick-ppss-at-pos))))
 269
 270 ;; Balancing means controlling pairing and skipping of parentheses
 271 ;; so that, if possible, the buffer ends up at least as balanced as
 272 ;; before, if not more.  The algorithm is slightly complex because
 273 ;; some situations like "()))" need pairing to occur at the end but
 274 ;; not at the beginning.  Balancing should also happen independently
 275 ;; for different types of parentheses, so that having your {}'s
 276 ;; unbalanced doesn't keep `electric-pair-mode' from balancing your
 277 ;; ()'s and your []'s.
 278 (defun electric-pair--balance-info (direction string-or-comment)
 279   "Examine lists forward or backward according to DIRECTION's sign.
 280
 281 STRING-OR-COMMENT is info suitable for running `parse-partial-sexp'.
 282
 283 Return a cons of two descriptions (MATCHED-P . PAIR) for the
 284 innermost and outermost lists that enclose point.  The outermost
 285 list enclosing point is either the first top-level or first
 286 mismatched list found by listing up.
 287
 288 If the outermost list is matched, don't rely on its PAIR.
 289 If point is not enclosed by any lists, return ((t) . (t))."
 290   (let* (innermost
 291          outermost
 292          (table (if string-or-comment
 293                     electric-pair-text-syntax-table
 294                   (syntax-table)))
 295          (at-top-level-or-equivalent-fn
 296           ;; called when `scan-sexps' ran perfectly, when it found
 297           ;; a parenthesis pointing in the direction of travel.
 298           ;; Also when travel started inside a comment and exited it.
 299           #'(lambda ()
 300               (setq outermost (list t))
 301               (unless innermost
 302                 (setq innermost (list t)))))
 303          (ended-prematurely-fn
 304           ;; called when `scan-sexps' crashed against a parenthesis
 305           ;; pointing opposite the direction of travel.  After
 306           ;; traversing that character, the idea is to travel one sexp
 307           ;; in the opposite direction looking for a matching
 308           ;; delimiter.
 309           #'(lambda ()
 310               (let* ((pos (point))
 311                      (matched
 312                       (save-excursion
 313                         (cond ((< direction 0)
 314                                (condition-case nil
 315                                    (eq (char-after pos)
 316                                        (with-syntax-table table
 317                                          (matching-paren
 318                                           (char-before
 319                                            (scan-sexps (point) 1)))))
 320                                  (scan-error nil)))
 321                               (t
 322                                ;; In this case, no need to use
 323                                ;; `scan-sexps', we can use some
 324                                ;; `electric-pair--syntax-ppss' in this
 325                                ;; case (which uses the quicker
 326                                ;; `syntax-ppss' in some cases)
 327                                (let* ((ppss (electric-pair--syntax-ppss
 328                                              (1- (point))))
 329                                       (start (car (last (nth 9 ppss))))
 330                                       (opener (char-after start)))
 331                                  (and start
 332                                       (eq (char-before pos)
 333                                           (or (with-syntax-table table
 334                                                 (matching-paren opener))
 335                                               opener))))))))
 336                      (actual-pair (if (> direction 0)
 337                                       (char-before (point))
 338                                     (char-after (point)))))
 339                 (unless innermost
 340                   (setq innermost (cons matched actual-pair)))
 341                 (unless matched
 342                   (setq outermost (cons matched actual-pair)))))))
 343     (save-excursion
 344       (while (not outermost)
 345         (condition-case err
 346             (with-syntax-table table
 347               (scan-sexps (point) (if (> direction 0)
 348                                       (point-max)
 349                                     (- (point-max))))
 350               (funcall at-top-level-or-equivalent-fn))
 351           (scan-error
 352            (cond ((or
 353                    ;; some error happened and it is not of the "ended
 354                    ;; prematurely" kind"...
 355                    (not (string-match "ends prematurely" (nth 1 err)))
 356                    ;; ... or we were in a comment and just came out of
 357                    ;; it.
 358                    (and string-or-comment
 359                         (not (nth 8 (syntax-ppss)))))
 360                   (funcall at-top-level-or-equivalent-fn))
 361                  (t
 362                   ;; exit the sexp
 363                   (goto-char (nth 3 err))
 364                   (funcall ended-prematurely-fn)))))))
 365     (cons innermost outermost)))
 366
 367 (defun electric-pair--in-unterminated-string-p (char)
 368   "Return non-nil if inside unterminated string started by CHAR"
 369   (let* ((ppss (syntax-ppss))
 370          (relevant-ppss (if (nth 4 ppss) ; in comment
 371                             (electric-pair--syntax-ppss)
 372                           ppss))
 373          (string-delim (nth 3 relevant-ppss)))
 374     (and (or (eq t string-delim)
 375              (eq char string-delim))
 376          (condition-case nil (progn (scan-sexps (nth 8 relevant-ppss) 1)
 377                                     nil)
 378            (scan-error t)))))
 379
 380 (defun electric-pair--inside-string-p (char)
 381   "Return non-nil if point is inside a string started by CHAR.
 382
 383 A comments text is parsed with `electric-pair-text-syntax-table'.
 384 Also consider strings within comments, but not strings within
 385 strings."
 386   ;; FIXME: could also consider strings within strings by examining
 387   ;; delimiters.
 388   (let ((ppss (electric-pair--syntax-ppss (point) '(comment))))
 389     (memq (nth 3 ppss) (list t char))))
 390
 391 (defun electric-pair-inhibit-if-helps-balance (char)
 392   "Return non-nil if auto-pairing of CHAR would hurt parentheses' balance.
 393
 394 Works by first removing the character from the buffer, then doing
 395 some list calculations, finally restoring the situation as if nothing
 396 happened."
 397   (pcase (electric-pair-syntax-info char)
 398     (`(,syntax ,pair ,_ ,s-or-c)
 399      (unwind-protect
 400          (progn
 401            (delete-char -1)
 402            (cond ((eq ?\( syntax)
 403                   (let* ((pair-data
 404                           (electric-pair--balance-info 1 s-or-c))
 405                          (outermost (cdr pair-data)))
 406                     (cond ((car outermost)
 407                            nil)
 408                           (t
 409                            (eq (cdr outermost) pair)))))
 410                  ((eq syntax ?\")
 411                   (save-excursion
 412                     (goto-char (point-max))
 413                     (electric-pair--in-unterminated-string-p char)))))
 414        (insert-char char)))))
 415
 416 (defun electric-pair-skip-if-helps-balance (char)
 417   "Return non-nil if skipping CHAR would benefit parentheses' balance.
 418
 419 Works by first removing the character from the buffer, then doing
 420 some list calculations, finally restoring the situation as if nothing
 421 happened."
 422   (pcase (electric-pair-syntax-info char)
 423     (`(,syntax ,pair ,_ ,s-or-c)
 424      (unwind-protect
 425          (progn
 426            (delete-char -1)
 427            (cond ((eq syntax ?\))
 428                   (let* ((pair-data
 429                           (electric-pair--balance-info
 430                            -1 s-or-c))
 431                          (innermost (car pair-data))
 432                          (outermost (cdr pair-data)))
 433                     (and
 434                      (cond ((car outermost)
 435                             (car innermost))
 436                            ((car innermost)
 437                             (not (eq (cdr outermost) pair)))))))
 438                  ((eq syntax ?\")
 439                   (electric-pair--inside-string-p char))))
 440        (insert-char char)))))
 441
 442 (defun electric-pair-default-skip-self (char)
 443   (if electric-pair-preserve-balance
 444       (electric-pair-skip-if-helps-balance char)
 445     t))
 446
 447 (defun electric-pair-default-inhibit (char)
 448   (if electric-pair-preserve-balance
 449       (electric-pair-inhibit-if-helps-balance char)
 450     (electric-pair-conservative-inhibit char)))
 451
 452 (defun electric-pair-post-self-insert-function ()
 453   (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
 454          (skip-whitespace-info))
 455     (pcase (electric-pair-syntax-info last-command-event)
 456       (`(,syntax ,pair ,unconditional ,_)
 457        (cond
 458         ((null pos) nil)
 459         ;; Wrap a pair around the active region.
 460         ;;
 461         ((and (memq syntax '(?\( ?\) ?\" ?\$)) (use-region-p))
 462          ;; FIXME: To do this right, we'd need a post-self-insert-function
 463          ;; so we could add-function around it and insert the closer after
 464          ;; all the rest of the hook has run.
 465          (if (or (eq syntax ?\")
 466                  (and (eq syntax ?\))
 467                       (>= (point) (mark)))
 468                  (and (not (eq syntax ?\)))
 469                       (>= (mark) (point))))
 470              (save-excursion
 471                (goto-char (mark))
 472                (electric-pair--insert pair))
 473            (delete-region pos (1- pos))
 474            (electric-pair--insert pair)
 475            (goto-char (mark))
 476            (electric-pair--insert last-command-event)))
 477         ;; Backslash-escaped: no pairing, no skipping.
 478         ((save-excursion
 479            (goto-char (1- pos))
 480            (not (zerop (% (skip-syntax-backward "\\") 2))))
 481          nil)
 482         ;; Skip self.
 483         ((and (memq syntax '(?\) ?\" ?\$))
 484               (and (or unconditional
 485                        (if (functionp electric-pair-skip-self)
 486                            (funcall electric-pair-skip-self last-command-event)
 487                          electric-pair-skip-self))
 488                    (save-excursion
 489                      (when (setq skip-whitespace-info
 490                                  (if (functionp electric-pair-skip-whitespace)
 491                                      (funcall electric-pair-skip-whitespace)
 492                                    electric-pair-skip-whitespace))
 493                        (electric-pair--skip-whitespace))
 494                      (eq (char-after) last-command-event))))
 495          ;; This is too late: rather than insert&delete we'd want to only
 496          ;; skip (or insert in overwrite mode).  The difference is in what
 497          ;; goes in the undo-log and in the intermediate state which might
 498          ;; be visible to other post-self-insert-hook.  We'll just have to
 499          ;; live with it for now.
 500          (when skip-whitespace-info
 501            (electric-pair--skip-whitespace))
 502          (delete-region (1- pos) (if (eq skip-whitespace-info 'chomp)
 503                                      (point)
 504                                    pos))
 505          (forward-char))
 506         ;; Insert matching pair.
 507         ((and (memq syntax `(?\( ?\" ?\$))
 508               (not overwrite-mode)
 509               (or unconditional
 510                   (not (funcall electric-pair-inhibit-predicate
 511                                 last-command-event))))
 512          (save-excursion (electric-pair--insert pair)))))
 513       (t
 514        (when (and (if (functionp electric-pair-open-newline-between-pairs)
 515                       (funcall electric-pair-open-newline-between-pairs)
 516                     electric-pair-open-newline-between-pairs)
 517                   (eq last-command-event ?\n)
 518                   (< (1+ (point-min)) (point) (point-max))
 519                   (eq (save-excursion
 520                         (skip-chars-backward "\t\s")
 521                         (char-before (1- (point))))
 522                       (matching-paren (char-after))))
 523          (save-excursion (newline 1 t)))))))
 524
 525 (put 'electric-pair-post-self-insert-function   'priority  20)
 526
 527 (defun electric-pair-will-use-region ()
 528   (and (use-region-p)
 529        (memq (car (electric-pair-syntax-info last-command-event))
 530              '(?\( ?\) ?\" ?\$))))
 531
 532 (defvar electric-pair-mode-map
 533   (let ((map (make-sparse-keymap)))
 534     (define-key map [remap backward-delete-char-untabify]
 535       'electric-pair-backward-delete-char-untabify)
 536     (define-key map [remap backward-delete-char]
 537       'electric-pair-backward-delete-char)
 538     (define-key map [remap delete-backward-char]
 539       'electric-pair-backward-delete-char)
 540     map)
 541   "Keymap used by `electric-pair-mode'.")
 542
 543 ;;;###autoload
 544 (define-minor-mode electric-pair-mode
 545   "Toggle automatic parens pairing (Electric Pair mode).
 546 With a prefix argument ARG, enable Electric Pair mode if ARG is
 547 positive, and disable it otherwise.  If called from Lisp, enable
 548 the mode if ARG is omitted or nil.
 549
 550 Electric Pair mode is a global minor mode.  When enabled, typing
 551 an open parenthesis automatically inserts the corresponding
 552 closing parenthesis.  (Likewise for brackets, etc.)."
 553   :global t :group 'electricity
 554   (if electric-pair-mode
 555       (progn
 556         (add-hook 'post-self-insert-hook
 557                   #'electric-pair-post-self-insert-function)
 558         (electric--sort-post-self-insertion-hook)
 559         (add-hook 'self-insert-uses-region-functions
 560                   #'electric-pair-will-use-region))
 561     (remove-hook 'post-self-insert-hook
 562                  #'electric-pair-post-self-insert-function)
 563     (remove-hook 'self-insert-uses-region-functions
 564                  #'electric-pair-will-use-region)))
 565
 566 (provide 'elec-pair)
 567
 568 ;;; elec-pair.el ends here