lisp/electric.el

   1 ;;; electric.el --- window maker and Command loop for `electric' modes
   2
   3 ;; Copyright (C) 1985-1986, 1995, 2001-2013 Free Software Foundation,
   4 ;; Inc.
   5
   6 ;; Author: K. Shane Hartman
   7 ;; Maintainer: FSF
   8 ;; Keywords: extensions
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; "Electric" has been used in Emacs to refer to different things.
  28 ;; Among them:
  29 ;;
  30 ;; - electric modes and buffers: modes that typically pop-up in a modal kind of
  31 ;;   way a transient buffer that automatically disappears as soon as the user
  32 ;;   is done with it.
  33 ;;
  34 ;; - electric keys: self inserting keys which additionally perform some side
  35 ;;   operation which happens to be often convenient at that time.  Examples of
  36 ;;   such side operations are: reindenting code, inserting a newline,
  37 ;;   ... auto-fill-mode and abbrev-mode can be considered as built-in forms of
  38 ;;   electric key behavior.
  39
  40 ;;; Code:
  41
  42 ;; This loop is the guts for non-standard modes which retain control
  43 ;; until some event occurs.  It is a `do-forever', the only way out is
  44 ;; to throw.  It assumes that you have set up the keymap, window, and
  45 ;; everything else: all it does is read commands and execute them -
  46 ;; providing error messages should one occur (if there is no loop
  47 ;; function - which see).  The required argument is a tag which should
  48 ;; expect a value of nil if the user decides to punt. The second
  49 ;; argument is the prompt to be used: if nil, use "->", if 'noprompt,
  50 ;; don't use a prompt, if a string, use that string as prompt, and if
  51 ;; a function of no variable, it will be evaluated in every iteration
  52 ;; of the loop and its return value, which can be nil, 'noprompt or a
  53 ;; string, will be used as prompt.  Given third argument non-nil, it
  54 ;; INHIBITS quitting unless the user types C-g at toplevel.  This is
  55 ;; so user can do things like C-u C-g and not get thrown out.  Fourth
  56 ;; argument, if non-nil, should be a function of two arguments which
  57 ;; is called after every command is executed.  The fifth argument, if
  58 ;; provided, is the state variable for the function.  If the
  59 ;; loop-function gets an error, the loop will abort WITHOUT throwing
  60 ;; (moral: use unwind-protect around call to this function for any
  61 ;; critical stuff).  The second argument for the loop function is the
  62 ;; conditions for any error that occurred or nil if none.
  63
  64 (defun Electric-command-loop (return-tag
  65                               &optional prompt inhibit-quitting
  66                                         loop-function loop-state)
  67
  68   (let (cmd
  69         (err nil)
  70         (inhibit-quit inhibit-quitting)
  71         (prompt-string prompt))
  72     (while t
  73       (if (functionp prompt)
  74           (setq prompt-string (funcall prompt)))
  75       (if (not (stringp prompt-string))
  76           (setq prompt-string (unless (eq prompt-string 'noprompt) "->")))
  77       (setq cmd (read-key-sequence prompt-string))
  78       (setq last-command-event (aref cmd (1- (length cmd)))
  79             this-command (key-binding cmd t)
  80             cmd this-command)
  81       (if (or (prog1 quit-flag (setq quit-flag nil))
  82               (eq last-input-event ?\C-g))
  83           (progn (setq unread-command-events nil
  84                        prefix-arg nil)
  85                  ;; If it wasn't canceling a prefix character, then quit.
  86                  (if (or (= (length (this-command-keys)) 1)
  87                          (not inhibit-quit)) ; safety
  88                      (progn (ding)
  89                             (message "Quit")
  90                             (throw return-tag nil))
  91                    (setq cmd nil))))
  92       (setq current-prefix-arg prefix-arg)
  93       (if cmd
  94           (condition-case conditions
  95               (progn (command-execute cmd)
  96                      (setq last-command this-command)
  97                      (if (or (prog1 quit-flag (setq quit-flag nil))
  98                              (eq last-input-event ?\C-g))
  99                          (progn (setq unread-command-events nil)
 100                                 (if (not inhibit-quit)
 101                                     (progn (ding)
 102                                            (message "Quit")
 103                                            (throw return-tag nil))
 104                                   (ding)))))
 105             (buffer-read-only (if loop-function
 106                                   (setq err conditions)
 107                                 (ding)
 108                                 (message "Buffer is read-only")
 109                                 (sit-for 2)))
 110             (beginning-of-buffer (if loop-function
 111                                      (setq err conditions)
 112                                    (ding)
 113                                    (message "Beginning of Buffer")
 114                                    (sit-for 2)))
 115             (end-of-buffer (if loop-function
 116                                (setq err conditions)
 117                              (ding)
 118                              (message "End of Buffer")
 119                              (sit-for 2)))
 120             (error (if loop-function
 121                        (setq err conditions)
 122                      (ding)
 123                      (message "Error: %s"
 124                               (if (eq (car conditions) 'error)
 125                                   (car (cdr conditions))
 126                                 (prin1-to-string conditions)))
 127                      (sit-for 2))))
 128         (ding))
 129       (if loop-function (funcall loop-function loop-state err))))
 130   (ding)
 131   (throw return-tag nil))
 132
 133 ;; This function is like pop-to-buffer, sort of.
 134 ;; The algorithm is
 135 ;; If there is a window displaying buffer
 136 ;;      Select it
 137 ;; Else if there is only one window
 138 ;;      Split it, selecting the window on the bottom with height being
 139 ;;      the lesser of max-height (if non-nil) and the number of lines in
 140 ;;      the buffer to be displayed subject to window-min-height constraint.
 141 ;; Else
 142 ;;      Switch to buffer in the current window.
 143 ;;
 144 ;; Then if max-height is nil, and not all of the lines in the buffer
 145 ;; are displayed, grab the whole frame.
 146 ;;
 147 ;; Returns selected window on buffer positioned at point-min.
 148
 149 (defun Electric-pop-up-window (buffer &optional max-height)
 150   (let* ((win (or (get-buffer-window buffer) (selected-window)))
 151          (buf (get-buffer buffer))
 152          (one-window (one-window-p t))
 153          (pop-up-windows t)
 154          (pop-up-frames nil))
 155     (if (not buf)
 156         (error "Buffer %s does not exist" buffer)
 157       (cond ((and (eq (window-buffer win) buf))
 158              (select-window win))
 159             (one-window
 160              (pop-to-buffer buffer)
 161              (setq win (selected-window)))
 162             (t
 163              (switch-to-buffer buf)))
 164       ;; Don't shrink the window, but expand it if necessary.
 165       (goto-char (point-min))
 166       (unless (= (point-max) (window-end win t))
 167         (fit-window-to-buffer win max-height))
 168       win)))
 169
 170 ;;; Electric keys.
 171
 172 (defgroup electricity ()
 173   "Electric behavior for self inserting keys."
 174   :group 'editing)
 175
 176 (defun electric--after-char-pos ()
 177   "Return the position after the char we just inserted.
 178 Returns nil when we can't find this char."
 179   (let ((pos (point)))
 180     (when (or (eq (char-before) last-command-event) ;; Sanity check.
 181               (save-excursion
 182                 (or (progn (skip-chars-backward " \t")
 183                            (setq pos (point))
 184                            (eq (char-before) last-command-event))
 185                     (progn (skip-chars-backward " \n\t")
 186                            (setq pos (point))
 187                            (eq (char-before) last-command-event)))))
 188       pos)))
 189
 190 (defun electric--sort-post-self-insertion-hook ()
 191   "Ensure order of electric functions in `post-self-insertion-hook'.
 192
 193 Hooks in this variable interact in non-trivial ways, so a
 194 relative order must be maintained within it."
 195   (setq-default post-self-insert-hook
 196                 (sort (default-value 'post-self-insert-hook)
 197                       #'(lambda (fn1 fn2)
 198                           (< (or (get fn1 'priority) 0)
 199                              (or (get fn2 'priority) 0))))))
 200
 201 ;;; Electric indentation.
 202
 203 ;; Autoloading variables is generally undesirable, but major modes
 204 ;; should usually set this variable by adding elements to the default
 205 ;; value, which only works well if the variable is preloaded.
 206 ;;;###autoload
 207 (defvar electric-indent-chars '(?\n)
 208   "Characters that should cause automatic reindentation.")
 209
 210 (defvar electric-indent-functions nil
 211   "Special hook run to decide whether to auto-indent.
 212 Each function is called with one argument (the inserted char), with
 213 point right after that char, and it should return t to cause indentation,
 214 `no-indent' to prevent indentation or nil to let other functions decide.")
 215
 216 (defvar-local electric-indent-inhibit nil
 217   "If non-nil, reindentation is not appropriate for this buffer.
 218 This should be set by major modes such as `python-mode' since
 219 Python does not lend itself to fully automatic indentation.")
 220
 221 (defvar electric-indent-functions-without-reindent
 222   '(indent-relative indent-to-left-margin indent-relative-maybe
 223     py-indent-line coffee-indent-line org-indent-line
 224     haskell-indentation-indent-line haskell-indent-cycle haskell-simple-indent)
 225   "List of indent functions that can't reindent.
 226 If `line-indent-function' is one of those, then `electric-indent-mode' will
 227 not try to reindent lines.  It is normally better to make the major
 228 mode set `electric-indent-inhibit', but this can be used as a workaround.")
 229
 230 (defun electric-indent-post-self-insert-function ()
 231   ;; FIXME: This reindents the current line, but what we really want instead is
 232   ;; to reindent the whole affected text.  That's the current line for simple
 233   ;; cases, but not all cases.  We do take care of the newline case in an
 234   ;; ad-hoc fashion, but there are still missing cases such as the case of
 235   ;; electric-pair-mode wrapping a region with a pair of parens.
 236   ;; There might be a way to get it working by analyzing buffer-undo-list, but
 237   ;; it looks challenging.
 238   (let (pos)
 239     (when (and
 240            electric-indent-mode
 241            ;; Don't reindent while inserting spaces at beginning of line.
 242            (or (not (memq last-command-event '(?\s ?\t)))
 243                (save-excursion (skip-chars-backward " \t") (not (bolp))))
 244            (setq pos (electric--after-char-pos))
 245            (save-excursion
 246              (goto-char pos)
 247              (let ((act (or (run-hook-with-args-until-success
 248                              'electric-indent-functions
 249                              last-command-event)
 250                             (memq last-command-event electric-indent-chars))))
 251                (not
 252                 (or (memq act '(nil no-indent))
 253                     ;; In a string or comment.
 254                     (unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))
 255       ;; For newline, we want to reindent both lines and basically behave like
 256       ;; reindent-then-newline-and-indent (whose code we hence copied).
 257       (when (<= pos (line-beginning-position))
 258         (let ((before (copy-marker (1- pos) t)))
 259           (save-excursion
 260             (unless (or (memq indent-line-function
 261                               electric-indent-functions-without-reindent)
 262                         electric-indent-inhibit)
 263               ;; Don't reindent the previous line if the indentation function
 264               ;; is not a real one.
 265               (goto-char before)
 266               (indent-according-to-mode))
 267             ;; We are at EOL before the call to indent-according-to-mode, and
 268             ;; after it we usually are as well, but not always.  We tried to
 269             ;; address it with `save-excursion' but that uses a normal marker
 270             ;; whereas we need `move after insertion', so we do the
 271             ;; save/restore by hand.
 272             (goto-char before)
 273             (when (eolp)
 274               ;; Remove the trailing whitespace after indentation because
 275               ;; indentation may (re)introduce the whitespace.
 276               (delete-horizontal-space t)))))
 277       (unless (and electric-indent-inhibit
 278                    (> pos (line-beginning-position)))
 279         (indent-according-to-mode)))))
 280
 281 (put 'electric-indent-post-self-insert-function 'priority  60)
 282
 283 (defun electric-indent-just-newline (arg)
 284   "Insert just a newline, without any auto-indentation."
 285   (interactive "*P")
 286   (let ((electric-indent-mode nil))
 287     (newline arg 'interactive)))
 288
 289 ;;;###autoload
 290 (define-minor-mode electric-indent-mode
 291   "Toggle on-the-fly reindentation (Electric Indent mode).
 292 With a prefix argument ARG, enable Electric Indent mode if ARG is
 293 positive, and disable it otherwise.  If called from Lisp, enable
 294 the mode if ARG is omitted or nil.
 295
 296 This is a global minor mode.  When enabled, it reindents whenever
 297 the hook `electric-indent-functions' returns non-nil, or you
 298 insert a character from `electric-indent-chars'."
 299   :global t :group 'electricity
 300   :initialize 'custom-initialize-delay
 301   :init-value t
 302   (if (not electric-indent-mode)
 303       (progn
 304         (when (eq (lookup-key global-map [?\C-j])
 305                   'electric-indent-just-newline)
 306           (define-key global-map [?\C-j] 'newline-and-indent))
 307         (remove-hook 'post-self-insert-hook
 308                      #'electric-indent-post-self-insert-function))
 309     (when (eq (lookup-key global-map [?\C-j]) 'newline-and-indent)
 310       (define-key global-map [?\C-j] 'electric-indent-just-newline))
 311     (add-hook 'post-self-insert-hook
 312               #'electric-indent-post-self-insert-function)
 313     (electric--sort-post-self-insertion-hook)))
 314
 315 ;;;###autoload
 316 (define-minor-mode electric-indent-local-mode
 317   "Toggle `electric-indent-mode' only in this buffer."
 318   :variable (buffer-local-value 'electric-indent-mode (current-buffer))
 319   (cond
 320    ((eq electric-indent-mode (default-value 'electric-indent-mode))
 321     (kill-local-variable 'electric-indent-mode))
 322    ((not (default-value 'electric-indent-mode))
 323     ;; Locally enabled, but globally disabled.
 324     (electric-indent-mode 1)                ; Setup the hooks.
 325     (setq-default electric-indent-mode nil) ; But keep it globally disabled.
 326     )))
 327
 328 ;;; Electric pairing.
 329
 330 (defcustom electric-pair-pairs
 331   '((?\" . ?\"))
 332   "Alist of pairs that should be used regardless of major mode.
 333
 334 Pairs of delimiters in this list are a fallback in case they have
 335 no syntax relevant to `electric-pair-mode' in the mode's syntax
 336 table.
 337
 338 See also the variable `electric-pair-text-pairs'."
 339   :version "24.1"
 340   :type '(repeat (cons character character)))
 341
 342 (defcustom electric-pair-text-pairs
 343   '((?\" . ?\" ))
 344   "Alist of pairs that should always be used in comments and strings.
 345
 346 Pairs of delimiters in this list are a fallback in case they have
 347 no syntax relevant to `electric-pair-mode' in the syntax table
 348 defined in `electric-pair-text-syntax-table'"
 349   :version "24.4"
 350   :type '(repeat (cons character character)))
 351
 352 (defcustom electric-pair-skip-self #'electric-pair-default-skip-self
 353   "If non-nil, skip char instead of inserting a second closing paren.
 354
 355 When inserting a closing paren character right before the same character,
 356 just skip that character instead, so that hitting ( followed by ) results
 357 in \"()\" rather than \"())\".
 358
 359 This can be convenient for people who find it easier to hit ) than C-f.
 360
 361 Can also be a function of one argument (the closer char just
 362 inserted), in which case that function's return value is
 363 considered instead."
 364   :version "24.1"
 365   :type '(choice
 366           (const :tag "Never skip" nil)
 367           (const :tag "Help balance" electric-pair-default-skip-self)
 368           (const :tag "Always skip" t)
 369           function))
 370
 371 (defcustom electric-pair-inhibit-predicate
 372   #'electric-pair-default-inhibit
 373   "Predicate to prevent insertion of a matching pair.
 374
 375 The function is called with a single char (the opening char just inserted).
 376 If it returns non-nil, then `electric-pair-mode' will not insert a matching
 377 closer."
 378   :version "24.4"
 379   :type '(choice
 380           (const :tag "Conservative" electric-pair-conservative-inhibit)
 381           (const :tag "Help balance" electric-pair-default-inhibit)
 382           (const :tag "Always pair" ignore)
 383           function))
 384
 385 (defcustom electric-pair-preserve-balance t
 386   "Non-nil if default pairing and skipping should help balance parentheses.
 387
 388 The default values of `electric-pair-inhibit-predicate' and
 389 `electric-pair-skip-self' check this variable before delegating to other
 390 predicates reponsible for making decisions on whether to pair/skip some
 391 characters based on the actual state of the buffer's parenthesis and
 392 quotes."
 393   :version "24.4"
 394   :type 'boolean)
 395
 396 (defcustom electric-pair-delete-adjacent-pairs t
 397   "If non-nil, backspacing an open paren also deletes adjacent closer.
 398
 399 Can also be a function of no arguments, in which case that function's
 400 return value is considered instead."
 401   :version "24.4"
 402   :type '(choice
 403           (const :tag "Yes" t)
 404           (const :tag "No" nil)
 405           function))
 406
 407 (defcustom electric-pair-open-newline-between-pairs t
 408   "If non-nil, a newline between adjacent parentheses opens an extra one.
 409
 410 Can also be a function of no arguments, in which case that function's
 411 return value is considered instead."
 412   :version "24.4"
 413   :type '(choice
 414           (const :tag "Yes" t)
 415           (const :tag "No" nil)
 416           function))
 417
 418 (defcustom electric-pair-skip-whitespace t
 419   "If non-nil skip whitespace when skipping over closing parens.
 420
 421 The specific kind of whitespace skipped is given by the variable
 422 `electric-pair-skip-whitespace-chars'.
 423
 424 The symbol `chomp' specifies that the skipped-over whitespace
 425 should be deleted.
 426
 427 Can also be a function of no arguments, in which case that function's
 428 return value is considered instead."
 429   :version "24.4"
 430   :type '(choice
 431           (const :tag "Yes, jump over whitespace" t)
 432           (const :tag "Yes, and delete whitespace" 'chomp)
 433           (const :tag "No, no whitespace skipping" nil)
 434           function))
 435
 436 (defcustom electric-pair-skip-whitespace-chars (list ?\t ?\s ?\n)
 437   "Whitespace characters considered by `electric-pair-skip-whitespace'."
 438   :version "24.4"
 439   :type '(choice (set (const :tag "Space" ?\s)
 440                       (const :tag "Tab" ?\t)
 441                       (const :tag "Newline" ?\n))
 442                  (list character)))
 443
 444 (defun electric-pair--skip-whitespace ()
 445   "Skip whitespace forward, not crossing comment or string boundaries."
 446   (let ((saved (point))
 447         (string-or-comment (nth 8 (syntax-ppss))))
 448     (skip-chars-forward (apply #'string electric-pair-skip-whitespace-chars))
 449     (unless (eq string-or-comment (nth 8 (syntax-ppss)))
 450       (goto-char saved))))
 451
 452 (defvar electric-pair-text-syntax-table prog-mode-syntax-table
 453   "Syntax table used when pairing inside comments and strings.
 454
 455 `electric-pair-mode' considers this syntax table only when point in inside
 456 quotes or comments. If lookup fails here, `electric-pair-text-pairs' will
 457 be considered.")
 458
 459 (defun electric-pair-backward-delete-char (n &optional killflag untabify)
 460   "Delete characters backward, and maybe also two adjacent paired delimiters.
 461
 462 Remaining behaviour is given by `backward-delete-char' or, if UNTABIFY is
 463 non-nil, `backward-delete-char-untabify'."
 464   (interactive "*p\nP")
 465   (let* ((prev (char-before))
 466          (next (char-after))
 467          (syntax-info (electric-pair-syntax-info prev))
 468          (syntax (car syntax-info))
 469          (pair (cadr syntax-info)))
 470     (when (and (if (functionp electric-pair-delete-adjacent-pairs)
 471                    (funcall electric-pair-delete-adjacent-pairs)
 472                  electric-pair-delete-adjacent-pairs)
 473                next
 474                (memq syntax '(?\( ?\" ?\$))
 475                (eq pair next))
 476       (delete-char 1 killflag))
 477     (if untabify
 478         (backward-delete-char-untabify n killflag)
 479         (backward-delete-char n killflag))))
 480
 481 (defun electric-pair-backward-delete-char-untabify (n &optional killflag)
 482   "Delete characters backward, and maybe also two adjacent paired delimiters.
 483
 484 Remaining behaviour is given by `backward-delete-char-untabify'."
 485   (interactive "*p\nP")
 486   (electric-pair-backward-delete-char n killflag t))
 487
 488 (defun electric-pair-conservative-inhibit (char)
 489   (or
 490    ;; I find it more often preferable not to pair when the
 491    ;; same char is next.
 492    (eq char (char-after))
 493    ;; Don't pair up when we insert the second of "" or of ((.
 494    (and (eq char (char-before))
 495         (eq char (char-before (1- (point)))))
 496    ;; I also find it often preferable not to pair next to a word.
 497    (eq (char-syntax (following-char)) ?w)))
 498
 499 (defun electric-pair-syntax-info (command-event)
 500   "Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
 501
 502 SYNTAX is COMMAND-EVENT's syntax character.  PAIR is
 503 COMMAND-EVENT's pair.  UNCONDITIONAL indicates the variables
 504 `electric-pair-pairs' or `electric-pair-text-pairs' were used to
 505 lookup syntax.  STRING-OR-COMMENT-START indicates that point is
 506 inside a comment of string."
 507   (let* ((pre-string-or-comment (nth 8 (save-excursion
 508                                          (syntax-ppss (1- (point))))))
 509          (post-string-or-comment (nth 8 (syntax-ppss (point))))
 510          (string-or-comment (and post-string-or-comment
 511                                  pre-string-or-comment))
 512          (table (if string-or-comment
 513                     electric-pair-text-syntax-table
 514                   (syntax-table)))
 515          (table-syntax-and-pair (with-syntax-table table
 516                                   (list (char-syntax command-event)
 517                                         (or (matching-paren command-event)
 518                                             command-event))))
 519          (fallback (if string-or-comment
 520                        (append electric-pair-text-pairs
 521                                electric-pair-pairs)
 522                      electric-pair-pairs))
 523          (direct (assq command-event fallback))
 524          (reverse (rassq command-event fallback)))
 525     (cond
 526      ((memq (car table-syntax-and-pair)
 527             '(?\" ?\( ?\) ?\$))
 528       (append table-syntax-and-pair (list nil string-or-comment)))
 529      (direct (if (eq (car direct) (cdr direct))
 530                  (list ?\" command-event t string-or-comment)
 531                (list ?\( (cdr direct) t string-or-comment)))
 532      (reverse (list ?\) (car reverse) t string-or-comment)))))
 533
 534 (defun electric-pair--insert (char)
 535   (let ((last-command-event char)
 536         (blink-matching-paren nil)
 537         (electric-pair-mode nil))
 538     (self-insert-command 1)))
 539
 540 (defun electric-pair--syntax-ppss (&optional pos where)
 541   "Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
 542
 543 WHERE is list defaulting to '(string comment) and indicates
 544 when to fallback to `parse-partial-sexp'."
 545   (let* ((pos (or pos (point)))
 546          (where (or where '(string comment)))
 547          (quick-ppss (syntax-ppss))
 548          (quick-ppss-at-pos (syntax-ppss pos)))
 549     (if (or (and (nth 3 quick-ppss) (memq 'string where))
 550             (and (nth 4 quick-ppss) (memq 'comment where)))
 551         (with-syntax-table electric-pair-text-syntax-table
 552           (parse-partial-sexp (1+ (nth 8 quick-ppss)) pos))
 553       ;; HACK! cc-mode apparently has some `syntax-ppss' bugs
 554       (if (memq major-mode '(c-mode c++ mode))
 555           (parse-partial-sexp (point-min) pos)
 556         quick-ppss-at-pos))))
 557
 558 ;; Balancing means controlling pairing and skipping of parentheses so
 559 ;; that, if possible, the buffer ends up at least as balanced as
 560 ;; before, if not more. The algorithm is slightly complex because some
 561 ;; situations like "()))" need pairing to occur at the end but not at
 562 ;; the beginning. Balancing should also happen independently for
 563 ;; different types of parentheses, so that having your {}'s unbalanced
 564 ;; doesn't keep `electric-pair-mode' from balancing your ()'s and your
 565 ;; []'s.
 566 (defun electric-pair--balance-info (direction string-or-comment)
 567   "Examine lists forward or backward according to DIRECTIONS's sign.
 568
 569 STRING-OR-COMMENT is info suitable for running `parse-partial-sexp'.
 570
 571 Return a cons of two descritions (MATCHED-P . PAIR) for the
 572 innermost and outermost lists that enclose point. The outermost
 573 list enclosing point is either the first top-level or first
 574 mismatched list found by uplisting.
 575
 576 If the outermost list is matched, don't rely on its PAIR. If
 577 point is not enclosed by any lists, return ((T) (T))."
 578   (let* (innermost
 579          outermost
 580          (table (if string-or-comment
 581                     electric-pair-text-syntax-table
 582                   (syntax-table)))
 583          (at-top-level-or-equivalent-fn
 584           ;; called when `scan-sexps' ran perfectly, when when it
 585           ;; found a parenthesis pointing in the direction of
 586           ;; travel. Also when travel started inside a comment and
 587           ;; exited it
 588           #'(lambda ()
 589               (setq outermost (list t))
 590               (unless innermost
 591                 (setq innermost (list t)))))
 592          (ended-prematurely-fn
 593           ;; called when `scan-sexps' crashed against a parenthesis
 594           ;; pointing opposite the direction of travel. After
 595           ;; traversing that character, the idea is to travel one sexp
 596           ;; in the opposite direction looking for a matching
 597           ;; delimiter.
 598           #'(lambda ()
 599               (let* ((pos (point))
 600                      (matched
 601                       (save-excursion
 602                         (cond ((< direction 0)
 603                                (condition-case nil
 604                                    (eq (char-after pos)
 605                                        (with-syntax-table table
 606                                          (matching-paren
 607                                           (char-before
 608                                            (scan-sexps (point) 1)))))
 609                                  (scan-error nil)))
 610                               (t
 611                                ;; In this case, no need to use
 612                                ;; `scan-sexps', we can use some
 613                                ;; `electric-pair--syntax-ppss' in this
 614                                ;; case (which uses the quicker
 615                                ;; `syntax-ppss' in some cases)
 616                                (let* ((ppss (electric-pair--syntax-ppss
 617                                              (1- (point))))
 618                                       (start (car (last (nth 9 ppss))))
 619                                       (opener (char-after start)))
 620                                  (and start
 621                                       (eq (char-before pos)
 622                                           (or (with-syntax-table table
 623                                                 (matching-paren opener))
 624                                               opener))))))))
 625                      (actual-pair (if (> direction 0)
 626                                       (char-before (point))
 627                                     (char-after (point)))))
 628                 (unless innermost
 629                   (setq innermost (cons matched actual-pair)))
 630                 (unless matched
 631                   (setq outermost (cons matched actual-pair)))))))
 632     (save-excursion
 633       (while (not outermost)
 634         (condition-case err
 635             (with-syntax-table table
 636               (scan-sexps (point) (if (> direction 0)
 637                                       (point-max)
 638                                     (- (point-max))))
 639               (funcall at-top-level-or-equivalent-fn))
 640           (scan-error
 641            (cond ((or
 642                    ;; some error happened and it is not of the "ended
 643                    ;; prematurely" kind"...
 644                    (not (string-match "ends prematurely" (nth 1 err)))
 645                    ;; ... or we were in a comment and just came out of
 646                    ;; it.
 647                    (and string-or-comment
 648                         (not (nth 8 (syntax-ppss)))))
 649                   (funcall at-top-level-or-equivalent-fn))
 650                  (t
 651                   ;; exit the sexp
 652                   (goto-char (nth 3 err))
 653                   (funcall ended-prematurely-fn)))))))
 654     (cons innermost outermost)))
 655
 656 (defun electric-pair--looking-at-unterminated-string-p (char)
 657   "Say if following string starts with CHAR and is unterminated."
 658   ;; FIXME: ugly/naive
 659   (save-excursion
 660     (skip-chars-forward (format "^%c" char))
 661     (while (not (zerop (% (save-excursion (skip-syntax-backward "\\")) 2)))
 662       (unless (eobp)
 663         (forward-char 1)
 664         (skip-chars-forward (format "^%c" char))))
 665     (and (not (eobp))
 666          (condition-case err
 667              (progn (forward-sexp) nil)
 668            (scan-error t)))))
 669
 670 (defun electric-pair--inside-string-p (char)
 671   "Say if point is inside a string started by CHAR.
 672
 673 A comments text is parsed with `electric-pair-text-syntax-table'.
 674 Also consider strings within comments, but not strings within
 675 strings."
 676   ;; FIXME: could also consider strings within strings by examining
 677   ;; delimiters.
 678   (let* ((ppss (electric-pair--syntax-ppss (point) '(comment))))
 679     (memq (nth 3 ppss) (list t char))))
 680
 681 (defun electric-pair-inhibit-if-helps-balance (char)
 682   "Return non-nil if auto-pairing of CHAR would hurt parentheses' balance.
 683
 684 Works by first removing the character from the buffer, then doing
 685 some list calculations, finally restoring the situation as if nothing
 686 happened."
 687   (pcase (electric-pair-syntax-info char)
 688     (`(,syntax ,pair ,_ ,s-or-c)
 689      (unwind-protect
 690          (progn
 691            (delete-char -1)
 692            (cond ((eq ?\( syntax)
 693                   (let* ((pair-data
 694                           (electric-pair--balance-info 1 s-or-c))
 695                          (innermost (car pair-data))
 696                          (outermost (cdr pair-data)))
 697                     (cond ((car outermost)
 698                            nil)
 699                           (t
 700                            (eq (cdr outermost) pair)))))
 701                  ((eq syntax ?\")
 702                   (electric-pair--looking-at-unterminated-string-p char))))
 703        (insert-char char)))))
 704
 705 (defun electric-pair-skip-if-helps-balance (char)
 706   "Return non-nil if skipping CHAR would benefit parentheses' balance.
 707
 708 Works by first removing the character from the buffer, then doing
 709 some list calculations, finally restoring the situation as if nothing
 710 happened."
 711   (pcase (electric-pair-syntax-info char)
 712     (`(,syntax ,pair ,_ ,s-or-c)
 713      (unwind-protect
 714          (progn
 715            (delete-char -1)
 716            (cond ((eq syntax ?\))
 717                   (let* ((pair-data
 718                           (electric-pair--balance-info
 719                            -1 s-or-c))
 720                          (innermost (car pair-data))
 721                          (outermost (cdr pair-data)))
 722                     (and
 723                      (cond ((car outermost)
 724                             (car innermost))
 725                            ((car innermost)
 726                             (not (eq (cdr outermost) pair)))))))
 727                  ((eq syntax ?\")
 728                   (electric-pair--inside-string-p char))))
 729        (insert-char char)))))
 730
 731 (defun electric-pair-default-skip-self (char)
 732   (if electric-pair-preserve-balance
 733       (electric-pair-skip-if-helps-balance char)
 734     t))
 735
 736 (defun electric-pair-default-inhibit (char)
 737   (if electric-pair-preserve-balance
 738       (electric-pair-inhibit-if-helps-balance char)
 739     (electric-pair-conservative-inhibit char)))
 740
 741 (defun electric-pair-post-self-insert-function ()
 742   (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
 743          (skip-whitespace-info))
 744     (pcase (electric-pair-syntax-info last-command-event)
 745       (`(,syntax ,pair ,unconditional ,_)
 746        (cond
 747         ((null pos) nil)
 748         ;; Wrap a pair around the active region.
 749         ;;
 750         ((and (memq syntax '(?\( ?\) ?\" ?\$)) (use-region-p))
 751          ;; FIXME: To do this right, we'd need a post-self-insert-function
 752          ;; so we could add-function around it and insert the closer after
 753          ;; all the rest of the hook has run.
 754          (if (or (eq syntax ?\")
 755                  (and (eq syntax ?\))
 756                       (>= (point) (mark)))
 757                  (and (not (eq syntax ?\)))
 758                       (>= (mark) (point))))
 759              (save-excursion
 760                (goto-char (mark))
 761                (electric-pair--insert pair))
 762            (delete-region pos (1- pos))
 763            (electric-pair--insert pair)
 764            (goto-char (mark))
 765            (electric-pair--insert last-command-event)))
 766         ;; Backslash-escaped: no pairing, no skipping.
 767         ((save-excursion
 768            (goto-char (1- pos))
 769            (not (zerop (% (skip-syntax-backward "\\") 2))))
 770          nil)
 771         ;; Skip self.
 772         ((and (memq syntax '(?\) ?\" ?\$))
 773               (and (or unconditional
 774                        (if (functionp electric-pair-skip-self)
 775                            (funcall electric-pair-skip-self last-command-event)
 776                          electric-pair-skip-self))
 777                    (save-excursion
 778                      (when (setq skip-whitespace-info
 779                                  (if (functionp electric-pair-skip-whitespace)
 780                                      (funcall electric-pair-skip-whitespace)
 781                                    electric-pair-skip-whitespace))
 782                        (electric-pair--skip-whitespace))
 783                      (eq (char-after) last-command-event))))
 784          ;; This is too late: rather than insert&delete we'd want to only
 785          ;; skip (or insert in overwrite mode).  The difference is in what
 786          ;; goes in the undo-log and in the intermediate state which might
 787          ;; be visible to other post-self-insert-hook.  We'll just have to
 788          ;; live with it for now.
 789          (when skip-whitespace-info
 790            (electric-pair--skip-whitespace))
 791          (delete-region (1- pos) (if (eq skip-whitespace-info 'chomp)
 792                                      (point)
 793                                    pos))
 794          (forward-char))
 795         ;; Insert matching pair.
 796         ((and (memq syntax `(?\( ?\" ?\$))
 797               (not overwrite-mode)
 798               (or unconditional
 799                   (not (funcall electric-pair-inhibit-predicate
 800                                 last-command-event))))
 801          (save-excursion (electric-pair--insert pair)))))
 802       (t
 803        (when (and (if (functionp electric-pair-open-newline-between-pairs)
 804                       (funcall electric-pair-open-newline-between-pairs)
 805                     electric-pair-open-newline-between-pairs)
 806                   (eq last-command-event ?\n)
 807                   (not (eobp))
 808                   (eq (save-excursion
 809                         (skip-chars-backward "\t\s")
 810                         (char-before (1- (point))))
 811                       (matching-paren (char-after))))
 812          (save-excursion (newline 1 t)))))))
 813
 814 (put 'electric-pair-post-self-insert-function   'priority  20)
 815
 816 (defun electric-pair-will-use-region ()
 817   (and (use-region-p)
 818        (memq (car (electric-pair-syntax-info last-command-event))
 819              '(?\( ?\) ?\" ?\$))))
 820
 821 (defvar electric-pair-mode-map
 822   (let ((map (make-sparse-keymap)))
 823     (define-key map [remap backward-delete-char-untabify]
 824       'electric-pair-backward-delete-char-untabify)
 825     (define-key map [remap backward-delete-char]
 826       'electric-pair-backward-delete-char)
 827     (define-key map [remap delete-backward-char]
 828       'electric-pair-backward-delete-char)
 829     map)
 830   "Keymap used by `electric-pair-mode'.")
 831
 832 ;;;###autoload
 833 (define-minor-mode electric-pair-mode
 834   "Toggle automatic parens pairing (Electric Pair mode).
 835 With a prefix argument ARG, enable Electric Pair mode if ARG is
 836 positive, and disable it otherwise.  If called from Lisp, enable
 837 the mode if ARG is omitted or nil.
 838
 839 Electric Pair mode is a global minor mode.  When enabled, typing
 840 an open parenthesis automatically inserts the corresponding
 841 closing parenthesis.  \(Likewise for brackets, etc.)."
 842   :global t :group 'electricity
 843   (if electric-pair-mode
 844       (progn
 845         (add-hook 'post-self-insert-hook
 846                   #'electric-pair-post-self-insert-function)
 847         (electric--sort-post-self-insertion-hook)
 848         (add-hook 'self-insert-uses-region-functions
 849                   #'electric-pair-will-use-region))
 850     (remove-hook 'post-self-insert-hook
 851                  #'electric-pair-post-self-insert-function)
 852     (remove-hook 'self-insert-uses-region-functions
 853                  #'electric-pair-will-use-region)))
 854
 855 ;;; Electric newlines after/before/around some chars.
 856
 857 (defvar electric-layout-rules nil
 858   "List of rules saying where to automatically insert newlines.
 859
 860 Each rule has the form (CHAR . WHERE) where CHAR is the char that
 861 was just inserted and WHERE specifies where to insert newlines
 862 and can be: nil, `before', `after', `around', `after-stay', or a
 863 function of no arguments that returns one of those symbols.
 864
 865 The symbols specify where in relation to CHAR the newline
 866 character(s) should be inserted. `after-stay' means insert a
 867 newline after CHAR but stay in the same place.")
 868
 869 (defun electric-layout-post-self-insert-function ()
 870   (let* ((rule (cdr (assq last-command-event electric-layout-rules)))
 871          pos)
 872     (when (and rule
 873                (setq pos (electric--after-char-pos))
 874                ;; Not in a string or comment.
 875                (not (nth 8 (save-excursion (syntax-ppss pos)))))
 876       (let ((end (copy-marker (point)))
 877             (sym (if (functionp rule) (funcall rule) rule)))
 878         (set-marker-insertion-type end (not (eq sym 'after-stay)))
 879         (goto-char pos)
 880         (pcase sym
 881           ;; FIXME: we used `newline' down here which called
 882           ;; self-insert-command and ran post-self-insert-hook recursively.
 883           ;; It happened to make electric-indent-mode work automatically with
 884           ;; electric-layout-mode (at the cost of re-indenting lines
 885           ;; multiple times), but I'm not sure it's what we want.
 886           ;;
 887           ;; FIXME: check eolp before inserting \n?
 888           (`before (goto-char (1- pos)) (skip-chars-backward " \t")
 889                    (unless (bolp) (insert "\n")))
 890           (`after  (insert "\n"))
 891           (`after-stay (save-excursion
 892                          (let ((electric-layout-rules nil))
 893                            (newline 1 t))))
 894           (`around (save-excursion
 895                      (goto-char (1- pos)) (skip-chars-backward " \t")
 896                      (unless (bolp) (insert "\n")))
 897                    (insert "\n")))      ; FIXME: check eolp before inserting \n?
 898         (goto-char end)))))
 899
 900 (put 'electric-layout-post-self-insert-function 'priority  40)
 901
 902 ;;;###autoload
 903 (define-minor-mode electric-layout-mode
 904   "Automatically insert newlines around some chars.
 905 With a prefix argument ARG, enable Electric Layout mode if ARG is
 906 positive, and disable it otherwise.  If called from Lisp, enable
 907 the mode if ARG is omitted or nil.
 908 The variable `electric-layout-rules' says when and how to insert newlines."
 909   :global t :group 'electricity
 910   (cond (electric-layout-mode
 911          (add-hook 'post-self-insert-hook
 912                    #'electric-layout-post-self-insert-function)
 913          (electric--sort-post-self-insertion-hook))
 914         (t
 915          (remove-hook 'post-self-insert-hook
 916                       #'electric-layout-post-self-insert-function))))
 917
 918 (provide 'electric)
 919
 920 ;;; electric.el ends here