etc/TODO small updates
[emacs.git] / lisp / electric.el
blobb62de874b9383750c2f7c9ca6460267af8a3835b
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 (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))
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.
144 ;; Then if max-height is nil, and not all of the lines in the buffer
145 ;; are displayed, grab the whole frame.
147 ;; Returns selected window on buffer positioned at point-min.
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)))
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)))
170 ;;; Electric keys.
172 (defgroup electricity ()
173 "Electric behavior for self inserting keys."
174 :group 'editing)
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)))
190 ;;; Electric indentation.
192 ;; Autoloading variables is generally undesirable, but major modes
193 ;; should usually set this variable by adding elements to the default
194 ;; value, which only works well if the variable is preloaded.
195 ;;;###autoload
196 (defvar electric-indent-chars '(?\n)
197 "Characters that should cause automatic reindentation.")
199 (defvar electric-indent-functions nil
200 "Special hook run to decide whether to auto-indent.
201 Each function is called with one argument (the inserted char), with
202 point right after that char, and it should return t to cause indentation,
203 `no-indent' to prevent indentation or nil to let other functions decide.")
205 (defvar-local electric-indent-inhibit nil
206 "If non-nil, reindentation is not appropriate for this buffer.
207 This should be set by major modes such as `python-mode' since
208 Python does not lend itself to fully automatic indentation.")
210 (defun electric-indent-post-self-insert-function ()
211 ;; FIXME: This reindents the current line, but what we really want instead is
212 ;; to reindent the whole affected text. That's the current line for simple
213 ;; cases, but not all cases. We do take care of the newline case in an
214 ;; ad-hoc fashion, but there are still missing cases such as the case of
215 ;; electric-pair-mode wrapping a region with a pair of parens.
216 ;; There might be a way to get it working by analyzing buffer-undo-list, but
217 ;; it looks challenging.
218 (let (pos)
219 (when (and
220 electric-indent-mode
221 ;; Don't reindent while inserting spaces at beginning of line.
222 (or (not (memq last-command-event '(?\s ?\t)))
223 (save-excursion (skip-chars-backward " \t") (not (bolp))))
224 (setq pos (electric--after-char-pos))
225 (save-excursion
226 (goto-char pos)
227 (let ((act (or (run-hook-with-args-until-success
228 'electric-indent-functions
229 last-command-event)
230 (memq last-command-event electric-indent-chars))))
231 (not
232 (or (memq act '(nil no-indent))
233 ;; In a string or comment.
234 (unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))
235 ;; For newline, we want to reindent both lines and basically behave like
236 ;; reindent-then-newline-and-indent (whose code we hence copied).
237 (when (<= pos (line-beginning-position))
238 (let ((before (copy-marker (1- pos) t)))
239 (save-excursion
240 (unless (or (memq indent-line-function
241 '(indent-relative indent-to-left-margin
242 indent-relative-maybe))
243 electric-indent-inhibit)
244 ;; Don't reindent the previous line if the indentation function
245 ;; is not a real one.
246 (goto-char before)
247 (indent-according-to-mode))
248 ;; We are at EOL before the call to indent-according-to-mode, and
249 ;; after it we usually are as well, but not always. We tried to
250 ;; address it with `save-excursion' but that uses a normal marker
251 ;; whereas we need `move after insertion', so we do the
252 ;; save/restore by hand.
253 (goto-char before)
254 ;; Remove the trailing whitespace after indentation because
255 ;; indentation may (re)introduce the whitespace.
256 (delete-horizontal-space t))))
257 (unless (or (memq indent-line-function '(indent-to-left-margin))
258 (and electric-indent-inhibit
259 (> pos (line-beginning-position))))
260 (indent-according-to-mode)))))
262 ;;;###autoload
263 (define-minor-mode electric-indent-mode
264 "Toggle on-the-fly reindentation (Electric Indent mode).
265 With a prefix argument ARG, enable Electric Indent mode if ARG is
266 positive, and disable it otherwise. If called from Lisp, enable
267 the mode if ARG is omitted or nil.
269 This is a global minor mode. When enabled, it reindents whenever
270 the hook `electric-indent-functions' returns non-nil, or you
271 insert a character from `electric-indent-chars'."
272 :global t
273 :group 'electricity
274 (if (not electric-indent-mode)
275 (remove-hook 'post-self-insert-hook
276 #'electric-indent-post-self-insert-function)
277 ;; post-self-insert-hooks interact in non-trivial ways.
278 ;; It turns out that electric-indent-mode generally works better if run
279 ;; late, but still before blink-paren.
280 (add-hook 'post-self-insert-hook
281 #'electric-indent-post-self-insert-function
282 'append)
283 ;; FIXME: Ugly!
284 (let ((bp (memq #'blink-paren-post-self-insert-function
285 (default-value 'post-self-insert-hook))))
286 (when (memq #'electric-indent-post-self-insert-function bp)
287 (setcar bp #'electric-indent-post-self-insert-function)
288 (setcdr bp (cons #'blink-paren-post-self-insert-function
289 (delq #'electric-indent-post-self-insert-function
290 (cdr bp))))))))
292 ;;; Electric pairing.
294 (defcustom electric-pair-pairs
295 '((?\" . ?\"))
296 "Alist of pairs that should be used regardless of major mode."
297 :group 'electricity
298 :version "24.1"
299 :type '(repeat (cons character character)))
301 (defcustom electric-pair-skip-self t
302 "If non-nil, skip char instead of inserting a second closing paren.
303 When inserting a closing paren character right before the same character,
304 just skip that character instead, so that hitting ( followed by ) results
305 in \"()\" rather than \"())\".
306 This can be convenient for people who find it easier to hit ) than C-f."
307 :group 'electricity
308 :version "24.1"
309 :type 'boolean)
311 (defcustom electric-pair-inhibit-predicate
312 #'electric-pair-default-inhibit
313 "Predicate to prevent insertion of a matching pair.
314 The function is called with a single char (the opening char just inserted).
315 If it returns non-nil, then `electric-pair-mode' will not insert a matching
316 closer."
317 :version "24.4"
318 :type '(choice
319 (const :tag "Default" electric-pair-default-inhibit)
320 (const :tag "Always pair" ignore)
321 function))
323 (defun electric-pair-default-inhibit (char)
325 ;; I find it more often preferable not to pair when the
326 ;; same char is next.
327 (eq char (char-after))
328 ;; Don't pair up when we insert the second of "" or of ((.
329 (and (eq char (char-before))
330 (eq char (char-before (1- (point)))))
331 ;; I also find it often preferable not to pair next to a word.
332 (eq (char-syntax (following-char)) ?w)))
334 (defun electric-pair-syntax (command-event)
335 (let ((x (assq command-event electric-pair-pairs)))
336 (cond
337 (x (if (eq (car x) (cdr x)) ?\" ?\())
338 ((rassq command-event electric-pair-pairs) ?\))
339 ((nth 8 (syntax-ppss))
340 (with-syntax-table text-mode-syntax-table (char-syntax command-event)))
341 (t (char-syntax command-event)))))
343 (defun electric-pair--insert (char)
344 (let ((last-command-event char)
345 (blink-matching-paren nil)
346 (electric-pair-mode nil))
347 (self-insert-command 1)))
349 (defun electric-pair-post-self-insert-function ()
350 (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
351 (syntax (and pos (electric-pair-syntax last-command-event)))
352 (closer (if (eq syntax ?\()
353 (cdr (or (assq last-command-event electric-pair-pairs)
354 (aref (syntax-table) last-command-event)))
355 last-command-event)))
356 (cond
357 ((null pos) nil)
358 ;; Wrap a pair around the active region.
359 ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
360 ;; FIXME: To do this right, we'd need a post-self-insert-function
361 ;; so we could add-function around it and insert the closer after
362 ;; all the rest of the hook has run.
363 (if (>= (mark) (point))
364 (goto-char (mark))
365 ;; We already inserted the open-paren but at the end of the
366 ;; region, so we have to remove it and start over.
367 (delete-region (1- pos) (point))
368 (save-excursion
369 (goto-char (mark))
370 (electric-pair--insert last-command-event)))
371 ;; Since we're right after the closer now, we could tell the rest of
372 ;; post-self-insert-hook that we inserted `closer', but then we'd get
373 ;; blink-paren to kick in, which is annoying.
374 ;;(setq last-command-event closer)
375 (insert closer))
376 ;; Backslash-escaped: no pairing, no skipping.
377 ((save-excursion
378 (goto-char (1- pos))
379 (not (zerop (% (skip-syntax-backward "\\") 2))))
380 nil)
381 ;; Skip self.
382 ((and (memq syntax '(?\) ?\" ?\$))
383 electric-pair-skip-self
384 (eq (char-after pos) last-command-event))
385 ;; This is too late: rather than insert&delete we'd want to only skip (or
386 ;; insert in overwrite mode). The difference is in what goes in the
387 ;; undo-log and in the intermediate state which might be visible to other
388 ;; post-self-insert-hook. We'll just have to live with it for now.
389 (delete-char 1))
390 ;; Insert matching pair.
391 ((not (or (not (memq syntax `(?\( ?\" ?\$)))
392 overwrite-mode
393 (funcall electric-pair-inhibit-predicate last-command-event)))
394 (save-excursion (electric-pair--insert closer))))))
396 (defun electric-pair-will-use-region ()
397 (and (use-region-p)
398 (memq (electric-pair-syntax last-command-event) '(?\( ?\" ?\$))))
400 ;;;###autoload
401 (define-minor-mode electric-pair-mode
402 "Toggle automatic parens pairing (Electric Pair mode).
403 With a prefix argument ARG, enable Electric Pair mode if ARG is
404 positive, and disable it otherwise. If called from Lisp, enable
405 the mode if ARG is omitted or nil.
407 Electric Pair mode is a global minor mode. When enabled, typing
408 an open parenthesis automatically inserts the corresponding
409 closing parenthesis. \(Likewise for brackets, etc.)
411 See options `electric-pair-pairs' and `electric-pair-skip-self'."
412 :global t
413 :group 'electricity
414 (if electric-pair-mode
415 (progn
416 (add-hook 'post-self-insert-hook
417 #'electric-pair-post-self-insert-function)
418 (add-hook 'self-insert-uses-region-functions
419 #'electric-pair-will-use-region))
420 (remove-hook 'post-self-insert-hook
421 #'electric-pair-post-self-insert-function)
422 (remove-hook 'self-insert-uses-region-functions
423 #'electric-pair-will-use-region)))
425 ;;; Electric newlines after/before/around some chars.
427 (defvar electric-layout-rules '()
428 "List of rules saying where to automatically insert newlines.
429 Each rule has the form (CHAR . WHERE) where CHAR is the char
430 that was just inserted and WHERE specifies where to insert newlines
431 and can be: nil, `before', `after', `around', or a function of no
432 arguments that returns one of those symbols.")
434 (defun electric-layout-post-self-insert-function ()
435 (let* ((rule (cdr (assq last-command-event electric-layout-rules)))
436 pos)
437 (when (and rule
438 (setq pos (electric--after-char-pos))
439 ;; Not in a string or comment.
440 (not (nth 8 (save-excursion (syntax-ppss pos)))))
441 (let ((end (copy-marker (point) t)))
442 (goto-char pos)
443 (pcase (if (functionp rule) (funcall rule) rule)
444 ;; FIXME: we used `newline' down here which called
445 ;; self-insert-command and ran post-self-insert-hook recursively.
446 ;; It happened to make electric-indent-mode work automatically with
447 ;; electric-layout-mode (at the cost of re-indenting lines
448 ;; multiple times), but I'm not sure it's what we want.
449 (`before (goto-char (1- pos)) (skip-chars-backward " \t")
450 (unless (bolp) (insert "\n")))
451 (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
452 (`around (save-excursion
453 (goto-char (1- pos)) (skip-chars-backward " \t")
454 (unless (bolp) (insert "\n")))
455 (insert "\n"))) ; FIXME: check eolp before inserting \n?
456 (goto-char end)))))
458 ;;;###autoload
459 (define-minor-mode electric-layout-mode
460 "Automatically insert newlines around some chars.
461 With a prefix argument ARG, enable Electric Layout mode if ARG is
462 positive, and disable it otherwise. If called from Lisp, enable
463 the mode if ARG is omitted or nil.
464 The variable `electric-layout-rules' says when and how to insert newlines."
465 :global t
466 :group 'electricity
467 (if electric-layout-mode
468 (add-hook 'post-self-insert-hook
469 #'electric-layout-post-self-insert-function)
470 (remove-hook 'post-self-insert-hook
471 #'electric-layout-post-self-insert-function)))
473 (provide 'electric)
475 ;;; electric.el ends here