1 ;;; electric.el --- window maker and Command loop for `electric' modes
3 ;; Copyright (C) 1985-1986, 1995, 2001-2011 Free Software Foundation, Inc.
5 ;; Author: K. Shane Hartman
7 ;; Keywords: extensions
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; "Electric" has been used in Emacs to refer to different things.
29 ;; - electric modes and buffers: modes that typically pop-up in a modal kind of
30 ;; way a transient buffer that automatically disappears as soon as the user
33 ;; - electric keys: self inserting keys which additionally perform some side
34 ;; operation which happens to be often convenient at that time. Examples of
35 ;; such side operations are: reindenting code, inserting a newline,
36 ;; ... auto-fill-mode and abbrev-mode can be considered as built-in forms of
37 ;; electric key behavior.
41 (eval-when-compile (require 'cl
))
43 ;; This loop is the guts for non-standard modes which retain control
44 ;; until some event occurs. It is a `do-forever', the only way out is
45 ;; to throw. It assumes that you have set up the keymap, window, and
46 ;; everything else: all it does is read commands and execute them -
47 ;; providing error messages should one occur (if there is no loop
48 ;; function - which see). The required argument is a tag which should
49 ;; expect a value of nil if the user decides to punt. The second
50 ;; argument is the prompt to be used: if nil, use "->", if 'noprompt,
51 ;; don't use a prompt, if a string, use that string as prompt, and if
52 ;; a function of no variable, it will be evaluated in every iteration
53 ;; of the loop and its return value, which can be nil, 'noprompt or a
54 ;; string, will be used as prompt. Given third argument non-nil, it
55 ;; INHIBITS quitting unless the user types C-g at toplevel. This is
56 ;; so user can do things like C-u C-g and not get thrown out. Fourth
57 ;; argument, if non-nil, should be a function of two arguments which
58 ;; is called after every command is executed. The fifth argument, if
59 ;; provided, is the state variable for the function. If the
60 ;; loop-function gets an error, the loop will abort WITHOUT throwing
61 ;; (moral: use unwind-protect around call to this function for any
62 ;; critical stuff). The second argument for the loop function is the
63 ;; conditions for any error that occurred or nil if none.
65 (defun Electric-command-loop (return-tag
66 &optional prompt inhibit-quitting
67 loop-function loop-state
)
71 (inhibit-quit inhibit-quitting
)
72 (prompt-string prompt
))
74 (if (functionp prompt
)
75 (setq prompt-string
(funcall prompt
)))
76 (if (not (stringp prompt-string
))
77 (setq prompt-string
(unless (eq prompt-string
'noprompt
) "->")))
78 (setq cmd
(read-key-sequence prompt-string
))
79 (setq last-command-event
(aref cmd
(1- (length cmd
)))
80 this-command
(key-binding cmd t
)
82 ;; This makes universal-argument-other-key work.
83 (setq universal-argument-num-events
0)
84 (if (or (prog1 quit-flag
(setq quit-flag nil
))
85 (eq last-input-event ?\C-g
))
86 (progn (setq unread-command-events nil
88 ;; If it wasn't cancelling a prefix character, then quit.
89 (if (or (= (length (this-command-keys)) 1)
90 (not inhibit-quit
)) ; safety
93 (throw return-tag nil
))
95 (setq current-prefix-arg prefix-arg
)
97 (condition-case conditions
98 (progn (command-execute cmd
)
99 (setq last-command this-command
)
100 (if (or (prog1 quit-flag
(setq quit-flag nil
))
101 (eq last-input-event ?\C-g
))
102 (progn (setq unread-command-events nil
)
103 (if (not inhibit-quit
)
106 (throw return-tag nil
))
108 (buffer-read-only (if loop-function
109 (setq err conditions
)
111 (message "Buffer is read-only")
113 (beginning-of-buffer (if loop-function
114 (setq err conditions
)
116 (message "Beginning of Buffer")
118 (end-of-buffer (if loop-function
119 (setq err conditions
)
121 (message "End of Buffer")
123 (error (if loop-function
124 (setq err conditions
)
127 (if (eq (car conditions
) 'error
)
128 (car (cdr conditions
))
129 (prin1-to-string conditions
)))
132 (if loop-function
(funcall loop-function loop-state err
))))
134 (throw return-tag nil
))
136 ;; This function is like pop-to-buffer, sort of.
138 ;; If there is a window displaying buffer
140 ;; Else if there is only one window
141 ;; Split it, selecting the window on the bottom with height being
142 ;; the lesser of max-height (if non-nil) and the number of lines in
143 ;; the buffer to be displayed subject to window-min-height constraint.
145 ;; Switch to buffer in the current window.
147 ;; Then if max-height is nil, and not all of the lines in the buffer
148 ;; are displayed, grab the whole frame.
150 ;; Returns selected window on buffer positioned at point-min.
152 (defun Electric-pop-up-window (buffer &optional max-height
)
153 (let* ((win (or (get-buffer-window buffer
) (selected-window)))
154 (buf (get-buffer buffer
)))
157 (error "Buffer %s does not exist" buffer
))
158 ((eq (window-buffer win
) buf
)
160 ((eq win
(frame-root-window))
161 ;; Try to do what the comment above says.
162 (pop-to-buffer buffer
'((pop-up-window (selected . below
)))))
164 (pop-to-buffer-same-window buf
)))
166 ;; Don't shrink the window, but expand it if necessary.
167 (goto-char (point-min))
168 (unless (= (point-max) (window-end nil t
))
169 (fit-window-to-buffer nil max-height
))
174 (defgroup electricity
()
175 "Electric behavior for self inserting keys."
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."
182 (when (or (eq (char-before) last-command-event
) ;; Sanity check.
184 (or (progn (skip-chars-backward " \t")
186 (eq (char-before) last-command-event
))
187 (progn (skip-chars-backward " \n\t")
189 (eq (char-before) last-command-event
)))))
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.
198 (defvar electric-indent-chars
'(?
\n)
199 "Characters that should cause automatic reindentation.")
201 (defun electric-indent-post-self-insert-function ()
202 ;; FIXME: This reindents the current line, but what we really want instead is
203 ;; to reindent the whole affected text. That's the current line for simple
204 ;; cases, but not all cases. We do take care of the newline case in an
205 ;; ad-hoc fashion, but there are still missing cases such as the case of
206 ;; electric-pair-mode wrapping a region with a pair of parens.
207 ;; There might be a way to get it working by analyzing buffer-undo-list, but
208 ;; it looks challenging.
210 (when (and (memq last-command-event electric-indent-chars
)
211 ;; Don't reindent while inserting spaces at beginning of line.
212 (or (not (memq last-command-event
'(?\s ?
\t)))
213 (save-excursion (skip-chars-backward " \t") (not (bolp))))
214 (setq pos
(electric--after-char-pos))
215 ;; Not in a string or comment.
216 (not (nth 8 (save-excursion (syntax-ppss pos
)))))
217 ;; For newline, we want to reindent both lines and basically behave like
218 ;; reindent-then-newline-and-indent (whose code we hence copied).
219 (when (< (1- pos
) (line-beginning-position))
220 (let ((before (copy-marker (1- pos
) t
)))
222 (unless (memq indent-line-function
223 '(indent-relative indent-to-left-margin
224 indent-relative-maybe
))
225 ;; Don't reindent the previous line if the indentation function
226 ;; is not a real one.
228 (indent-according-to-mode))
229 ;; We are at EOL before the call to indent-according-to-mode, and
230 ;; after it we usually are as well, but not always. We tried to
231 ;; address it with `save-excursion' but that uses a normal marker
232 ;; whereas we need `move after insertion', so we do the
233 ;; save/restore by hand.
235 ;; Remove the trailing whitespace after indentation because
236 ;; indentation may (re)introduce the whitespace.
237 (delete-horizontal-space t
))))
238 (unless (memq indent-line-function
'(indent-to-left-margin))
239 (indent-according-to-mode)))))
242 (define-minor-mode electric-indent-mode
243 "Automatically reindent lines of code when inserting particular chars.
244 `electric-indent-chars' specifies the set of chars that should cause reindentation."
247 (if electric-indent-mode
248 (add-hook 'post-self-insert-hook
249 #'electric-indent-post-self-insert-function
)
250 (remove-hook 'post-self-insert-hook
251 #'electric-indent-post-self-insert-function
))
252 ;; FIXME: electric-indent-mode and electric-layout-mode interact
253 ;; in non-trivial ways. It turns out that electric-indent-mode works
254 ;; better if it is run *after* electric-layout-mode's hook.
255 (when (memq #'electric-layout-post-self-insert-function
256 (memq #'electric-indent-post-self-insert-function
257 (default-value 'post-self-insert-hook
)))
258 (remove-hook 'post-self-insert-hook
259 #'electric-layout-post-self-insert-function
)
260 (add-hook 'post-self-insert-hook
261 #'electric-layout-post-self-insert-function
)))
265 (defcustom electric-pair-pairs
267 "Alist of pairs that should be used regardless of major mode."
268 :type
'(repeat (cons character character
)))
270 (defcustom electric-pair-skip-self t
271 "If non-nil, skip char instead of inserting a second closing paren.
272 When inserting a closing paren character right before the same character,
273 just skip that character instead, so that hitting ( followed by ) results
274 in \"()\" rather than \"())\".
275 This can be convenient for people who find it easier to hit ) than C-f."
278 (defun electric-pair-post-self-insert-function ()
279 (let* ((syntax (and (eq (char-before) last-command-event
) ; Sanity check.
280 (let ((x (assq last-command-event electric-pair-pairs
)))
282 (x (if (eq (car x
) (cdr x
)) ?
\" ?\
())
283 ((rassq last-command-event electric-pair-pairs
) ?\
))
284 (t (char-syntax last-command-event
))))))
285 ;; FIXME: when inserting the closer, we should maybe use
286 ;; self-insert-command, although it may prove tricky running
287 ;; post-self-insert-hook recursively, and we wouldn't want to trigger
288 ;; blink-matching-open.
289 (closer (if (eq syntax ?\
()
290 (cdr (or (assq last-command-event electric-pair-pairs
)
291 (aref (syntax-table) last-command-event
)))
292 last-command-event
)))
294 ;; Wrap a pair around the active region.
295 ((and (memq syntax
'(?\
( ?
\" ?\$
)) (use-region-p))
296 (if (> (mark) (point))
298 ;; We already inserted the open-paren but at the end of the region,
299 ;; so we have to remove it and start over.
303 (insert last-command-event
)))
305 ;; Backslash-escaped: no pairing, no skipping.
307 (goto-char (1- (point)))
308 (not (zerop (%
(skip-syntax-backward "\\") 2))))
311 ((and (memq syntax
'(?\
) ?
\" ?\$
))
312 electric-pair-skip-self
313 (eq (char-after) last-command-event
))
314 ;; This is too late: rather than insert&delete we'd want to only skip (or
315 ;; insert in overwrite mode). The difference is in what goes in the
316 ;; undo-log and in the intermediate state which might be visible to other
317 ;; post-self-insert-hook. We'll just have to live with it for now.
319 ;; Insert matching pair.
320 ((not (or (not (memq syntax
`(?\
( ?
\" ?\$
)))
322 ;; I find it more often preferable not to pair when the
323 ;; same char is next.
324 (eq last-command-event
(char-after))
325 (eq last-command-event
(char-before (1- (point))))
326 ;; I also find it often preferable not to pair next to a word.
327 (eq (char-syntax (following-char)) ?w
)))
328 (save-excursion (insert closer
))))))
331 (define-minor-mode electric-pair-mode
332 "Automatically pair-up parens when inserting an open paren."
335 (if electric-pair-mode
336 (add-hook 'post-self-insert-hook
337 #'electric-pair-post-self-insert-function
)
338 (remove-hook 'post-self-insert-hook
339 #'electric-pair-post-self-insert-function
)))
341 ;; Automatically add newlines after/before/around some chars.
343 (defvar electric-layout-rules
'()
344 "List of rules saying where to automatically insert newlines.
345 Each rule has the form (CHAR . WHERE) where CHAR is the char
346 that was just inserted and WHERE specifies where to insert newlines
347 and can be: nil, `before', `after', `around', or a function that returns
348 one of those symbols.")
350 (defun electric-layout-post-self-insert-function ()
351 (let* ((rule (cdr (assq last-command-event electric-layout-rules
)))
354 (setq pos
(electric--after-char-pos))
355 ;; Not in a string or comment.
356 (not (nth 8 (save-excursion (syntax-ppss pos
)))))
357 (let ((end (copy-marker (point) t
)))
359 (case (if (functionp rule
) (funcall rule
) rule
)
360 ;; FIXME: we used `newline' down here which called
361 ;; self-insert-command and ran post-self-insert-hook recursively.
362 ;; It happened to make electric-indent-mode work automatically with
363 ;; electric-layout-mode (at the cost of re-indenting lines
364 ;; multiple times), but I'm not sure it's what we want.
365 (before (goto-char (1- pos
)) (skip-chars-backward " \t")
366 (unless (bolp) (insert "\n")))
367 (after (insert "\n")) ; FIXME: check eolp before inserting \n?
368 (around (save-excursion
369 (goto-char (1- pos
)) (skip-chars-backward " \t")
370 (unless (bolp) (insert "\n")))
371 (insert "\n"))) ; FIXME: check eolp before inserting \n?
375 (define-minor-mode electric-layout-mode
376 "Automatically insert newlines around some chars."
379 (if electric-layout-mode
380 (add-hook 'post-self-insert-hook
381 #'electric-layout-post-self-insert-function
)
382 (remove-hook 'post-self-insert-hook
383 #'electric-layout-post-self-insert-function
)))
387 ;;; electric.el ends here