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-conservative-inhibit (char)
 170   (or
 171    ;; I find it more often preferable not to pair when the
 172    ;; same char is next.
 173    (eq char (char-after))
 174    ;; Don't pair up when we insert the second of "" or of ((.
 175    (and (eq char (char-before))
 176         (eq char (char-before (1- (point)))))
 177    ;; I also find it often preferable not to pair next to a word.
 178    (eq (char-syntax (following-char)) ?w)))
 179
 180 (defun electric-pair-syntax-info (command-event)
 181   "Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
 182
 183 SYNTAX is COMMAND-EVENT's syntax character.  PAIR is
 184 COMMAND-EVENT's pair.  UNCONDITIONAL indicates the variables
 185 `electric-pair-pairs' or `electric-pair-text-pairs' were used to
 186 lookup syntax.  STRING-OR-COMMENT-START indicates that point is
 187 inside a comment or string."
 188   (let* ((pre-string-or-comment (or (bobp)
 189                                     (nth 8 (save-excursion
 190                                              (syntax-ppss (1- (point)))))))
 191          (post-string-or-comment (nth 8 (syntax-ppss (point))))
 192          (string-or-comment (and post-string-or-comment
 193                                  pre-string-or-comment))
 194          (table (if string-or-comment
 195                     electric-pair-text-syntax-table
 196                   (syntax-table)))
 197          (table-syntax-and-pair (with-syntax-table table
 198                                   (list (char-syntax command-event)
 199                                         (or (matching-paren command-event)
 200                                             command-event))))
 201          (fallback (if string-or-comment
 202                        (append electric-pair-text-pairs
 203                                electric-pair-pairs)
 204                      electric-pair-pairs))
 205          (direct (assq command-event fallback))
 206          (reverse (rassq command-event fallback)))
 207     (cond
 208      ((memq (car table-syntax-and-pair)
 209             '(?\" ?\( ?\) ?\$))
 210       (append table-syntax-and-pair (list nil string-or-comment)))
 211      (direct (if (eq (car direct) (cdr direct))
 212                  (list ?\" command-event t string-or-comment)
 213                (list ?\( (cdr direct) t string-or-comment)))
 214      (reverse (list ?\) (car reverse) t string-or-comment)))))
 215
 216 (defun electric-pair--insert (char)
 217   (let ((last-command-event char)
 218         (blink-matching-paren nil)
 219         (electric-pair-mode nil))
 220     (self-insert-command 1)))
 221
 222 (defun electric-pair--syntax-ppss (&optional pos where)
 223   "Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
 224
 225 WHERE is a list defaulting to '(string comment) and indicates
 226 when to fallback to `parse-partial-sexp'."
 227   (let* ((pos (or pos (point)))
 228          (where (or where '(string comment)))
 229          (quick-ppss (syntax-ppss))
 230          (quick-ppss-at-pos (syntax-ppss pos)))
 231     (if (or (and (nth 3 quick-ppss) (memq 'string where))
 232             (and (nth 4 quick-ppss) (memq 'comment where)))
 233         (with-syntax-table electric-pair-text-syntax-table
 234           (parse-partial-sexp (1+ (nth 8 quick-ppss)) pos))
 235       ;; HACK! cc-mode apparently has some `syntax-ppss' bugs
 236       (if (memq major-mode '(c-mode c++ mode))
 237           (parse-partial-sexp (point-min) pos)
 238         quick-ppss-at-pos))))
 239
 240 ;; Balancing means controlling pairing and skipping of parentheses
 241 ;; so that, if possible, the buffer ends up at least as balanced as
 242 ;; before, if not more.  The algorithm is slightly complex because
 243 ;; some situations like "()))" need pairing to occur at the end but
 244 ;; not at the beginning.  Balancing should also happen independently
 245 ;; for different types of parentheses, so that having your {}'s
 246 ;; unbalanced doesn't keep `electric-pair-mode' from balancing your
 247 ;; ()'s and your []'s.
 248 (defun electric-pair--balance-info (direction string-or-comment)
 249   "Examine lists forward or backward according to DIRECTION's sign.
 250
 251 STRING-OR-COMMENT is info suitable for running `parse-partial-sexp'.
 252
 253 Return a cons of two descriptions (MATCHED-P . PAIR) for the
 254 innermost and outermost lists that enclose point.  The outermost
 255 list enclosing point is either the first top-level or first
 256 mismatched list found by listing up.
 257
 258 If the outermost list is matched, don't rely on its PAIR.
 259 If point is not enclosed by any lists, return ((t) . (t))."
 260   (let* (innermost
 261          outermost
 262          (table (if string-or-comment
 263                     electric-pair-text-syntax-table
 264                   (syntax-table)))
 265          (at-top-level-or-equivalent-fn
 266           ;; called when `scan-sexps' ran perfectly, when it found
 267           ;; a parenthesis pointing in the direction of travel.
 268           ;; Also when travel started inside a comment and exited it.
 269           #'(lambda ()
 270               (setq outermost (list t))
 271               (unless innermost
 272                 (setq innermost (list t)))))
 273          (ended-prematurely-fn
 274           ;; called when `scan-sexps' crashed against a parenthesis
 275           ;; pointing opposite the direction of travel.  After
 276           ;; traversing that character, the idea is to travel one sexp
 277           ;; in the opposite direction looking for a matching
 278           ;; delimiter.
 279           #'(lambda ()
 280               (let* ((pos (point))
 281                      (matched
 282                       (save-excursion
 283                         (cond ((< direction 0)
 284                                (condition-case nil
 285                                    (eq (char-after pos)
 286                                        (with-syntax-table table
 287                                          (matching-paren
 288                                           (char-before
 289                                            (scan-sexps (point) 1)))))
 290                                  (scan-error nil)))
 291                               (t
 292                                ;; In this case, no need to use
 293                                ;; `scan-sexps', we can use some
 294                                ;; `electric-pair--syntax-ppss' in this
 295                                ;; case (which uses the quicker
 296                                ;; `syntax-ppss' in some cases)
 297                                (let* ((ppss (electric-pair--syntax-ppss
 298                                              (1- (point))))
 299                                       (start (car (last (nth 9 ppss))))
 300                                       (opener (char-after start)))
 301                                  (and start
 302                                       (eq (char-before pos)
 303                                           (or (with-syntax-table table
 304                                                 (matching-paren opener))
 305                                               opener))))))))
 306                      (actual-pair (if (> direction 0)
 307                                       (char-before (point))
 308                                     (char-after (point)))))
 309                 (unless innermost
 310                   (setq innermost (cons matched actual-pair)))
 311                 (unless matched
 312                   (setq outermost (cons matched actual-pair)))))))
 313     (save-excursion
 314       (while (not outermost)
 315         (condition-case err
 316             (with-syntax-table table
 317               (scan-sexps (point) (if (> direction 0)
 318                                       (point-max)
 319                                     (- (point-max))))
 320               (funcall at-top-level-or-equivalent-fn))
 321           (scan-error
 322            (cond ((or
 323                    ;; some error happened and it is not of the "ended
 324                    ;; prematurely" kind"...
 325                    (not (string-match "ends prematurely" (nth 1 err)))
 326                    ;; ... or we were in a comment and just came out of
 327                    ;; it.
 328                    (and string-or-comment
 329                         (not (nth 8 (syntax-ppss)))))
 330                   (funcall at-top-level-or-equivalent-fn))
 331                  (t
 332                   ;; exit the sexp
 333                   (goto-char (nth 3 err))
 334                   (funcall ended-prematurely-fn)))))))
 335     (cons innermost outermost)))
 336
 337 (defun electric-pair--in-unterminated-string-p (char)
 338   "Return non-nil if inside unterminated string started by CHAR"
 339   (let* ((ppss (syntax-ppss))
 340          (relevant-ppss (if (nth 4 ppss) ; in comment
 341                             (electric-pair--syntax-ppss)
 342                           ppss))
 343          (string-delim (nth 3 relevant-ppss)))
 344     (and (or (eq t string-delim)
 345              (eq char string-delim))
 346          (condition-case nil (progn (scan-sexps (nth 8 relevant-ppss) 1)
 347                                     nil)
 348            (scan-error t)))))
 349
 350 (defun electric-pair--inside-string-p (char)
 351   "Return non-nil if point is inside a string started by CHAR.
 352
 353 A comments text is parsed with `electric-pair-text-syntax-table'.
 354 Also consider strings within comments, but not strings within
 355 strings."
 356   ;; FIXME: could also consider strings within strings by examining
 357   ;; delimiters.
 358   (let ((ppss (electric-pair--syntax-ppss (point) '(comment))))
 359     (memq (nth 3 ppss) (list t char))))
 360
 361 (defun electric-pair-inhibit-if-helps-balance (char)
 362   "Return non-nil if auto-pairing of CHAR would hurt parentheses' balance.
 363
 364 Works by first removing the character from the buffer, then doing
 365 some list calculations, finally restoring the situation as if nothing
 366 happened."
 367   (pcase (electric-pair-syntax-info char)
 368     (`(,syntax ,pair ,_ ,s-or-c)
 369      (unwind-protect
 370          (progn
 371            (delete-char -1)
 372            (cond ((eq ?\( syntax)
 373                   (let* ((pair-data
 374                           (electric-pair--balance-info 1 s-or-c))
 375                          (outermost (cdr pair-data)))
 376                     (cond ((car outermost)
 377                            nil)
 378                           (t
 379                            (eq (cdr outermost) pair)))))
 380                  ((eq syntax ?\")
 381                   (save-excursion
 382                     (goto-char (point-max))
 383                     (electric-pair--in-unterminated-string-p char)))))
 384        (insert-char char)))))
 385
 386 (defun electric-pair-skip-if-helps-balance (char)
 387   "Return non-nil if skipping CHAR would benefit parentheses' balance.
 388
 389 Works by first removing the character from the buffer, then doing
 390 some list calculations, finally restoring the situation as if nothing
 391 happened."
 392   (pcase (electric-pair-syntax-info char)
 393     (`(,syntax ,pair ,_ ,s-or-c)
 394      (unwind-protect
 395          (progn
 396            (delete-char -1)
 397            (cond ((eq syntax ?\))
 398                   (let* ((pair-data
 399                           (electric-pair--balance-info
 400                            -1 s-or-c))
 401                          (innermost (car pair-data))
 402                          (outermost (cdr pair-data)))
 403                     (and
 404                      (cond ((car outermost)
 405                             (car innermost))
 406                            ((car innermost)
 407                             (not (eq (cdr outermost) pair)))))))
 408                  ((eq syntax ?\")
 409                   (electric-pair--inside-string-p char))))
 410        (insert-char char)))))
 411
 412 (defun electric-pair-default-skip-self (char)
 413   (if electric-pair-preserve-balance
 414       (electric-pair-skip-if-helps-balance char)
 415     t))
 416
 417 (defun electric-pair-default-inhibit (char)
 418   (if electric-pair-preserve-balance
 419       (electric-pair-inhibit-if-helps-balance char)
 420     (electric-pair-conservative-inhibit char)))
 421
 422 (defun electric-pair-post-self-insert-function ()
 423   (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
 424          (skip-whitespace-info))
 425     (pcase (electric-pair-syntax-info last-command-event)
 426       (`(,syntax ,pair ,unconditional ,_)
 427        (cond
 428         ((null pos) nil)
 429         ;; Wrap a pair around the active region.
 430         ;;
 431         ((and (memq syntax '(?\( ?\) ?\" ?\$)) (use-region-p))
 432          ;; FIXME: To do this right, we'd need a post-self-insert-function
 433          ;; so we could add-function around it and insert the closer after
 434          ;; all the rest of the hook has run.
 435          (if (or (eq syntax ?\")
 436                  (and (eq syntax ?\))
 437                       (>= (point) (mark)))
 438                  (and (not (eq syntax ?\)))
 439                       (>= (mark) (point))))
 440              (save-excursion
 441                (goto-char (mark))
 442                (electric-pair--insert pair))
 443            (delete-region pos (1- pos))
 444            (electric-pair--insert pair)
 445            (goto-char (mark))
 446            (electric-pair--insert last-command-event)))
 447         ;; Backslash-escaped: no pairing, no skipping.
 448         ((save-excursion
 449            (goto-char (1- pos))
 450            (not (zerop (% (skip-syntax-backward "\\") 2))))
 451          nil)
 452         ;; Skip self.
 453         ((and (memq syntax '(?\) ?\" ?\$))
 454               (and (or unconditional
 455                        (if (functionp electric-pair-skip-self)
 456                            (funcall electric-pair-skip-self last-command-event)
 457                          electric-pair-skip-self))
 458                    (save-excursion
 459                      (when (and (not (and unconditional
 460                                           (eq syntax ?\")))
 461                                 (setq skip-whitespace-info
 462                                       (if (functionp electric-pair-skip-whitespace)
 463                                           (funcall electric-pair-skip-whitespace)
 464                                         electric-pair-skip-whitespace)))
 465                        (electric-pair--skip-whitespace))
 466                      (eq (char-after) last-command-event))))
 467          ;; This is too late: rather than insert&delete we'd want to only
 468          ;; skip (or insert in overwrite mode).  The difference is in what
 469          ;; goes in the undo-log and in the intermediate state which might
 470          ;; be visible to other post-self-insert-hook.  We'll just have to
 471          ;; live with it for now.
 472          (when skip-whitespace-info
 473            (electric-pair--skip-whitespace))
 474          (delete-region (1- pos) (if (eq skip-whitespace-info 'chomp)
 475                                      (point)
 476                                    pos))
 477          (forward-char))
 478         ;; Insert matching pair.
 479         ((and (memq syntax `(?\( ?\" ?\$))
 480               (not overwrite-mode)
 481               (or unconditional
 482                   (not (funcall electric-pair-inhibit-predicate
 483                                 last-command-event))))
 484          (save-excursion (electric-pair--insert pair)))))
 485       (t
 486        (when (and (if (functionp electric-pair-open-newline-between-pairs)
 487                       (funcall electric-pair-open-newline-between-pairs)
 488                     electric-pair-open-newline-between-pairs)
 489                   (eq last-command-event ?\n)
 490                   (< (1+ (point-min)) (point) (point-max))
 491                   (eq (save-excursion
 492                         (skip-chars-backward "\t\s")
 493                         (char-before (1- (point))))
 494                       (matching-paren (char-after))))
 495          (save-excursion (newline 1 t)))))))
 496
 497 (put 'electric-pair-post-self-insert-function   'priority  20)
 498
 499 (defun electric-pair-will-use-region ()
 500   (and (use-region-p)
 501        (memq (car (electric-pair-syntax-info last-command-event))
 502              '(?\( ?\) ?\" ?\$))))
 503
 504 (defun electric-pair-delete-pair (arg &optional killp)
 505   "When between adjacent paired delimiters, delete both of them.
 506 ARG and KILLP are passed directly to
 507 `backward-delete-char-untabify', which see."
 508   (interactive "*p\nP")
 509   (delete-char 1)
 510   (backward-delete-char-untabify arg killp))
 511
 512 (defvar electric-pair-mode-map
 513   (let ((map (make-sparse-keymap)))
 514     (define-key map "\177"
 515       `(menu-item
 516         "" electric-pair-delete-pair
 517         :filter
 518         ,(lambda (cmd)
 519            (let* ((prev (char-before))
 520                   (next (char-after))
 521                   (syntax-info (and prev
 522                                     (electric-pair-syntax-info prev)))
 523                   (syntax (car syntax-info))
 524                   (pair (cadr syntax-info)))
 525              (and next pair
 526                   (memq syntax '(?\( ?\" ?\$))
 527                   (eq pair next)
 528                   (if (functionp electric-pair-delete-adjacent-pairs)
 529                       (funcall electric-pair-delete-adjacent-pairs)
 530                     electric-pair-delete-adjacent-pairs)
 531                   cmd)))))
 532     map)
 533   "Keymap used by `electric-pair-mode'.")
 534
 535 ;;;###autoload
 536 (define-minor-mode electric-pair-mode
 537   "Toggle automatic parens pairing (Electric Pair mode).
 538 With a prefix argument ARG, enable Electric Pair mode if ARG is
 539 positive, and disable it otherwise.  If called from Lisp, enable
 540 the mode if ARG is omitted or nil.
 541
 542 Electric Pair mode is a global minor mode.  When enabled, typing
 543 an open parenthesis automatically inserts the corresponding
 544 closing parenthesis.  (Likewise for brackets, etc.)."
 545   :global t :group 'electricity
 546   (if electric-pair-mode
 547       (progn
 548         (add-hook 'post-self-insert-hook
 549                   #'electric-pair-post-self-insert-function)
 550         (electric--sort-post-self-insertion-hook)
 551         (add-hook 'self-insert-uses-region-functions
 552                   #'electric-pair-will-use-region))
 553     (remove-hook 'post-self-insert-hook
 554                  #'electric-pair-post-self-insert-function)
 555     (remove-hook 'self-insert-uses-region-functions
 556                  #'electric-pair-will-use-region)))
 557
 558 (provide 'elec-pair)
 559
 560 ;;; elec-pair.el ends here