Mercurial > emacs
annotate lisp/electric.el @ 24419:30e478cd167e
(shell-command-default-error-buffer): Renamed from
shell-command-on-region-default-error-buffer.
(shell-command-on-region): Mention in echo area when there
is some error output. Mention success or failure, too.
Accumulate multiple error outputs
going forward, with formfeed in between. Display the error buffer
when we have put something in it.
(shell-command): Add the ERROR-BUFFER argument feature.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 01 Mar 1999 03:19:32 +0000 |
parents | 7e8ee35d0fb9 |
children | 253f761ad37b |
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 |
13260
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc. |
845 | 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 | 9 ;; This file is part of GNU Emacs. |
10 | |
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 | |
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 | 14 ;; any later version. |
15 | |
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. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
14169 | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
35 | 25 |
2229
bd3c525fa6fc
Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1821
diff
changeset
|
26 ;;; Commentary: |
35 | 27 |
584 | 28 ; zaaaaaaap |
35 | 29 |
2229
bd3c525fa6fc
Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1821
diff
changeset
|
30 ;;; Code: |
bd3c525fa6fc
Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1821
diff
changeset
|
31 |
35 | 32 ;; This loop is the guts for non-standard modes which retain control |
13260
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
33 ;; until some event occurs. It is a `do-forever', the only way out is |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
34 ;; to throw. It assumes that you have set up the keymap, window, and |
35 | 35 ;; everything else: all it does is read commands and execute them - |
36 ;; providing error messages should one occur (if there is no loop | |
37 ;; function - which see). The required argument is a tag which should | |
13260
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
38 ;; expect a value of nil if the user decides to punt. The second |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
39 ;; argument is the prompt to be used: if nil, use "->", if 'noprompt, |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
40 ;; don't use a prompt, if a string, use that string as prompt, and if |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
41 ;; a function of no variable, it will be evaluated in every iteration |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
42 ;; of the loop and its return value, which can be nil, 'noprompt or a |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
43 ;; string, will be used as prompt. Given third argument non-nil, it |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
44 ;; INHIBITS quitting unless the user types C-g at toplevel. This is |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
45 ;; so user can do things like C-u C-g and not get thrown out. Fourth |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
46 ;; argument, if non-nil, should be a function of two arguments which |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
47 ;; is called after every command is executed. The fifth argument, if |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
48 ;; provided, is the state variable for the function. If the |
35 | 49 ;; loop-function gets an error, the loop will abort WITHOUT throwing |
50 ;; (moral: use unwind-protect around call to this function for any | |
51 ;; critical stuff). The second argument for the loop function is the | |
52 ;; conditions for any error that occurred or nil if none. | |
53 | |
54 (defun Electric-command-loop (return-tag | |
55 &optional prompt inhibit-quit | |
56 loop-function loop-state) | |
13260
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
57 |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
58 (let (cmd |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
59 (err nil) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
60 (prompt-string prompt)) |
35 | 61 (while t |
13260
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
62 (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt))) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
63 (setq prompt-string (funcall prompt))) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
64 (if (not (stringp prompt-string)) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
65 (if (eq prompt-string 'noprompt) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
66 (setq prompt-string nil) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
67 (setq prompt-string "->"))) |
a10616f0ad17
(Electric-command-loop): Don't display a prompt
Richard M. Stallman <rms@gnu.org>
parents:
3439
diff
changeset
|
68 (setq cmd (read-key-sequence prompt-string)) |
35 | 69 (setq last-command-char (aref cmd (1- (length cmd))) |
14941
7e8ee35d0fb9
(Electric-command-loop): Set universal-argument-other-key to 0.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
70 this-command (key-binding cmd t) |
35 | 71 cmd this-command) |
14941
7e8ee35d0fb9
(Electric-command-loop): Set universal-argument-other-key to 0.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
72 ;; This makes universal-argument-other-key work. |
7e8ee35d0fb9
(Electric-command-loop): Set universal-argument-other-key to 0.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
73 (setq universal-argument-num-events 0) |
35 | 74 (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
|
75 (eq last-input-char ?\C-g)) |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1609
diff
changeset
|
76 (progn (setq unread-command-events nil |
35 | 77 prefix-arg nil) |
78 ;; If it wasn't cancelling a prefix character, then quit. | |
79 (if (or (= (length (this-command-keys)) 1) | |
80 (not inhibit-quit)) ; safety | |
81 (progn (ding) | |
82 (message "Quit") | |
83 (throw return-tag nil)) | |
84 (setq cmd nil)))) | |
85 (setq current-prefix-arg prefix-arg) | |
86 (if cmd | |
87 (condition-case conditions | |
88 (progn (command-execute cmd) | |
703
e2780d9a814c
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
89 (setq last-command this-command) |
35 | 90 (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
|
91 (eq last-input-char ?\C-g)) |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1609
diff
changeset
|
92 (progn (setq unread-command-events nil) |
35 | 93 (if (not inhibit-quit) |
94 (progn (ding) | |
95 (message "Quit") | |
96 (throw return-tag nil)) | |
97 (ding))))) | |
98 (buffer-read-only (if loop-function | |
99 (setq err conditions) | |
100 (ding) | |
101 (message "Buffer is read-only") | |
102 (sit-for 2))) | |
103 (beginning-of-buffer (if loop-function | |
104 (setq err conditions) | |
105 (ding) | |
106 (message "Beginning of Buffer") | |
107 (sit-for 2))) | |
108 (end-of-buffer (if loop-function | |
109 (setq err conditions) | |
110 (ding) | |
111 (message "End of Buffer") | |
112 (sit-for 2))) | |
113 (error (if loop-function | |
114 (setq err conditions) | |
115 (ding) | |
116 (message "Error: %s" | |
117 (if (eq (car conditions) 'error) | |
118 (car (cdr conditions)) | |
119 (prin1-to-string conditions))) | |
120 (sit-for 2)))) | |
121 (ding)) | |
122 (if loop-function (funcall loop-function loop-state err)))) | |
123 (ding) | |
124 (throw return-tag nil)) | |
125 | |
126 ;; This function is like pop-to-buffer, sort of. | |
127 ;; The algorithm is | |
128 ;; If there is a window displaying buffer | |
129 ;; Select it | |
130 ;; Else if there is only one window | |
131 ;; Split it, selecting the window on the bottom with height being | |
132 ;; the lesser of max-height (if non-nil) and the number of lines in | |
133 ;; the buffer to be displayed subject to window-min-height constraint. | |
134 ;; Else | |
135 ;; Switch to buffer in the current window. | |
136 ;; | |
137 ;; Then if max-height is nil, and not all of the lines in the buffer | |
778 | 138 ;; are displayed, grab the whole frame. |
35 | 139 ;; |
140 ;; Returns selected window on buffer positioned at point-min. | |
141 | |
142 (defun Electric-pop-up-window (buffer &optional max-height) | |
143 (let* ((win (or (get-buffer-window buffer) (selected-window))) | |
144 (buf (get-buffer buffer)) | |
145 (one-window (one-window-p t)) | |
146 (pop-up-windows t) | |
147 (target-height) | |
148 (lines)) | |
149 (if (not buf) | |
150 (error "Buffer %s does not exist" buffer) | |
151 (save-excursion | |
152 (set-buffer buf) | |
153 (setq lines (count-lines (point-min) (point-max))) | |
154 (setq target-height | |
155 (min (max (if max-height (min max-height (1+ lines)) (1+ lines)) | |
156 window-min-height) | |
157 (save-window-excursion | |
158 (delete-other-windows) | |
159 (1- (window-height (selected-window))))))) | |
160 (cond ((and (eq (window-buffer win) buf)) | |
161 (select-window win)) | |
162 (one-window | |
163 (goto-char (window-start win)) | |
164 (pop-to-buffer buffer) | |
165 (setq win (selected-window)) | |
166 (enlarge-window (- target-height (window-height win)))) | |
167 (t | |
168 (switch-to-buffer buf))) | |
169 (if (and (not max-height) | |
170 (> target-height (window-height (selected-window)))) | |
171 (progn (goto-char (window-start win)) | |
172 (enlarge-window (- target-height (window-height win))))) | |
173 (goto-char (point-min)) | |
174 win))) | |
584 | 175 |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
176 (provide 'electric) |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
177 |
2229
bd3c525fa6fc
Added standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1821
diff
changeset
|
178 ;;; electric.el ends here |