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