38414
|
1 ;;; esh-io.el --- I/O management
|
29876
|
2
|
29934
|
3 ;; Copyright (C) 1999, 2000 Free Software Foundation
|
29876
|
4
|
32526
|
5 ;; Author: John Wiegley <johnw@gnu.org>
|
|
6
|
29876
|
7 ;; This file is part of GNU Emacs.
|
|
8
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
12 ;; any later version.
|
|
13
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17 ;; GNU General Public License for more details.
|
|
18
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
23
|
|
24 (provide 'esh-io)
|
|
25
|
|
26 (eval-when-compile (require 'esh-maint))
|
|
27
|
|
28 (defgroup eshell-io nil
|
|
29 "Eshell's I/O management code provides a scheme for treating many
|
|
30 different kinds of objects -- symbols, files, buffers, etc. -- as
|
|
31 though they were files."
|
|
32 :tag "I/O management"
|
|
33 :group 'eshell)
|
|
34
|
|
35 ;;; Commentary:
|
|
36
|
|
37 ;; At the moment, only output redirection is supported in Eshell. To
|
|
38 ;; use input redirection, the following syntax will work, assuming
|
|
39 ;; that the command after the pipe is always an external command:
|
|
40 ;;
|
|
41 ;; cat <file> | <command>
|
|
42 ;;
|
|
43 ;; Otherwise, output redirection and piping are provided in a manner
|
|
44 ;; consistent with most shells. Therefore, only unique features are
|
|
45 ;; mentioned here.
|
|
46 ;;
|
|
47 ;;;_* Insertion
|
|
48 ;;
|
|
49 ;; To insert at the location of point in a buffer, use '>>>':
|
|
50 ;;
|
|
51 ;; echo alpha >>> #<buffer *scratch*>;
|
|
52 ;;
|
|
53 ;;;_* Pseudo-devices
|
|
54 ;;
|
|
55 ;; A few pseudo-devices are provided, since Emacs cannot write
|
|
56 ;; directly to a UNIX device file:
|
|
57 ;;
|
|
58 ;; echo alpha > /dev/null ; the bit bucket
|
|
59 ;; echo alpha > /dev/kill ; set the kill ring
|
|
60 ;; echo alpha >> /dev/clip ; append to the clipboard
|
|
61 ;;
|
|
62 ;;;_* Multiple output targets
|
|
63 ;;
|
|
64 ;; Eshell can write to multiple output targets, including pipes.
|
|
65 ;; Example:
|
|
66 ;;
|
|
67 ;; (+ 1 2) > a > b > c ; prints number to all three files
|
|
68 ;; (+ 1 2) > a | wc ; prints to 'a', and pipes to 'wc'
|
|
69
|
|
70 ;;; User Variables:
|
|
71
|
|
72 (defcustom eshell-io-load-hook '(eshell-io-initialize)
|
|
73 "*A hook that gets run when `eshell-io' is loaded."
|
|
74 :type 'hook
|
|
75 :group 'eshell-io)
|
|
76
|
|
77 (defcustom eshell-number-of-handles 3
|
|
78 "*The number of file handles that eshell supports.
|
|
79 Currently this is standard input, output and error. But even all of
|
|
80 these Emacs does not currently support with asynchronous processes
|
|
81 \(which is what eshell uses so that you can continue doing work in
|
|
82 other buffers) ."
|
|
83 :type 'integer
|
|
84 :group 'eshell-io)
|
|
85
|
|
86 (defcustom eshell-output-handle 1
|
|
87 "*The index of the standard output handle."
|
|
88 :type 'integer
|
|
89 :group 'eshell-io)
|
|
90
|
|
91 (defcustom eshell-error-handle 2
|
|
92 "*The index of the standard error handle."
|
|
93 :type 'integer
|
|
94 :group 'eshell-io)
|
|
95
|
|
96 (defcustom eshell-buffer-shorthand nil
|
|
97 "*If non-nil, a symbol name can be used for a buffer in redirection.
|
|
98 If nil, redirecting to a buffer requires buffer name syntax. If this
|
|
99 variable is set, redirection directly to Lisp symbols will be
|
|
100 impossible.
|
|
101
|
|
102 Example:
|
|
103
|
|
104 echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t
|
|
105 echo hello > #<buffer *scratch*> ; always works"
|
|
106 :type 'boolean
|
|
107 :group 'eshell-io)
|
|
108
|
|
109 (defcustom eshell-print-queue-size 5
|
|
110 "*The size of the print queue, for doing buffered printing.
|
|
111 This is basically a speed enhancement, to avoid blocking the Lisp code
|
|
112 from executing while Emacs is redisplaying."
|
|
113 :type 'integer
|
|
114 :group 'eshell-io)
|
|
115
|
|
116 (defcustom eshell-virtual-targets
|
|
117 '(("/dev/eshell" eshell-interactive-print nil)
|
|
118 ("/dev/kill" (lambda (mode)
|
|
119 (if (eq mode 'overwrite)
|
|
120 (kill-new ""))
|
|
121 'eshell-kill-append) t)
|
|
122 ("/dev/clip" (lambda (mode)
|
|
123 (if (eq mode 'overwrite)
|
|
124 (let ((x-select-enable-clipboard t))
|
|
125 (kill-new "")))
|
|
126 'eshell-clipboard-append) t))
|
|
127 "*Map virtual devices name to Emacs Lisp functions.
|
|
128 If the user specifies any of the filenames above as a redirection
|
|
129 target, the function in the second element will be called.
|
|
130
|
|
131 If the third element is non-nil, the redirection mode is passed as an
|
|
132 argument (which is the symbol `overwrite', `append' or `insert'), and
|
|
133 the function is expected to return another function -- which is the
|
|
134 output function. Otherwise, the second element itself is the output
|
|
135 function.
|
|
136
|
31241
|
137 The output function is then called repeatedly with single strings,
|
|
138 which represents successive pieces of the output of the command, until nil
|
29876
|
139 is passed, meaning EOF.
|
|
140
|
|
141 NOTE: /dev/null is handled specially as a virtual target, and should
|
|
142 not be added to this variable."
|
|
143 :type '(repeat
|
|
144 (list (string :tag "Target")
|
|
145 function
|
|
146 (choice (const :tag "Func returns output-func" t)
|
|
147 (const :tag "Func is output-func" nil))))
|
|
148 :group 'eshell-io)
|
|
149
|
|
150 (put 'eshell-virtual-targets 'risky-local-variable t)
|
|
151
|
|
152 ;;; Internal Variables:
|
|
153
|
|
154 (defvar eshell-current-handles nil)
|
|
155
|
|
156 (defvar eshell-last-command-status 0
|
|
157 "The exit code from the last command. 0 if successful.")
|
|
158
|
|
159 (defvar eshell-last-command-result nil
|
|
160 "The result of the last command. Not related to success.")
|
|
161
|
|
162 (defvar eshell-output-file-buffer nil
|
|
163 "If non-nil, the current buffer is a file output buffer.")
|
|
164
|
|
165 (defvar eshell-print-count)
|
|
166 (defvar eshell-current-redirections)
|
|
167
|
|
168 ;;; Functions:
|
|
169
|
|
170 (defun eshell-io-initialize ()
|
|
171 "Initialize the I/O subsystem code."
|
|
172 (make-local-hook 'eshell-parse-argument-hook)
|
|
173 (add-hook 'eshell-parse-argument-hook
|
|
174 'eshell-parse-redirection nil t)
|
|
175 (make-local-variable 'eshell-current-redirections)
|
|
176 (make-local-hook 'eshell-pre-rewrite-command-hook)
|
|
177 (add-hook 'eshell-pre-rewrite-command-hook
|
|
178 'eshell-strip-redirections nil t)
|
|
179 (make-local-hook 'eshell-post-rewrite-command-hook)
|
|
180 (add-hook 'eshell-post-rewrite-command-hook
|
|
181 'eshell-apply-redirections nil t))
|
|
182
|
|
183 (defun eshell-parse-redirection ()
|
|
184 "Parse an output redirection, such as '2>'."
|
|
185 (if (and (not eshell-current-quoted)
|
|
186 (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
|
|
187 (if eshell-current-argument
|
|
188 (eshell-finish-arg)
|
|
189 (let ((sh (match-string 1))
|
|
190 (oper (match-string 2))
|
|
191 ; (th (match-string 3))
|
|
192 )
|
|
193 (if (string= oper "<")
|
|
194 (error "Eshell does not support input redirection"))
|
|
195 (eshell-finish-arg
|
|
196 (prog1
|
|
197 (list 'eshell-set-output-handle
|
|
198 (or (and sh (string-to-int sh)) 1)
|
|
199 (list 'quote
|
|
200 (aref [overwrite append insert]
|
|
201 (1- (length oper)))))
|
|
202 (goto-char (match-end 0))))))))
|
|
203
|
|
204 (defun eshell-strip-redirections (terms)
|
|
205 "Rewrite any output redirections in TERMS."
|
|
206 (setq eshell-current-redirections (list t))
|
|
207 (let ((tl terms)
|
|
208 (tt (cdr terms)))
|
|
209 (while tt
|
|
210 (if (not (and (consp (car tt))
|
|
211 (eq (caar tt) 'eshell-set-output-handle)))
|
|
212 (setq tt (cdr tt)
|
|
213 tl (cdr tl))
|
|
214 (unless (cdr tt)
|
|
215 (error "Missing redirection target"))
|
|
216 (nconc eshell-current-redirections
|
|
217 (list (list 'ignore
|
|
218 (append (car tt) (list (cadr tt))))))
|
|
219 (setcdr tl (cddr tt))
|
|
220 (setq tt (cddr tt))))
|
|
221 (setq eshell-current-redirections
|
|
222 (cdr eshell-current-redirections))))
|
|
223
|
|
224 (defun eshell-apply-redirections (cmdsym)
|
|
225 "Apply any redirection which were specified for COMMAND."
|
|
226 (if eshell-current-redirections
|
|
227 (set cmdsym
|
|
228 (append (list 'progn)
|
|
229 eshell-current-redirections
|
|
230 (list (symbol-value cmdsym))))))
|
|
231
|
|
232 (defun eshell-create-handles
|
|
233 (standard-output output-mode &optional standard-error error-mode)
|
|
234 "Create a new set of file handles for a command.
|
|
235 The default location for standard output and standard error will go to
|
31241
|
236 STANDARD-OUTPUT and STANDARD-ERROR, respectively.
|
|
237 OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert';
|
|
238 a nil value of mode defaults to `insert'."
|
29876
|
239 (let ((handles (make-vector eshell-number-of-handles nil))
|
|
240 (output-target (eshell-get-target standard-output output-mode))
|
|
241 (error-target (eshell-get-target standard-error error-mode)))
|
|
242 (aset handles eshell-output-handle (cons output-target 1))
|
|
243 (if standard-error
|
|
244 (aset handles eshell-error-handle (cons error-target 1))
|
|
245 (aset handles eshell-error-handle (cons output-target 1)))
|
|
246 handles))
|
|
247
|
|
248 (defun eshell-protect-handles (handles)
|
|
249 "Protect the handles in HANDLES from a being closed."
|
|
250 (let ((idx 0))
|
|
251 (while (< idx eshell-number-of-handles)
|
|
252 (if (aref handles idx)
|
|
253 (setcdr (aref handles idx)
|
|
254 (1+ (cdr (aref handles idx)))))
|
|
255 (setq idx (1+ idx))))
|
|
256 handles)
|
|
257
|
|
258 (defun eshell-close-target (target status)
|
|
259 "Close an output TARGET, passing STATUS as the result.
|
|
260 STATUS should be non-nil on successful termination of the output."
|
|
261 (cond
|
|
262 ((symbolp target) nil)
|
|
263
|
|
264 ;; If we were redirecting to a file, save the file and close the
|
|
265 ;; buffer.
|
|
266 ((markerp target)
|
|
267 (let ((buf (marker-buffer target)))
|
|
268 (when buf ; somebody's already killed it!
|
|
269 (save-current-buffer
|
|
270 (set-buffer buf)
|
|
271 (when eshell-output-file-buffer
|
|
272 (save-buffer)
|
|
273 (when (eq eshell-output-file-buffer t)
|
|
274 (or status (set-buffer-modified-p nil))
|
|
275 (kill-buffer buf)))))))
|
|
276
|
|
277 ;; If we're redirecting to a process (via a pipe, or process
|
|
278 ;; redirection), send it EOF so that it knows we're finished.
|
31241
|
279 ((eshell-processp target)
|
29876
|
280 (if (eq (process-status target) 'run)
|
|
281 (process-send-eof target)))
|
|
282
|
|
283 ;; A plain function redirection needs no additional arguments
|
|
284 ;; passed.
|
|
285 ((functionp target)
|
|
286 (funcall target status))
|
|
287
|
|
288 ;; But a more complicated function redirection (which can only
|
|
289 ;; happen with aliases at the moment) has arguments that need to be
|
|
290 ;; passed along with it.
|
|
291 ((consp target)
|
|
292 (apply (car target) status (cdr target)))))
|
|
293
|
|
294 (defun eshell-close-handles (exit-code &optional result handles)
|
|
295 "Close all of the current handles, taking refcounts into account.
|
|
296 EXIT-CODE is the process exit code; mainly, it is zero, if the command
|
|
297 completed successfully. RESULT is the quoted value of the last
|
|
298 command. If nil, then the meta variables for keeping track of the
|
|
299 last execution result should not be changed."
|
|
300 (let ((idx 0))
|
|
301 (assert (or (not result) (eq (car result) 'quote)))
|
|
302 (setq eshell-last-command-status exit-code
|
|
303 eshell-last-command-result (cadr result))
|
|
304 (while (< idx eshell-number-of-handles)
|
|
305 (let ((handles (or handles eshell-current-handles)))
|
|
306 (when (aref handles idx)
|
|
307 (setcdr (aref handles idx)
|
|
308 (1- (cdr (aref handles idx))))
|
|
309 (when (= (cdr (aref handles idx)) 0)
|
|
310 (let ((target (car (aref handles idx))))
|
|
311 (if (not (listp target))
|
|
312 (eshell-close-target target (= exit-code 0))
|
|
313 (while target
|
|
314 (eshell-close-target (car target) (= exit-code 0))
|
|
315 (setq target (cdr target)))))
|
|
316 (setcar (aref handles idx) nil))))
|
|
317 (setq idx (1+ idx)))
|
|
318 nil))
|
|
319
|
|
320 (defun eshell-kill-append (string)
|
|
321 "Call `kill-append' with STRING, if it is indeed a string."
|
|
322 (if (stringp string)
|
|
323 (kill-append string nil)))
|
|
324
|
|
325 (defun eshell-clipboard-append (string)
|
|
326 "Call `kill-append' with STRING, if it is indeed a string."
|
|
327 (if (stringp string)
|
|
328 (let ((x-select-enable-clipboard t))
|
|
329 (kill-append string nil))))
|
|
330
|
|
331 (defun eshell-get-target (target &optional mode)
|
|
332 "Convert TARGET, which is a raw argument, into a valid output target.
|
31241
|
333 MODE is either `overwrite', `append' or `insert'; if it is omitted or nil,
|
|
334 it defaults to `insert'."
|
29876
|
335 (setq mode (or mode 'insert))
|
|
336 (cond
|
|
337 ((stringp target)
|
|
338 (let ((redir (assoc target eshell-virtual-targets)))
|
|
339 (if redir
|
|
340 (if (nth 2 redir)
|
|
341 (funcall (nth 1 redir) mode)
|
|
342 (nth 1 redir))
|
|
343 (let* ((exists (get-file-buffer target))
|
|
344 (buf (find-file-noselect target t)))
|
|
345 (with-current-buffer buf
|
|
346 (if buffer-read-only
|
|
347 (error "Cannot write to read-only file `%s'" target))
|
|
348 (set (make-local-variable 'eshell-output-file-buffer)
|
|
349 (if (eq exists buf) 0 t))
|
|
350 (cond ((eq mode 'overwrite)
|
|
351 (erase-buffer))
|
|
352 ((eq mode 'append)
|
|
353 (goto-char (point-max))))
|
|
354 (point-marker))))))
|
|
355 ((or (bufferp target)
|
|
356 (and (boundp 'eshell-buffer-shorthand)
|
|
357 (symbol-value 'eshell-buffer-shorthand)
|
|
358 (symbolp target)))
|
|
359 (let ((buf (if (bufferp target)
|
|
360 target
|
|
361 (get-buffer-create
|
|
362 (symbol-name target)))))
|
|
363 (with-current-buffer buf
|
|
364 (cond ((eq mode 'overwrite)
|
|
365 (erase-buffer))
|
|
366 ((eq mode 'append)
|
|
367 (goto-char (point-max))))
|
|
368 (point-marker))))
|
|
369 ((functionp target)
|
|
370 nil)
|
|
371 ((symbolp target)
|
|
372 (if (eq mode 'overwrite)
|
|
373 (set target nil))
|
|
374 target)
|
31241
|
375 ((or (eshell-processp target)
|
29876
|
376 (markerp target))
|
|
377 target)
|
|
378 (t
|
|
379 (error "Illegal redirection target: %s"
|
|
380 (eshell-stringify target)))))
|
|
381
|
|
382 (eval-when-compile
|
|
383 (defvar grep-null-device))
|
|
384
|
|
385 (defun eshell-set-output-handle (index mode &optional target)
|
|
386 "Set handle INDEX, using MODE, to point to TARGET."
|
|
387 (when target
|
|
388 (if (and (stringp target)
|
|
389 (or (cond
|
|
390 ((boundp 'null-device)
|
|
391 (string= target null-device))
|
|
392 ((boundp 'grep-null-device)
|
|
393 (string= target grep-null-device))
|
|
394 (t nil))
|
|
395 (string= target "/dev/null")))
|
|
396 (aset eshell-current-handles index nil)
|
|
397 (let ((where (eshell-get-target target mode))
|
|
398 (current (car (aref eshell-current-handles index))))
|
|
399 (if (and (listp current)
|
|
400 (not (member where current)))
|
|
401 (setq current (append current (list where)))
|
31241
|
402 (setq current where))
|
29876
|
403 (if (not (aref eshell-current-handles index))
|
|
404 (aset eshell-current-handles index (cons nil 1)))
|
|
405 (setcar (aref eshell-current-handles index) current)))))
|
|
406
|
|
407 (defun eshell-interactive-output-p ()
|
|
408 "Return non-nil if current handles are bound for interactive display."
|
|
409 (and (eq (car (aref eshell-current-handles
|
|
410 eshell-output-handle)) t)
|
|
411 (eq (car (aref eshell-current-handles
|
|
412 eshell-error-handle)) t)))
|
|
413
|
|
414 (defvar eshell-print-queue nil)
|
|
415 (defvar eshell-print-queue-count -1)
|
|
416
|
|
417 (defun eshell-flush (&optional reset-p)
|
|
418 "Flush out any lines that have been queued for printing.
|
|
419 Must be called before printing begins with -1 as its argument, and
|
|
420 after all printing is over with no argument."
|
|
421 (ignore
|
|
422 (if reset-p
|
|
423 (setq eshell-print-queue nil
|
|
424 eshell-print-queue-count reset-p)
|
|
425 (if eshell-print-queue
|
|
426 (eshell-print eshell-print-queue))
|
|
427 (eshell-flush 0))))
|
|
428
|
|
429 (defun eshell-init-print-buffer ()
|
|
430 "Initialize the buffered printing queue."
|
|
431 (eshell-flush -1))
|
|
432
|
|
433 (defun eshell-buffered-print (&rest strings)
|
|
434 "A buffered print -- *for strings only*."
|
|
435 (if (< eshell-print-queue-count 0)
|
|
436 (progn
|
|
437 (eshell-print (apply 'concat strings))
|
|
438 (setq eshell-print-queue-count 0))
|
|
439 (if (= eshell-print-queue-count eshell-print-queue-size)
|
|
440 (eshell-flush))
|
|
441 (setq eshell-print-queue
|
|
442 (concat eshell-print-queue (apply 'concat strings))
|
|
443 eshell-print-queue-count (1+ eshell-print-queue-count))))
|
|
444
|
|
445 (defsubst eshell-print (object)
|
31241
|
446 "Output OBJECT to the standard output handle."
|
29876
|
447 (eshell-output-object object eshell-output-handle))
|
|
448
|
|
449 (defsubst eshell-error (object)
|
31241
|
450 "Output OBJECT to the standard error handle."
|
29876
|
451 (eshell-output-object object eshell-error-handle))
|
|
452
|
|
453 (defsubst eshell-errorn (object)
|
31241
|
454 "Output OBJECT followed by a newline to the standard error handle."
|
29876
|
455 (eshell-error object)
|
|
456 (eshell-error "\n"))
|
|
457
|
|
458 (defsubst eshell-printn (object)
|
31241
|
459 "Output OBJECT followed by a newline to the standard output handle."
|
29876
|
460 (eshell-print object)
|
|
461 (eshell-print "\n"))
|
|
462
|
|
463 (defun eshell-output-object-to-target (object target)
|
|
464 "Insert OBJECT into TARGET.
|
|
465 Returns what was actually sent, or nil if nothing was sent."
|
|
466 (cond
|
|
467 ((functionp target)
|
|
468 (funcall target object))
|
|
469
|
|
470 ((symbolp target)
|
|
471 (if (eq target t) ; means "print to display"
|
|
472 (eshell-output-filter nil (eshell-stringify object))
|
|
473 (if (not (symbol-value target))
|
|
474 (set target object)
|
|
475 (setq object (eshell-stringify object))
|
|
476 (if (not (stringp (symbol-value target)))
|
|
477 (set target (eshell-stringify
|
|
478 (symbol-value target))))
|
|
479 (set target (concat (symbol-value target) object)))))
|
|
480
|
|
481 ((markerp target)
|
|
482 (if (buffer-live-p (marker-buffer target))
|
|
483 (with-current-buffer (marker-buffer target)
|
|
484 (let ((moving (= (point) target)))
|
|
485 (save-excursion
|
|
486 (goto-char target)
|
|
487 (setq object (eshell-stringify object))
|
|
488 (insert-and-inherit object)
|
|
489 (set-marker target (point-marker)))
|
|
490 (if moving
|
|
491 (goto-char target))))))
|
|
492
|
31241
|
493 ((eshell-processp target)
|
29876
|
494 (when (eq (process-status target) 'run)
|
|
495 (setq object (eshell-stringify object))
|
|
496 (process-send-string target object)))
|
|
497
|
|
498 ((consp target)
|
|
499 (apply (car target) object (cdr target))))
|
|
500 object)
|
|
501
|
|
502 (defun eshell-output-object (object &optional handle-index handles)
|
|
503 "Insert OBJECT, using HANDLE-INDEX specifically)."
|
|
504 (let ((target (car (aref (or handles eshell-current-handles)
|
|
505 (or handle-index eshell-output-handle)))))
|
|
506 (if (and target (not (listp target)))
|
|
507 (eshell-output-object-to-target object target)
|
|
508 (while target
|
|
509 (eshell-output-object-to-target object (car target))
|
|
510 (setq target (cdr target))))))
|
|
511
|
|
512 ;;; Code:
|
|
513
|
|
514 ;;; esh-io.el ends here
|