annotate lisp/electric.el @ 12972:62682d1146a0

(dired-byte-compile): Report failure if output file is not created.
author Richard M. Stallman <rms@gnu.org>
date Tue, 29 Aug 1995 16:22:25 +0000
parents 13660e63d8f0
children a10616f0ad17
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
662
8a533acedb77 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
1 ;;; electric.el --- window maker and Command loop for `electric' modes.
8a533acedb77 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
2
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 811
diff changeset
3 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 811
diff changeset
4
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 778
diff changeset
5 ;; Author: K. Shane Hartman
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 778
diff changeset
6 ;; Maintainer: FSF
811
e694e0879463 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
7 ;; Keywords: extensions
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 778
diff changeset
8
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 778
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 ;; any later version.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19 ;; GNU General Public License for more details.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24
2229
bd3c525fa6fc Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1821
diff changeset
25 ;;; Commentary:
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 35
diff changeset
27 ; zaaaaaaap
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28
2229
bd3c525fa6fc Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1821
diff changeset
29 ;;; Code:
bd3c525fa6fc Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1821
diff changeset
30
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 ;; This loop is the guts for non-standard modes which retain control
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 ;; until some event occurs. It is a `do-forever', the only way out is to
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33 ;; throw. It assumes that you have set up the keymap, window, and
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 ;; everything else: all it does is read commands and execute them -
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 ;; providing error messages should one occur (if there is no loop
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
36 ;; function - which see). The required argument is a tag which should
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37 ;; expect a value of nil if the user decides to punt. The
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 ;; second argument is a prompt string (defaults to "->"). Given third
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39 ;; argument non-nil, it INHIBITS quitting unless the user types C-g at
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 ;; toplevel. This is so user can do things like C-u C-g and not get
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41 ;; thrown out. Fourth argument, if non-nil, should be a function of two
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
42 ;; arguments which is called after every command is executed. The fifth
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 ;; argument, if provided, is the state variable for the function. If the
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 ;; loop-function gets an error, the loop will abort WITHOUT throwing
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 ;; (moral: use unwind-protect around call to this function for any
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 ;; critical stuff). The second argument for the loop function is the
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
47 ;; conditions for any error that occurred or nil if none.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
48
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49 (defun Electric-command-loop (return-tag
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 &optional prompt inhibit-quit
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 loop-function loop-state)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52 (if (not prompt) (setq prompt "->"))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53 (let (cmd (err nil))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54 (while t
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
55 (setq cmd (read-key-sequence (if (stringp prompt)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
56 prompt (funcall prompt))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 (setq last-command-char (aref cmd (1- (length cmd)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 this-command (key-binding cmd)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 cmd this-command)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60 (if (or (prog1 quit-flag (setq quit-flag nil))
3439
13660e63d8f0 (Electric-command-loop): Use eq to compare events.
Richard M. Stallman <rms@gnu.org>
parents: 2540
diff changeset
61 (eq last-input-char ?\C-g))
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1609
diff changeset
62 (progn (setq unread-command-events nil
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 prefix-arg nil)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 ;; If it wasn't cancelling a prefix character, then quit.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65 (if (or (= (length (this-command-keys)) 1)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 (not inhibit-quit)) ; safety
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 (progn (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 (message "Quit")
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 (throw return-tag nil))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70 (setq cmd nil))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 (setq current-prefix-arg prefix-arg)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 (if cmd
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 (condition-case conditions
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 (progn (command-execute cmd)
703
e2780d9a814c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 662
diff changeset
75 (setq last-command this-command)
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 (if (or (prog1 quit-flag (setq quit-flag nil))
3439
13660e63d8f0 (Electric-command-loop): Use eq to compare events.
Richard M. Stallman <rms@gnu.org>
parents: 2540
diff changeset
77 (eq last-input-char ?\C-g))
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1609
diff changeset
78 (progn (setq unread-command-events nil)
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 (if (not inhibit-quit)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 (progn (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 (message "Quit")
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 (throw return-tag nil))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 (ding)))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 (buffer-read-only (if loop-function
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 (setq err conditions)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 (message "Buffer is read-only")
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 (sit-for 2)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 (beginning-of-buffer (if loop-function
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 (setq err conditions)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 (message "Beginning of Buffer")
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 (sit-for 2)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 (end-of-buffer (if loop-function
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 (setq err conditions)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 (message "End of Buffer")
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 (sit-for 2)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 (error (if loop-function
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 (setq err conditions)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102 (message "Error: %s"
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 (if (eq (car conditions) 'error)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 (car (cdr conditions))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 (prin1-to-string conditions)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 (sit-for 2))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 (ding))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 (if loop-function (funcall loop-function loop-state err))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 (ding)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 (throw return-tag nil))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 ;; This function is like pop-to-buffer, sort of.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 ;; The algorithm is
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114 ;; If there is a window displaying buffer
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 ;; Select it
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 ;; Else if there is only one window
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 ;; Split it, selecting the window on the bottom with height being
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 ;; the lesser of max-height (if non-nil) and the number of lines in
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 ;; the buffer to be displayed subject to window-min-height constraint.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 ;; Else
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 ;; Switch to buffer in the current window.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 ;;
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 ;; Then if max-height is nil, and not all of the lines in the buffer
778
cd00bdacc17b *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 703
diff changeset
124 ;; are displayed, grab the whole frame.
35
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 ;;
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 ;; Returns selected window on buffer positioned at point-min.
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 (defun Electric-pop-up-window (buffer &optional max-height)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 (let* ((win (or (get-buffer-window buffer) (selected-window)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 (buf (get-buffer buffer))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 (one-window (one-window-p t))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 (pop-up-windows t)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 (target-height)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 (lines))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 (if (not buf)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 (error "Buffer %s does not exist" buffer)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 (save-excursion
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 (set-buffer buf)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 (setq lines (count-lines (point-min) (point-max)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 (setq target-height
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 (min (max (if max-height (min max-height (1+ lines)) (1+ lines))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 window-min-height)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143 (save-window-excursion
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 (delete-other-windows)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 (1- (window-height (selected-window)))))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 (cond ((and (eq (window-buffer win) buf))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 (select-window win))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 (one-window
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 (goto-char (window-start win))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 (pop-to-buffer buffer)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 (setq win (selected-window))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 (enlarge-window (- target-height (window-height win))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 (t
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 (switch-to-buffer buf)))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155 (if (and (not max-height)
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 (> target-height (window-height (selected-window))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 (progn (goto-char (window-start win))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 (enlarge-window (- target-height (window-height win)))))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159 (goto-char (point-min))
63b375f17a65 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 win)))
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 35
diff changeset
161
662
8a533acedb77 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
162 (provide 'electric)
8a533acedb77 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
163
2229
bd3c525fa6fc Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 1821
diff changeset
164 ;;; electric.el ends here