annotate lisp/process.el @ 622:11502791fc1c

[xemacs-hg @ 2001-06-22 01:49:57 by ben] dired-msw.c: Fix problem noted by Michael Sperber with directories containing [] and code that destructively modifies an existing string. term\AT386.el: Fix warnings. term\apollo.el: Removed. Kill kill kill. Sync with FSF and remove most crap. term\linux.el: Removed. Sync with FSF. Don't define most defns, because they are automatically defined by termcap. But do add defns for keys that normally get defined as f13, f14, etc. and really ought to be shift-f3, shift-f4, etc. (NOTE: I did this based on Cygwin, which emulates the Linux console. I would appreciate it if someone on Linux could verify.) term\cygwin.el: New. Load term/linux. term\lk201.el, term\news.el, term\vt100.el: Sync with FSF. Fix warnings. dialog-gtk.el: Fix warning. For 21.4: help.el, update-elc.el: Compile in proper order. Maybe for 21.4: keydefs.el: Add a defn for M-?, previously undefined, to access help -- in case the terminal is not set up right, or f1 gets redefined. README: Rewrite.
author ben
date Fri, 22 Jun 2001 01:50:04 +0000
parents 38db05db9cb5
children 943eaba38521
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; process.el --- commands for subprocesses; split out of simple.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4 ;; Copyright (C) 1995, 2000 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: Ben Wing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: internal, processes, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: FSF 19.30.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
29 ;;; Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 ;; Created 1995 by Ben Wing during Mule work -- some commands split out
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 ;; of simple.el and wrappers of *-internal functions created so they could
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
33 ;; be redefined in a Mule world.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
34 ;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 (defgroup processes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 "Process, subshell, compilation, and job control support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 :group 'external
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (defgroup processes-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 "Basic stuff dealing with processes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 :group 'processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (defgroup execute nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 "Executing external commands."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 :group 'processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
56 ;; This may be changed to "/c" in win32-native.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (defvar shell-command-switch "-c"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 "Switch used to have the shell execute its command line argument.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (defun start-process-shell-command (name buffer &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 "Start a program in a subprocess. Return the process object for it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 NAME is name for process. It is modified if necessary to make it unique.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 BUFFER is the buffer or (buffer-name) to associate with the process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Process output goes at end of that buffer, unless you specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 an output stream or filter function to handle the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 BUFFER may be also nil, meaning that this process is not associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 with any buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Third arg is command name, the name of a shell command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Remaining arguments are the arguments for the command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Wildcards and redirection are handled as usual in the shell."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; We used to use `exec' to replace the shell with the command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; but that failed to handle (...) and semicolon, etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (start-process name buffer shell-file-name shell-command-switch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (mapconcat #'identity args " ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
78 (defun call-process-internal (program &optional infile buffer display &rest args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
79 "Call PROGRAM synchronously in separate process, with coding-system specified.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
80 Arguments are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
81 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
82 The program's input comes from file INFILE (nil means `/dev/null').
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
83 Insert output in BUFFER before point; t means current buffer;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
84 nil for BUFFER means discard it; 0 means discard and don't wait.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
85 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
86 REAL-BUFFER says what to do with standard output, as above,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
87 while STDERR-FILE says what to do with standard error in the child.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
88 STDERR-FILE may be nil (discard standard error output),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
89 t (mix it with ordinary output), or a file name string.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
90
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
91 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
92 Remaining arguments are strings passed as command arguments to PROGRAM.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
93
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
94 If BUFFER is 0, `call-process' returns immediately with value nil.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
95 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
96 or a signal description string.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
97 If you quit, the process is killed with SIGINT, or SIGKILL if you
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
98 quit again."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
99 ;; #### remove windows-nt check when this is ready for prime time.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
100 (if (or (noninteractive) (not (eq 'windows-nt system-type)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
101 (apply 'old-call-process-internal program infile buffer display args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
102 (let (proc inbuf errbuf discard)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
103 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
104 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
105 (when infile
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
106 (setq infile (expand-file-name infile))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
107 (setq inbuf (generate-new-buffer "*call-process*"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
108 (with-current-buffer inbuf
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
109 ;; Make sure this works with jka-compr
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
110 (let ((file-name-handler-alist nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
111 (insert-file-contents-internal infile nil nil nil nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
112 'binary))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
113 (let ((stderr (if (consp buffer) (second buffer) t)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
114 (if (consp buffer) (setq buffer (car buffer)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
115 (setq buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
116 (cond ((null buffer) nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
117 ((eq buffer t) (current-buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
118 ;; use integerp for compatibility with existing
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
119 ;; call-process rmsism.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
120 ((integerp buffer) (setq discard t) nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121 (t (get-buffer-create buffer))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
122 (when (and stderr (not (eq t stderr)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
123 (setq stderr (expand-file-name stderr))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
124 (setq errbuf (generate-new-buffer "*call-process*")))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 (setq proc
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
126 (apply 'start-process-internal "*call-process*"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
127 buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
128 ;#### not implemented until my new process
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 ;changes go in.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 ;(if (eq t stderr) buffer (list buffer errbuf))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 program args))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 (if buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
133 (set-marker (process-mark proc) (point buffer) buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 (prog1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 (catch 'call-process-done
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 (when (not discard)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 (set-process-sentinel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
139 proc
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
140 #'(lambda (proc status)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
141 (cond ((eq 'exit (process-status proc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142 (set-process-sentinel proc nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
143 (throw 'call-process-done
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
144 (process-exit-status proc)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
145 ((eq 'signal (process-status proc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
146 (set-process-sentinel proc nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
147 (throw 'call-process-done status))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
148 (when inbuf
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
149 (process-send-region proc 1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
150 (1+ (buffer-size inbuf)) inbuf))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
151 (process-send-eof proc)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
152 (when discard
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
153 ;; we're trying really really hard to emulate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
154 ;; the old call-process.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
155 (if errbuf
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
156 (set-process-sentinel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
157 proc
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
158 `(lambda (proc status)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
159 (write-region-internal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
160 1 (1+ (buffer-size))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
161 ,stderr
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
162 nil 'major-rms-kludge-city nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
163 coding-system-for-write))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 (setq errbuf nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
165 (setq proc nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
166 (throw 'call-process-done nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 (while t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
168 (accept-process-output proc)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
169 (if display (sit-for 0))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
170 (when errbuf
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
171 (with-current-buffer errbuf
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
172 (write-region-internal 1 (1+ (buffer-size)) stderr
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
173 nil 'major-rms-kludge-city nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
174 coding-system-for-write))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
175 (if proc (set-process-sentinel proc nil)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
176 (if inbuf (kill-buffer inbuf))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 (if errbuf (kill-buffer errbuf))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
178 (condition-case nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
179 (if (and proc (process-live-p proc)) (kill-process proc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
180 (error nil))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
181
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (defun call-process (program &optional infile buffer displayp &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 "Call PROGRAM synchronously in separate process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 The program's input comes from file INFILE (nil means `/dev/null').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Insert output in BUFFER before point; t means current buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 nil for BUFFER means discard it; 0 means discard and don't wait.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 REAL-BUFFER says what to do with standard output, as above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 while STDERR-FILE says what to do with standard error in the child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 STDERR-FILE may be nil (discard standard error output),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 t (mix it with ordinary output), or a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Remaining arguments are strings passed as command arguments to PROGRAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 If BUFFER is 0, `call-process' returns immediately with value nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 or a signal description string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 If you quit, the process is killed with SIGINT, or SIGKILL if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 quit again."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (apply 'call-process-internal program infile buffer displayp args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (defun call-process-region (start end program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 &optional deletep buffer displayp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 "Send text from START to END to a synchronous process running PROGRAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Delete the text if fourth arg DELETEP is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Insert output in BUFFER before point; t means current buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 nil for BUFFER means discard it; 0 means discard and don't wait.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 REAL-BUFFER says what to do with standard output, as above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 while STDERR-FILE says what to do with standard error in the child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 STDERR-FILE may be nil (discard standard error output),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 t (mix it with ordinary output), or a file name string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Remaining args are passed to PROGRAM at startup as command args.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 If BUFFER is 0, returns immediately with value nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Otherwise waits for PROGRAM to terminate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 and returns a numeric exit status or a signal description string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 If you quit, the process is first killed with SIGINT, then with SIGKILL if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 you quit again before the process exits."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (let ((temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (make-temp-name
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
227 (concat (file-name-as-directory (temp-directory)) "emacs"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (progn
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
230 (write-region start end temp nil 'silent)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (if deletep (delete-region start end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (apply #'call-process program temp buffer displayp args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (ignore-file-errors (delete-file temp)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (defun shell-command (command &optional output-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 "Execute string COMMAND in inferior shell; display output, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 If COMMAND ends in ampersand, execute it asynchronously.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 The output appears in the buffer `*Async Shell Command*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 That buffer is in shell mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Otherwise, COMMAND is executed synchronously. The output appears in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 buffer `*Shell Command Output*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 If the output is one line, it is displayed in the echo area *as well*,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 but it is nonetheless available in buffer `*Shell Command Output*',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 even though that buffer is not automatically displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 If there is no output, or if output is inserted in the current buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 then `*Shell Command Output*' is deleted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 The optional second argument OUTPUT-BUFFER, if non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 says to put the output in some other buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 If OUTPUT-BUFFER is not a buffer and not nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 insert output in current buffer. (This cannot be done asynchronously.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 In either case, the output is inserted after point (leaving mark after it)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (interactive (list (read-shell-command "Shell command: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (if (and output-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (not (or (bufferp output-buffer) (stringp output-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (progn (barf-if-buffer-read-only)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
262 (push-mark nil (not (interactive-p)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 ;; We do not use -f for csh; we will not support broken use of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 ;; .cshrcs. Even the BSD csh manual says to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 ;; "if ($?prompt) exit" before things which are not useful
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 ;; non-interactively. Besides, if someone wants their other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 ;; aliases for shell commands then they can still have them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (call-process shell-file-name nil t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 shell-command-switch command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (exchange-point-and-mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; Preserve the match data in case called from a program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (if (string-match "[ \t]*&[ \t]*$" command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 ;; Command ending with ampersand means asynchronous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (background (substring command 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (shell-command-on-region (point) (point) command output-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 ;; We have a sentinel to prevent insertion of a termination message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 ;; in the buffer itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (defun shell-command-sentinel (process signal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (if (memq (process-status process) '(exit signal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (message "%s: %s."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (car (cdr (cdr (process-command process))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (substring signal 0 -1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (defun shell-command-on-region (start end command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 &optional output-buffer replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 "Execute string COMMAND in inferior shell with region as input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 Normally display output (if any) in temp buffer `*Shell Command Output*';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Prefix arg means replace the region with it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 If REPLACE is non-nil, that means insert the output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 in place of text from START to END, putting point and mark around it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 If the output is one line, it is displayed in the echo area,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 but it is nonetheless available in buffer `*Shell Command Output*'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 even though that buffer is not automatically displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 If there is no output, or if output is inserted in the current buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 then `*Shell Command Output*' is deleted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 If the optional fourth argument OUTPUT-BUFFER is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 that says to put the output in some other buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 If OUTPUT-BUFFER is not a buffer and not nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 insert output in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 In either case, the output is inserted after point (leaving mark after it)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (interactive (let ((string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ;; Do this before calling region-beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 ;; and region-end, in case subprocess output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ;; relocates them while we are in the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (read-shell-command "Shell command on region: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 ;; call-interactively recognizes region-beginning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 ;; region-end specially, leaving them in the history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (list (region-beginning) (region-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 current-prefix-arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (if (or replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (and output-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (not (or (bufferp output-buffer) (stringp output-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 ;; Replace specified region with output from command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (let ((swap (and replace (< start end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ;; Don't muck with mark unless REPLACE says we should.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (and replace (push-mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (call-process-region start end shell-file-name t t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 shell-command-switch command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (and shell-buffer (not (eq shell-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (kill-buffer shell-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 ;; Don't muck with mark unless REPLACE says we should.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (and replace swap (exchange-point-and-mark t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 ;; No prefix argument: put the output in a temp buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 ;; replacing its entire contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (let ((buffer (get-buffer-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (or output-buffer "*Shell Command Output*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (success nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (exit-status nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (directory default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (if (eq buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;; If the input is the same buffer as the output,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;; delete everything but the specified region,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; then replace that region with the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (progn (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (delete-region (max start end) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (delete-region (point-min) (max start end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (setq exit-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (call-process-region (point-min) (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 shell-file-name t t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 shell-command-switch command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (setq success t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 ;; Clear the output buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; then run the command with output there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (setq default-directory directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (erase-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (setq exit-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (call-process-region start end shell-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 nil buffer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 shell-command-switch command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (setq success t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ;; Report the amount of output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (let ((lines (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (if (= (buffer-size) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (count-lines (point-min) (point-max))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (cond ((= lines 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (if success
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 'command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (if (eql exit-status 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 "(Shell command succeeded with no output)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 "(Shell command failed with no output)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (kill-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ((and success (= lines 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (message "%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (progn (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (set-window-start (display-buffer buffer) 1))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (defun start-process (name buffer program &rest program-args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 "Start a program in a subprocess. Return the process object for it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 NAME is name for process. It is modified if necessary to make it unique.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 BUFFER is the buffer or (buffer-name) to associate with the process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 Process output goes at end of that buffer, unless you specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 an output stream or filter function to handle the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 BUFFER may be also nil, meaning that this process is not associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 with any buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 Third arg is program file name. It is searched for as in the shell.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 Remaining arguments are strings to give program as arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (apply 'start-process-internal name buffer program program-args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (defun open-network-stream (name buffer host service &optional protocol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 "Open a TCP connection for a service to a host.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
409 Returns a process object to represent the connection.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 Input and output work as for subprocesses; `delete-process' closes it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 Args are NAME BUFFER HOST SERVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 NAME is name for process. It is modified if necessary to make it unique.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 BUFFER is the buffer (or buffer-name) to associate with the process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 Process output goes at end of that buffer, unless you specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 an output stream or filter function to handle the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 BUFFER may be also nil, meaning that this process is not associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 with any buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 Third arg is name of the host to connect to, or its IP address.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 Fourth arg SERVICE is name of the service desired, or an integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 specifying a port number to connect to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 supported. When omitted, 'tcp is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
425 Output via `process-send-string' and input via buffer or filter (see
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 `set-process-filter') are stream-oriented. That means UDP datagrams are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 not guaranteed to be sent and received in discrete packets. (But small
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 datagrams around 500 bytes that are not truncated by `process-send-string'
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
429 are usually fine.) Note further that UDP protocol does not guard against
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 lost packets."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (open-network-stream-internal name buffer host service protocol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (defun shell-quote-argument (argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 "Quote an argument for passing as argument to an inferior shell."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
435 (if (and (eq system-type 'windows-nt)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
436 (let ((progname (downcase (file-name-nondirectory
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
437 shell-file-name))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
438 (or (equal progname "command.com")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
439 (equal progname "cmd.exe"))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
440 ;; the expectation is that you can take the result of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
441 ;; shell-quote-argument and pass it to as an arg to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 ;; (start-process shell-quote-argument ...) and have it end
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
443 ;; up as-is in the program's argv[] array. to do this, we
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444 ;; need to protect against both the shell's and the program's
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 ;; quoting conventions (and our own conventions in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
446 ;; mswindows-construct-process-command-line!). Putting quotes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 ;; around shell metachars gets through the last two, and applying
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 ;; the normal VC runtime quoting works with practically all apps.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 (mswindows-quote-one-vc-runtime-arg argument t)
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
450 (if (equal argument "")
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
451 "\"\""
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
452 ;; Quote everything except POSIX filename characters.
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
453 ;; This should be safe enough even for really weird shells.
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
454 (let ((result "") (start 0) end)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
455 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
456 (setq end (match-beginning 0)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
457 result (concat result (substring argument start end)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
458 "\\" (substring argument end (1+ end)))
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
459 start (1+ end)))
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
460 (concat result (substring argument start))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
462 (defun shell-command-to-string (command)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
463 "Execute shell command COMMAND and return its output as a string."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (with-output-to-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (call-process shell-file-name nil t nil shell-command-switch command)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
467 (defalias 'exec-to-string 'shell-command-to-string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 ;;; process.el ends here