Add 2013 to yet more FSF copyright years
[emacs.git] / lisp / electric.el
blob58b8e10cb717916e6ab1ddd175f5fdad61269641
1 ;;; electric.el --- window maker and Command loop for `electric' modes
3 ;; Copyright (C) 1985-1986, 1995, 2001-2013 Free Software Foundation,
4 ;; Inc.
6 ;; Author: K. Shane Hartman
7 ;; Maintainer: FSF
8 ;; Keywords: extensions
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;;; Commentary:
27 ;; "Electric" has been used in Emacs to refer to different things.
28 ;; Among them:
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.
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.
40 ;;; Code:
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.
64 (defun Electric-command-loop (return-tag
65 &optional prompt inhibit-quitting
66 loop-function loop-state)
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 ;; This makes universal-argument-other-key work.
82 (setq universal-argument-num-events 0)
83 (if (or (prog1 quit-flag (setq quit-flag nil))
84 (eq last-input-event ?\C-g))
85 (progn (setq unread-command-events nil
86 prefix-arg nil)
87 ;; If it wasn't canceling a prefix character, then quit.
88 (if (or (= (length (this-command-keys)) 1)
89 (not inhibit-quit)) ; safety
90 (progn (ding)
91 (message "Quit")
92 (throw return-tag nil))
93 (setq cmd nil))))
94 (setq current-prefix-arg prefix-arg)
95 (if cmd
96 (condition-case conditions
97 (progn (command-execute cmd)
98 (setq last-command this-command)
99 (if (or (prog1 quit-flag (setq quit-flag nil))
100 (eq last-input-event ?\C-g))
101 (progn (setq unread-command-events nil)
102 (if (not inhibit-quit)
103 (progn (ding)
104 (message "Quit")
105 (throw return-tag nil))
106 (ding)))))
107 (buffer-read-only (if loop-function
108 (setq err conditions)
109 (ding)
110 (message "Buffer is read-only")
111 (sit-for 2)))
112 (beginning-of-buffer (if loop-function
113 (setq err conditions)
114 (ding)
115 (message "Beginning of Buffer")
116 (sit-for 2)))
117 (end-of-buffer (if loop-function
118 (setq err conditions)
119 (ding)
120 (message "End of Buffer")
121 (sit-for 2)))
122 (error (if loop-function
123 (setq err conditions)
124 (ding)
125 (message "Error: %s"
126 (if (eq (car conditions) 'error)
127 (car (cdr conditions))
128 (prin1-to-string conditions)))
129 (sit-for 2))))
130 (ding))
131 (if loop-function (funcall loop-function loop-state err))))
132 (ding)
133 (throw return-tag nil))
135 ;; This function is like pop-to-buffer, sort of.
136 ;; The algorithm is
137 ;; If there is a window displaying buffer
138 ;; Select it
139 ;; Else if there is only one window
140 ;; Split it, selecting the window on the bottom with height being
141 ;; the lesser of max-height (if non-nil) and the number of lines in
142 ;; the buffer to be displayed subject to window-min-height constraint.
143 ;; Else
144 ;; Switch to buffer in the current window.
146 ;; Then if max-height is nil, and not all of the lines in the buffer
147 ;; are displayed, grab the whole frame.
149 ;; Returns selected window on buffer positioned at point-min.
151 (defun Electric-pop-up-window (buffer &optional max-height)
152 (let* ((win (or (get-buffer-window buffer) (selected-window)))
153 (buf (get-buffer buffer))
154 (one-window (one-window-p t))
155 (pop-up-windows t)
156 (pop-up-frames nil))
157 (if (not buf)
158 (error "Buffer %s does not exist" buffer)
159 (cond ((and (eq (window-buffer win) buf))
160 (select-window win))
161 (one-window
162 (pop-to-buffer buffer)
163 (setq win (selected-window)))
165 (switch-to-buffer buf)))
166 ;; Don't shrink the window, but expand it if necessary.
167 (goto-char (point-min))
168 (unless (= (point-max) (window-end win t))
169 (fit-window-to-buffer win max-height))
170 win)))
172 ;;; Electric keys.
174 (defgroup electricity ()
175 "Electric behavior for self inserting keys."
176 :group 'editing)
178 (defun electric--after-char-pos ()
179 "Return the position after the char we just inserted.
180 Returns nil when we can't find this char."
181 (let ((pos (point)))
182 (when (or (eq (char-before) last-command-event) ;; Sanity check.
183 (save-excursion
184 (or (progn (skip-chars-backward " \t")
185 (setq pos (point))
186 (eq (char-before) last-command-event))
187 (progn (skip-chars-backward " \n\t")
188 (setq pos (point))
189 (eq (char-before) last-command-event)))))
190 pos)))
192 ;; Electric indentation.
194 ;; Autoloading variables is generally undesirable, but major modes
195 ;; should usually set this variable by adding elements to the default
196 ;; value, which only works well if the variable is preloaded.
197 ;;;###autoload
198 (defvar electric-indent-chars '(?\n)
199 "Characters that should cause automatic reindentation.")
201 (defvar electric-indent-functions nil
202 "Special hook run to decide whether to auto-indent.
203 Each function is called with one argument (the inserted char), with
204 point right after that char, and it should return t to cause indentation,
205 `no-indent' to prevent indentation or nil to let other functions decide.")
207 (defun electric-indent-post-self-insert-function ()
208 ;; FIXME: This reindents the current line, but what we really want instead is
209 ;; to reindent the whole affected text. That's the current line for simple
210 ;; cases, but not all cases. We do take care of the newline case in an
211 ;; ad-hoc fashion, but there are still missing cases such as the case of
212 ;; electric-pair-mode wrapping a region with a pair of parens.
213 ;; There might be a way to get it working by analyzing buffer-undo-list, but
214 ;; it looks challenging.
215 (let (pos)
216 (when (and
217 electric-indent-mode
218 ;; Don't reindent while inserting spaces at beginning of line.
219 (or (not (memq last-command-event '(?\s ?\t)))
220 (save-excursion (skip-chars-backward " \t") (not (bolp))))
221 (setq pos (electric--after-char-pos))
222 (save-excursion
223 (goto-char pos)
224 (let ((act (or (run-hook-with-args-until-success
225 'electric-indent-functions
226 last-command-event)
227 (memq last-command-event electric-indent-chars))))
228 (not
229 (or (memq act '(nil no-indent))
230 ;; In a string or comment.
231 (unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))
232 ;; For newline, we want to reindent both lines and basically behave like
233 ;; reindent-then-newline-and-indent (whose code we hence copied).
234 (when (< (1- pos) (line-beginning-position))
235 (let ((before (copy-marker (1- pos) t)))
236 (save-excursion
237 (unless (memq indent-line-function
238 '(indent-relative indent-to-left-margin
239 indent-relative-maybe))
240 ;; Don't reindent the previous line if the indentation function
241 ;; is not a real one.
242 (goto-char before)
243 (indent-according-to-mode))
244 ;; We are at EOL before the call to indent-according-to-mode, and
245 ;; after it we usually are as well, but not always. We tried to
246 ;; address it with `save-excursion' but that uses a normal marker
247 ;; whereas we need `move after insertion', so we do the
248 ;; save/restore by hand.
249 (goto-char before)
250 ;; Remove the trailing whitespace after indentation because
251 ;; indentation may (re)introduce the whitespace.
252 (delete-horizontal-space t))))
253 (unless (memq indent-line-function '(indent-to-left-margin))
254 (indent-according-to-mode)))))
256 ;;;###autoload
257 (define-minor-mode electric-indent-mode
258 "Toggle on-the-fly reindentation (Electric Indent mode).
259 With a prefix argument ARG, enable Electric Indent mode if ARG is
260 positive, and disable it otherwise. If called from Lisp, enable
261 the mode if ARG is omitted or nil.
263 This is a global minor mode. When enabled, it reindents whenever
264 the hook `electric-indent-functions' returns non-nil, or you
265 insert a character from `electric-indent-chars'."
266 :global t
267 :group 'electricity
268 (if (not electric-indent-mode)
269 (remove-hook 'post-self-insert-hook
270 #'electric-indent-post-self-insert-function)
271 ;; post-self-insert-hooks interact in non-trivial ways.
272 ;; It turns out that electric-indent-mode generally works better if run
273 ;; late, but still before blink-paren.
274 (add-hook 'post-self-insert-hook
275 #'electric-indent-post-self-insert-function
276 'append)
277 ;; FIXME: Ugly!
278 (let ((bp (memq #'blink-paren-post-self-insert-function
279 (default-value 'post-self-insert-hook))))
280 (when (memq #'electric-indent-post-self-insert-function bp)
281 (setcar bp #'electric-indent-post-self-insert-function)
282 (setcdr bp (cons #'blink-paren-post-self-insert-function
283 (delq #'electric-indent-post-self-insert-function
284 (cdr bp))))))))
286 ;; Electric pairing.
288 (defcustom electric-pair-pairs
289 '((?\" . ?\"))
290 "Alist of pairs that should be used regardless of major mode."
291 :group 'electricity
292 :version "24.1"
293 :type '(repeat (cons character character)))
295 (defcustom electric-pair-skip-self t
296 "If non-nil, skip char instead of inserting a second closing paren.
297 When inserting a closing paren character right before the same character,
298 just skip that character instead, so that hitting ( followed by ) results
299 in \"()\" rather than \"())\".
300 This can be convenient for people who find it easier to hit ) than C-f."
301 :group 'electricity
302 :version "24.1"
303 :type 'boolean)
305 (defun electric-pair-syntax (command-event)
306 (and electric-pair-mode
307 (let ((x (assq command-event electric-pair-pairs)))
308 (cond
309 (x (if (eq (car x) (cdr x)) ?\" ?\())
310 ((rassq command-event electric-pair-pairs) ?\))
311 (t (char-syntax command-event))))))
313 (defun electric-pair-post-self-insert-function ()
314 (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check.
315 (electric-pair-syntax last-command-event)))
316 ;; FIXME: when inserting the closer, we should maybe use
317 ;; self-insert-command, although it may prove tricky running
318 ;; post-self-insert-hook recursively, and we wouldn't want to trigger
319 ;; blink-matching-open.
320 (closer (if (eq syntax ?\()
321 (cdr (or (assq last-command-event electric-pair-pairs)
322 (aref (syntax-table) last-command-event)))
323 last-command-event)))
324 (cond
325 ;; Wrap a pair around the active region.
326 ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
327 (if (> (mark) (point))
328 (goto-char (mark))
329 ;; We already inserted the open-paren but at the end of the
330 ;; region, so we have to remove it and start over.
331 (delete-char -1)
332 (save-excursion
333 (goto-char (mark))
334 ;; Do not insert after `save-excursion' marker (Bug#11520).
335 (insert-before-markers last-command-event)))
336 (insert closer))
337 ;; Backslash-escaped: no pairing, no skipping.
338 ((save-excursion
339 (goto-char (1- (point)))
340 (not (zerop (% (skip-syntax-backward "\\") 2))))
341 nil)
342 ;; Skip self.
343 ((and (memq syntax '(?\) ?\" ?\$))
344 electric-pair-skip-self
345 (eq (char-after) last-command-event))
346 ;; This is too late: rather than insert&delete we'd want to only skip (or
347 ;; insert in overwrite mode). The difference is in what goes in the
348 ;; undo-log and in the intermediate state which might be visible to other
349 ;; post-self-insert-hook. We'll just have to live with it for now.
350 (delete-char 1))
351 ;; Insert matching pair.
352 ((not (or (not (memq syntax `(?\( ?\" ?\$)))
353 overwrite-mode
354 ;; I find it more often preferable not to pair when the
355 ;; same char is next.
356 (eq last-command-event (char-after))
357 (eq last-command-event (char-before (1- (point))))
358 ;; I also find it often preferable not to pair next to a word.
359 (eq (char-syntax (following-char)) ?w)))
360 (save-excursion (insert closer))))))
362 (defun electric-pair-will-use-region ()
363 (and (use-region-p)
364 (memq (electric-pair-syntax last-command-event) '(?\( ?\" ?\$))))
366 ;;;###autoload
367 (define-minor-mode electric-pair-mode
368 "Toggle automatic parens pairing (Electric Pair mode).
369 With a prefix argument ARG, enable Electric Pair mode if ARG is
370 positive, and disable it otherwise. If called from Lisp, enable
371 the mode if ARG is omitted or nil.
373 Electric Pair mode is a global minor mode. When enabled, typing
374 an open parenthesis automatically inserts the corresponding
375 closing parenthesis. \(Likewise for brackets, etc.)
377 See options `electric-pair-pairs' and `electric-pair-skip-self'."
378 :global t
379 :group 'electricity
380 (if electric-pair-mode
381 (progn
382 (add-hook 'post-self-insert-hook
383 #'electric-pair-post-self-insert-function)
384 (add-hook 'self-insert-uses-region-functions
385 #'electric-pair-will-use-region))
386 (remove-hook 'post-self-insert-hook
387 #'electric-pair-post-self-insert-function)
388 (remove-hook 'self-insert-uses-region-functions
389 #'electric-pair-will-use-region)))
391 ;; Automatically add newlines after/before/around some chars.
393 (defvar electric-layout-rules '()
394 "List of rules saying where to automatically insert newlines.
395 Each rule has the form (CHAR . WHERE) where CHAR is the char
396 that was just inserted and WHERE specifies where to insert newlines
397 and can be: nil, `before', `after', `around', or a function of no
398 arguments that returns one of those symbols.")
400 (defun electric-layout-post-self-insert-function ()
401 (let* ((rule (cdr (assq last-command-event electric-layout-rules)))
402 pos)
403 (when (and rule
404 (setq pos (electric--after-char-pos))
405 ;; Not in a string or comment.
406 (not (nth 8 (save-excursion (syntax-ppss pos)))))
407 (let ((end (copy-marker (point) t)))
408 (goto-char pos)
409 (pcase (if (functionp rule) (funcall rule) rule)
410 ;; FIXME: we used `newline' down here which called
411 ;; self-insert-command and ran post-self-insert-hook recursively.
412 ;; It happened to make electric-indent-mode work automatically with
413 ;; electric-layout-mode (at the cost of re-indenting lines
414 ;; multiple times), but I'm not sure it's what we want.
415 (`before (goto-char (1- pos)) (skip-chars-backward " \t")
416 (unless (bolp) (insert "\n")))
417 (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
418 (`around (save-excursion
419 (goto-char (1- pos)) (skip-chars-backward " \t")
420 (unless (bolp) (insert "\n")))
421 (insert "\n"))) ; FIXME: check eolp before inserting \n?
422 (goto-char end)))))
424 ;;;###autoload
425 (define-minor-mode electric-layout-mode
426 "Automatically insert newlines around some chars.
427 With a prefix argument ARG, enable Electric Layout mode if ARG is
428 positive, and disable it otherwise. If called from Lisp, enable
429 the mode if ARG is omitted or nil.
430 The variable `electric-layout-rules' says when and how to insert newlines."
431 :global t
432 :group 'electricity
433 (if electric-layout-mode
434 (add-hook 'post-self-insert-hook
435 #'electric-layout-post-self-insert-function)
436 (remove-hook 'post-self-insert-hook
437 #'electric-layout-post-self-insert-function)))
439 (provide 'electric)
441 ;;; electric.el ends here