Mercurial > hg > xemacs-beta
annotate lisp/process.el @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 05 Aug 2013 10:05:32 +0100 |
| parents | f6af091ac654 |
| children | bbe4146603db |
| rev | line source |
|---|---|
| 428 | 1 ;;; process.el --- commands for subprocesses; split out of simple.el |
| 2 | |
|
5687
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
3 ;; Copyright (C) 1985-7, 1993,4, 1997, 2011, 2012 Free Software Foundation, Inc. |
| 853 | 4 ;; Copyright (C) 1995, 2000, 2001, 2002 Ben Wing. |
| 428 | 5 |
| 6 ;; Author: Ben Wing | |
| 7 ;; Maintainer: XEmacs Development Team | |
| 8 ;; Keywords: internal, processes, dumped | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4611
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 771 | 25 ;;; Synched up with: FSF 19.30, except for setenv/getenv (synched with FSF |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
26 ;;; 21.2.1). |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
27 ;;; shell-command and shell-command-on-region synced with FSF 23.3.1. |
| 428 | 28 |
| 442 | 29 ;;; Authorship: |
| 30 | |
| 31 ;; Created 1995 by Ben Wing during Mule work -- some commands split out | |
| 32 ;; of simple.el and wrappers of *-internal functions created so they could | |
| 33 ;; be redefined in a Mule world. | |
| 34 ;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing. | |
| 35 | |
| 428 | 36 ;;; Commentary: |
| 37 | |
| 38 ;; This file is dumped with XEmacs. | |
| 39 | |
| 40 ;;; Code: | |
| 41 | |
| 42 | |
| 43 (defgroup processes nil | |
| 44 "Process, subshell, compilation, and job control support." | |
| 45 :group 'external | |
| 46 :group 'development) | |
| 47 | |
| 48 (defgroup processes-basics nil | |
| 49 "Basic stuff dealing with processes." | |
| 50 :group 'processes) | |
| 51 | |
| 52 (defgroup execute nil | |
| 53 "Executing external commands." | |
| 54 :group 'processes) | |
| 55 | |
| 611 | 56 ;; This may be changed to "/c" in win32-native.el. |
| 428 | 57 |
| 58 (defvar shell-command-switch "-c" | |
| 59 "Switch used to have the shell execute its command line argument.") | |
| 60 | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
61 (defvar shell-command-default-error-buffer nil |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
62 "*Buffer name for `shell-command' and `shell-command-on-region' error output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
63 This buffer is used when `shell-command' or `shell-command-on-region' |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
64 is run interactively. A value of nil means that output to stderr and |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
65 stdout will be intermixed in the output stream.") |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
66 |
| 428 | 67 (defun start-process-shell-command (name buffer &rest args) |
| 68 "Start a program in a subprocess. Return the process object for it. | |
| 69 NAME is name for process. It is modified if necessary to make it unique. | |
| 70 BUFFER is the buffer or (buffer-name) to associate with the process. | |
| 71 Process output goes at end of that buffer, unless you specify | |
| 72 an output stream or filter function to handle the output. | |
| 73 BUFFER may be also nil, meaning that this process is not associated | |
| 2473 | 74 with any buffer. |
| 75 Variables `shell-file-name' and `shell-command-switch' are used to | |
| 76 start the process. | |
| 428 | 77 Remaining arguments are the arguments for the command. |
| 78 Wildcards and redirection are handled as usual in the shell." | |
| 79 ;; We used to use `exec' to replace the shell with the command, | |
| 80 ;; but that failed to handle (...) and semicolon, etc. | |
| 81 (start-process name buffer shell-file-name shell-command-switch | |
| 82 (mapconcat #'identity args " "))) | |
| 83 | |
|
5687
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
84 (defun call-process-shell-command (command &optional infile buffer display |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
85 &rest args) |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
86 "Execute the shell command COMMAND synchronously in separate process. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
87 The remaining arguments are optional. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
88 The program's input comes from file INFILE (nil means `/dev/null'). |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
89 Insert output in BUFFER before point; t means current buffer; |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
90 nil for BUFFER means discard it; 0 means discard and don't wait. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
91 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
92 REAL-BUFFER says what to do with standard output, as above, |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
93 while STDERR-FILE says what to do with standard error in the child. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
94 STDERR-FILE may be nil (discard standard error output), |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
95 t (mix it with ordinary output), or a file name string. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
96 |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
97 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
98 Remaining arguments are strings passed as additional arguments for COMMAND. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
99 Wildcards and redirection are handled as usual in the shell. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
100 |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
101 If BUFFER is 0, `call-process-shell-command' returns immediately with value nil. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
102 Otherwise it waits for COMMAND to terminate and returns a numeric exit |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
103 status or a signal description string. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
104 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
105 ;; We used to use `exec' to replace the shell with the command, |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
106 ;; but that failed to handle (...) and semicolon, etc. |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
107 (call-process shell-file-name |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
108 infile buffer display |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
109 shell-command-switch |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
110 (mapconcat 'identity (cons command args) " "))) |
|
965a9ddc915a
Introduce call-process-shell-command from GNU.
Mats Lidell <matsl@xemacs.org>
parents:
5652
diff
changeset
|
111 |
| 853 | 112 (defun call-process-internal (program &optional infile buffer display |
| 113 &rest args) | |
| 114 "Internal function to call PROGRAM synchronously in separate process. | |
| 115 Lisp callers should use `call-process' or `call-process-region'. | |
| 116 | |
| 442 | 117 The program's input comes from file INFILE (nil means `/dev/null'). |
| 853 | 118 XEmacs feature: INFILE can also be a list of (BUFFER [START [END]]), i.e. |
| 119 a list of one to three elements, consisting of a buffer and optionally | |
| 120 a start position or start and end position. In this case, input comes | |
| 121 from the buffer, starting from START (defaults to the beginning of the | |
| 122 buffer) and ending at END (defaults to the end of the buffer). | |
| 123 | |
| 442 | 124 Insert output in BUFFER before point; t means current buffer; |
| 125 nil for BUFFER means discard it; 0 means discard and don't wait. | |
| 853 | 126 If BUFFER is a string, then find or create a buffer with that name, |
| 127 then insert the output in that buffer, before point. | |
| 442 | 128 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
| 129 REAL-BUFFER says what to do with standard output, as above, | |
| 130 while STDERR-FILE says what to do with standard error in the child. | |
| 131 STDERR-FILE may be nil (discard standard error output), | |
| 853 | 132 t (mix it with ordinary output), a file name string, or (XEmacs feature) |
| 133 a buffer object. If STDERR-FILE is a buffer object (but not the name of | |
| 134 a buffer, since that would be interpreted as a file), the standard error | |
| 135 output will be inserted into the buffer before point. | |
| 442 | 136 |
| 137 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. | |
| 138 Remaining arguments are strings passed as command arguments to PROGRAM. | |
| 139 | |
| 853 | 140 If BUFFER is 0, returns immediately with value nil. |
| 141 Otherwise waits for PROGRAM to terminate and returns a numeric exit status | |
| 142 or a signal description string. If you quit, the process is first killed | |
| 143 with SIGINT, then with SIGKILL if you quit again before the process exits. | |
| 144 | |
| 145 Coding systems for the process are the same as for `start-process-internal'." | |
| 146 (let (proc inbuf errbuf kill-inbuf kill-errbuf no-wait start end) | |
| 147 ;; first set up an unwind-protect to clean everything up. this will: | |
| 148 ;; | |
| 149 ;; -- kill the process. (when we're not waiting for it to finish, we | |
| 150 ;; set PROC to nil when we're ready to exit so this doesn't happen -- | |
| 151 ;; if we're interrupted before we're ready to exit, we should still | |
| 152 ;; kill the process) | |
| 153 ;; -- kill temporary buffers created to handle I/O to or from a file. | |
| 154 ;; KILL-INBUF/KILL-ERRBUF tell us if we should do so. | |
| 155 ;; | |
| 156 ;; note that we need to be *very* careful in this code to handle C-g | |
| 157 ;; at any point. | |
| 158 (unwind-protect | |
|
5738
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
159 (labels |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
160 ((process-synchronize-point (proc) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
161 ;; Set the point(s) in buffer and stderr-buffer according to |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
162 ;; the process mark. |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
163 ;; |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
164 ;; We need this because the documentation says to insert |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
165 ;; *BEFORE* point, but we end up inserting after because only |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
166 ;; the process mark moves forward, not point. We synchronize |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
167 ;; after every place output might happen, in sentinels, and |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
168 ;; in an unwind-protect, to make *SURE* that point is |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
169 ;; correct. (We could do this more easily and perhaps more |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
170 ;; safely using a process filter, but that would create a LOT |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
171 ;; of garbage since all the data would get sent in strings.) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
172 ;; We make this a label, not an flet, due to dynamic binding |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
173 ;; problems -- the flet may not still be in scope when the |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
174 ;; sentinel is called. |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
175 (let ((pb (process-buffer proc)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
176 (pm (process-mark proc))) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
177 (if (and pb (buffer-live-p pb) (marker-buffer pm)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
178 (goto-char pm pb)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
179 (if (process-has-separate-stderr-p proc) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
180 (let ((pseb (process-stderr-buffer proc)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
181 (psem (process-stderr-mark proc))) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
182 (if (and pseb (not (eq pb pseb)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
183 (buffer-live-p pseb) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
184 (marker-buffer psem)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
185 (goto-char psem pseb))))))) |
| 853 | 186 ;; first handle INFILE. |
| 187 (cond ((stringp infile) | |
| 188 (setq infile (expand-file-name infile)) | |
| 189 (setq kill-inbuf t) | |
| 190 (setq inbuf (generate-new-buffer "*call-process*")) | |
| 191 ;; transfer the exact contents of the file to the process. | |
| 192 ;; we do that by reading in and writing out in | |
| 193 ;; binary. #### is this even correct? should we be doing | |
| 194 ;; the same thing with stderr? if so we'd need a way of | |
| 195 ;; controlling the stderr coding system separate from | |
| 196 ;; everything else. | |
| 197 (with-current-buffer inbuf | |
| 198 ;; Make sure this works with jka-compr | |
| 199 (let ((file-name-handler-alist nil)) | |
| 200 (insert-file-contents-internal infile nil nil nil nil | |
| 201 'binary)) | |
| 202 (setq start (point-min) end (point-max)))) | |
| 203 ((consp infile) | |
| 204 (setq inbuf (get-buffer (car infile))) | |
| 205 (setq start (or (nth 1 infile) (point-min inbuf))) | |
| 206 (setq end (or (nth 2 infile) (point-max inbuf)))) | |
| 207 ((null infile) nil) | |
| 208 (t | |
| 209 (error 'wrong-type-argument | |
| 210 "Must be filename or (BUFFER [START [END]])" | |
| 211 infile))) | |
| 212 ;; now handle BUFFER | |
| 213 (let ((stderr (if (consp buffer) (second buffer) t))) | |
| 214 (if (consp buffer) (setq buffer (car buffer))) | |
| 215 (setq buffer | |
| 216 (cond ((null buffer) nil) | |
| 217 ((eq buffer t) (current-buffer)) | |
| 218 ;; use integerp for compatibility with existing | |
| 219 ;; call-process rmsism. | |
| 220 ((integerp buffer) (setq no-wait t) nil) | |
| 221 (t (get-buffer-create buffer)))) | |
| 222 (when (and stderr (not (eq t stderr))) | |
| 223 ;; both ERRBUF and STDERR being non-nil indicates to the | |
| 224 ;; code below that STDERR is a file and we should write | |
| 225 ;; ERRBUF to it; so clear out STDERR if we don't want this. | |
| 226 (if (bufferp stderr) (setq errbuf stderr stderr nil) | |
| 442 | 227 (setq stderr (expand-file-name stderr)) |
| 853 | 228 (setq kill-errbuf t) |
| 229 (setq errbuf (generate-new-buffer "*call-process*")))) | |
| 230 ;; now start process. using a pty causes all sorts of | |
| 231 ;; weirdness, at least under cygwin, when there's input. #### i | |
| 232 ;; don't know what's going wrong and whether it's a cygwin-only | |
| 233 ;; problem. suffice to say that there were NO pty connections | |
| 234 ;; in the old version. | |
| 235 (let ((process-connection-type nil)) | |
| 442 | 236 (setq proc |
| 237 (apply 'start-process-internal "*call-process*" | |
| 853 | 238 (if (eq t stderr) buffer (list buffer errbuf)) |
| 239 program args))) | |
| 240 ;; see comment above where the data was read from the file. | |
| 241 (if kill-inbuf | |
| 242 (set-process-output-coding-system proc 'binary)) | |
| 243 ;; point mark/stderr-mark at the right place (by default it's | |
| 244 ;; end of buffer). | |
| 245 (if buffer | |
| 246 (set-marker (process-mark proc) (point buffer) buffer)) | |
| 247 (if errbuf | |
| 248 (set-marker (process-stderr-mark proc) (point errbuf) errbuf)) | |
| 859 | 249 ;; now do I/O, very carefully! the unwind-protect makes sure |
| 250 ;; to clear out the sentinel, since it does a `throw', which | |
| 251 ;; would have no catch (or writes to a file -- we only want | |
| 252 ;; this on normal exit) | |
| 862 | 253 (unwind-protect |
| 254 ;; if not NO-WAIT, set a sentinel to return the exit | |
| 255 ;; status. it will throw to this catch so we can exit | |
| 256 ;; properly. | |
| 257 (catch 'call-process-done | |
| 258 (set-process-sentinel | |
| 259 proc | |
| 260 (cond | |
| 261 ((and no-wait errbuf stderr) | |
| 262 ;; we're trying really really hard to emulate | |
| 263 ;; the old call-process, which would save the | |
| 264 ;; stderr to a file even if discarding output. so | |
| 265 ;; we set a sentinel to save the output when | |
| 266 ;; we finish. | |
| 267 ;; | |
| 268 ;; #### not clear if we should be doing this. | |
|
5738
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
269 (apply-partially |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
270 #'(lambda (errbuf stderr proc status) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
271 (set-process-sentinel proc nil) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
272 (process-synchronize-point proc) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
273 (with-current-buffer errbuf |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
274 (write-region-internal |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
275 1 (1+ (buffer-size)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
276 stderr |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
277 nil 'major-rms-kludge-city nil |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
278 coding-system-for-write)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
279 (kill-buffer errbuf)) |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
280 ;; Close around these two variables, the lambda may be |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
281 ;; called outside this enclosing unwind-protect. |
|
f6af091ac654
Use new language features in #'call-process-internal now they're available.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5687
diff
changeset
|
282 errbuf stderr)) |
| 862 | 283 (no-wait nil) |
| 284 (t | |
| 285 ;; normal sentinel: maybe write out stderr and return | |
| 286 ;; status. | |
| 287 #'(lambda (proc status) | |
| 288 (process-synchronize-point proc) | |
| 289 (when (and errbuf stderr) | |
| 290 (with-current-buffer errbuf | |
| 291 (write-region-internal | |
| 292 1 (1+ (buffer-size)) stderr | |
| 293 nil 'major-rms-kludge-city nil | |
| 294 coding-system-for-write))) | |
| 295 (cond ((eq 'exit (process-status proc)) | |
| 296 (set-process-sentinel proc nil) | |
| 297 (throw 'call-process-done | |
| 298 (process-exit-status proc))) | |
| 299 ((eq 'signal (process-status proc)) | |
| 300 (set-process-sentinel proc nil) | |
| 301 (throw 'call-process-done status))))))) | |
| 302 (if (not no-wait) | |
| 303 ;; we're waiting. send the input and loop forever, | |
| 304 ;; handling process output and maybe redisplaying. | |
| 305 ;; exit happens through the sentinel or C-g. if | |
| 306 ;; C-g, send SIGINT the first time, EOF if not | |
| 307 ;; already done so (might make the process exit), | |
| 308 ;; and keep waiting. Another C-g will exit the | |
| 309 ;; whole function, and the unwind-protect will | |
| 310 ;; kill the process. (Hence the documented semantics | |
| 311 ;; of SIGINT/SIGKILL.) | |
| 312 (let (eof-sent) | |
| 313 (condition-case nil | |
| 314 (progn | |
| 315 (when inbuf | |
| 316 (process-send-region proc start end inbuf)) | |
| 317 (process-send-eof proc) | |
| 318 (setq eof-sent t) | |
| 319 (while t | |
| 320 (accept-process-output proc) | |
| 321 (process-synchronize-point proc) | |
| 322 (if display (sit-for 0)))) | |
| 323 (quit | |
| 324 (process-send-signal 'SIGINT proc) | |
| 325 (unless eof-sent | |
| 326 (process-send-eof proc)) | |
| 327 (while t | |
| 328 (accept-process-output proc) | |
| 329 (process-synchronize-point proc) | |
| 330 (if display (sit-for 0)))))) | |
| 331 ;; discard and no wait: send the input, set PROC | |
| 332 ;; and ERRBUF to nil so that the unwind-protect | |
| 333 ;; forms don't erase the sentinel, kill the process, | |
| 334 ;; or kill ERRBUF (the sentinel does that), and exit. | |
| 335 (when inbuf | |
| 336 (process-send-region proc start end inbuf)) | |
| 337 (process-send-eof proc) | |
| 338 (setq errbuf nil) | |
| 339 (setq proc nil))) | |
| 340 ;; inner unwind-protect, once we're ready to do I/O. | |
| 341 (when proc | |
| 342 (set-process-sentinel proc nil) | |
| 343 (process-synchronize-point proc))))) | |
| 859 | 344 ;; outer unwind-protect forms, to make sure we always clean up. |
| 853 | 345 (if (and inbuf kill-inbuf) (kill-buffer inbuf)) |
| 346 (if (and errbuf kill-errbuf) (kill-buffer errbuf)) | |
| 347 (condition-case nil | |
| 348 (if (and proc (process-live-p proc)) (kill-process proc)) | |
| 349 (error nil))))) | |
| 428 | 350 |
| 351 | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
352 (defun shell-command (command &optional output-buffer error-buffer) |
| 428 | 353 "Execute string COMMAND in inferior shell; display output, if any. |
| 354 | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
355 If COMMAND ends in ampersand, execute it asynchronously. The command |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
356 is executed using the background package. See `background' for |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
357 details. |
| 428 | 358 |
| 359 Otherwise, COMMAND is executed synchronously. The output appears in the | |
| 360 buffer `*Shell Command Output*'. | |
| 361 If the output is one line, it is displayed in the echo area *as well*, | |
| 362 but it is nonetheless available in buffer `*Shell Command Output*', | |
| 363 even though that buffer is not automatically displayed. | |
| 364 If there is no output, or if output is inserted in the current buffer, | |
| 365 then `*Shell Command Output*' is deleted. | |
| 366 | |
| 367 The optional second argument OUTPUT-BUFFER, if non-nil, | |
| 368 says to put the output in some other buffer. | |
| 369 If OUTPUT-BUFFER is a buffer or buffer name, put the output there. | |
| 370 If OUTPUT-BUFFER is not a buffer and not nil, | |
| 371 insert output in current buffer. (This cannot be done asynchronously.) | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
372 In either case, the output is inserted after point (leaving mark after it). |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
373 |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
374 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
375 or buffer name to which to direct the command's standard error output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
376 If it is nil, error output is mingled with regular output. In an |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
377 interactive call, the variable `shell-command-default-error-buffer' |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
378 specifies the value of ERROR-BUFFER." |
| 428 | 379 (interactive (list (read-shell-command "Shell command: ") |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
380 current-prefix-arg |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
381 shell-command-default-error-buffer)) |
| 428 | 382 (if (and output-buffer |
| 383 (not (or (bufferp output-buffer) (stringp output-buffer)))) | |
| 384 (progn (barf-if-buffer-read-only) | |
| 444 | 385 (push-mark nil (not (interactive-p))) |
| 428 | 386 ;; We do not use -f for csh; we will not support broken use of |
| 387 ;; .cshrcs. Even the BSD csh manual says to use | |
| 388 ;; "if ($?prompt) exit" before things which are not useful | |
| 389 ;; non-interactively. Besides, if someone wants their other | |
| 390 ;; aliases for shell commands then they can still have them. | |
| 391 (call-process shell-file-name nil t nil | |
| 392 shell-command-switch command) | |
| 393 (exchange-point-and-mark t)) | |
| 394 ;; Preserve the match data in case called from a program. | |
| 395 (save-match-data | |
| 396 (if (string-match "[ \t]*&[ \t]*$" command) | |
| 397 ;; Command ending with ampersand means asynchronous. | |
| 398 (progn | |
| 776 | 399 (if-fboundp 'background |
| 3491 | 400 (background (substring command 0 (match-beginning 0)) |
| 401 output-buffer) | |
| 776 | 402 (error |
| 403 'unimplemented | |
| 404 "backgrounding a shell command requires package `background'"))) | |
| 405 | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
406 (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))) |
| 428 | 407 |
| 408 ;; We have a sentinel to prevent insertion of a termination message | |
| 409 ;; in the buffer itself. | |
| 410 (defun shell-command-sentinel (process signal) | |
| 411 (if (memq (process-status process) '(exit signal)) | |
| 412 (message "%s: %s." | |
| 413 (car (cdr (cdr (process-command process)))) | |
| 414 (substring signal 0 -1)))) | |
| 415 | |
| 416 (defun shell-command-on-region (start end command | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
417 &optional output-buffer replace |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
418 error-buffer display-error-buffer) |
| 428 | 419 "Execute string COMMAND in inferior shell with region as input. |
| 420 Normally display output (if any) in temp buffer `*Shell Command Output*'; | |
| 421 Prefix arg means replace the region with it. | |
| 422 | |
| 423 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE. | |
| 424 If REPLACE is non-nil, that means insert the output | |
| 425 in place of text from START to END, putting point and mark around it. | |
| 426 | |
| 427 If the output is one line, it is displayed in the echo area, | |
| 428 but it is nonetheless available in buffer `*Shell Command Output*' | |
| 429 even though that buffer is not automatically displayed. | |
| 430 If there is no output, or if output is inserted in the current buffer, | |
| 431 then `*Shell Command Output*' is deleted. | |
| 432 | |
| 433 If the optional fourth argument OUTPUT-BUFFER is non-nil, | |
| 434 that says to put the output in some other buffer. | |
| 435 If OUTPUT-BUFFER is a buffer or buffer name, put the output there. | |
| 436 If OUTPUT-BUFFER is not a buffer and not nil, | |
| 437 insert output in the current buffer. | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
438 In either case, the output is inserted after point (leaving mark after it). |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
439 |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
440 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
441 or buffer name to which to direct the command's standard error output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
442 If it is nil, error output is mingled with regular output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
443 If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
444 were any errors. (This is always t, interactively.) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
445 In an interactive call, the variable `shell-command-default-error-buffer' |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
446 specifies the value of ERROR-BUFFER." |
| 428 | 447 (interactive (let ((string |
| 448 ;; Do this before calling region-beginning | |
| 449 ;; and region-end, in case subprocess output | |
| 450 ;; relocates them while we are in the minibuffer. | |
| 451 (read-shell-command "Shell command on region: "))) | |
| 452 ;; call-interactively recognizes region-beginning and | |
| 453 ;; region-end specially, leaving them in the history. | |
| 454 (list (region-beginning) (region-end) | |
| 455 string | |
| 456 current-prefix-arg | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
457 current-prefix-arg |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
458 shell-command-default-error-buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
459 t))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
460 (let ((error-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
461 (if error-buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
462 (make-temp-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
463 (expand-file-name "scor" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
464 (or small-temporary-file-directory |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
465 (temp-directory)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
466 nil)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
467 (exit-status nil)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
468 (if (or replace |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
469 (and output-buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
470 (not (or (bufferp output-buffer) (stringp output-buffer))))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
471 ;; Replace specified region with output from command. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
472 (let ((swap (and replace (< start end)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
473 ;; Don't muck with mark unless REPLACE says we should. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
474 (goto-char start) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
475 (and replace (push-mark)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
476 (setq exit-status (call-process-region start end shell-file-name t |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
477 (if error-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
478 (list t error-file) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
479 t) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
480 nil shell-command-switch command)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
481 (let ((shell-buffer (get-buffer "*Shell Command Output*"))) |
|
5555
a39cd9dc92ba
Correct a typo from Mats' merge, process.el, thank you the byte-compiler
Aidan Kehoe <kehoea@parhasard.net>
parents:
5533
diff
changeset
|
482 (and shell-buffer (not (eq shell-buffer (current-buffer))) |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
483 (kill-buffer shell-buffer))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
484 ;; Don't muck with mark unless REPLACE says we should. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
485 (and replace swap (exchange-point-and-mark t))) |
| 428 | 486 ;; No prefix argument: put the output in a temp buffer, |
| 487 ;; replacing its entire contents. | |
|
5533
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
488 (let ((buffer (get-buffer-create |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
489 (or output-buffer "*Shell Command Output*"))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
490 (directory default-directory)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
491 (unwind-protect |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
492 (if (eq buffer (current-buffer)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
493 ;; If the input is the same buffer as the output, |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
494 ;; delete everything but the specified region, |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
495 ;; then replace that region with the output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
496 (progn (setq buffer-read-only nil) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
497 (delete-region (max start end) (point-max)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
498 (delete-region (point-min) (min start end)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
499 (setq exit-status |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
500 (call-process-region (point-min) (point-max) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
501 shell-file-name t |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
502 (if error-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
503 (list t error-file) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
504 t) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
505 nil shell-command-switch |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
506 command))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
507 ;; Clear the output buffer, |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
508 ;; then run the command with output there. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
509 (save-excursion |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
510 (set-buffer buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
511 (setq buffer-read-only nil) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
512 ;; XEmacs change |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
513 (setq default-directory directory) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
514 (erase-buffer)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
515 (setq exit-status |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
516 (call-process-region start end shell-file-name |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
517 nil |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
518 (if error-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
519 (list buffer error-file) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
520 buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
521 nil shell-command-switch command))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
522 |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
523 ;; Report the output. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
524 (with-current-buffer buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
525 (setq modeline-process |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
526 (cond ((null exit-status) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
527 " - Error") |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
528 ((stringp exit-status) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
529 (format " - Signal [%s]" exit-status)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
530 ((not (equal 0 exit-status)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
531 (format " - Exit [%d]" exit-status))))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
532 (if (with-current-buffer buffer (> (point-max) (point-min))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
533 ;; There's some output, display it |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
534 (let ((lines (save-excursion |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
535 (set-buffer buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
536 (if (= (buffer-size) 0) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
537 0 |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
538 (count-lines (point-min) (point-max)))))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
539 (cond ((= lines 0) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
540 (display-message |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
541 'command |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
542 (if (eql exit-status 0) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
543 "(Shell command succeeded with no output)" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
544 "(Shell command failed with no output)")) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
545 (kill-buffer buffer)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
546 ((= lines 1) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
547 (message "%s" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
548 (save-excursion |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
549 (set-buffer buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
550 (goto-char (point-min)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
551 (buffer-substring (point) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
552 (progn (end-of-line) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
553 (point)))))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
554 (t |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
555 (set-window-start (display-buffer buffer) 1)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
556 ;; No output; error? |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
557 (let ((output |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
558 (if (and error-file |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
559 (< 0 (nth 7 (file-attributes error-file)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
560 "some error output" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
561 "no output"))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
562 (cond ((null exit-status) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
563 (message "(Shell command failed with error)")) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
564 ((equal 0 exit-status) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
565 (message "(Shell command succeeded with %s)" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
566 output)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
567 ((stringp exit-status) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
568 (message "(Shell command killed by signal %s)" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
569 exit-status)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
570 (t |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
571 (message "(Shell command failed with code %d and %s)" |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
572 exit-status output)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
573 ;; Don't kill: there might be useful info in the undo-log. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
574 ;; (kill-buffer buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
575 )))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
576 |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
577 (when (and error-file (file-exists-p error-file)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
578 (if (< 0 (nth 7 (file-attributes error-file))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
579 (with-current-buffer (get-buffer-create error-buffer) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
580 (let ((pos-from-end (- (point-max) (point)))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
581 (or (bobp) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
582 (insert "\f\n")) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
583 ;; Do no formatting while reading error file, |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
584 ;; because that can run a shell command, and we |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
585 ;; don't want that to cause an infinite recursion. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
586 (format-insert-file error-file nil) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
587 ;; Put point after the inserted errors. |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
588 (goto-char (- (point-max) pos-from-end))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
589 (and display-error-buffer |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
590 (display-buffer (current-buffer))))) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
591 (delete-file error-file)) |
|
11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
Mats Lidell <mats.lidell@cag.se>
parents:
5402
diff
changeset
|
592 exit-status)) |
| 428 | 593 |
| 594 (defun shell-quote-argument (argument) | |
| 595 "Quote an argument for passing as argument to an inferior shell." | |
| 442 | 596 (if (and (eq system-type 'windows-nt) |
| 597 (let ((progname (downcase (file-name-nondirectory | |
| 598 shell-file-name)))) | |
| 599 (or (equal progname "command.com") | |
| 600 (equal progname "cmd.exe")))) | |
| 601 ;; the expectation is that you can take the result of | |
| 602 ;; shell-quote-argument and pass it to as an arg to | |
| 603 ;; (start-process shell-quote-argument ...) and have it end | |
| 604 ;; up as-is in the program's argv[] array. to do this, we | |
| 605 ;; need to protect against both the shell's and the program's | |
| 606 ;; quoting conventions (and our own conventions in | |
| 607 ;; mswindows-construct-process-command-line!). Putting quotes | |
| 608 ;; around shell metachars gets through the last two, and applying | |
| 609 ;; the normal VC runtime quoting works with practically all apps. | |
| 776 | 610 (declare-fboundp (mswindows-quote-one-vc-runtime-arg argument t)) |
| 611 | 611 (if (equal argument "") |
| 612 "\"\"" | |
| 613 ;; Quote everything except POSIX filename characters. | |
| 614 ;; This should be safe enough even for really weird shells. | |
| 615 (let ((result "") (start 0) end) | |
| 616 (while (string-match "[^-0-9a-zA-Z_./]" argument start) | |
| 617 (setq end (match-beginning 0) | |
| 618 result (concat result (substring argument start end) | |
| 619 "\\" (substring argument end (1+ end))) | |
| 620 start (1+ end))) | |
| 621 (concat result (substring argument start)))))) | |
| 428 | 622 |
| 438 | 623 (defun shell-command-to-string (command) |
| 624 "Execute shell command COMMAND and return its output as a string." | |
| 428 | 625 (with-output-to-string |
| 1189 | 626 (with-current-buffer standard-output |
| 627 (call-process shell-file-name nil t nil shell-command-switch command)))) | |
| 428 | 628 |
| 438 | 629 (defalias 'exec-to-string 'shell-command-to-string) |
| 771 | 630 |
| 631 | |
| 632 ;; History list for environment variable names. | |
| 633 (defvar read-envvar-name-history nil) | |
| 634 | |
| 635 (defun read-envvar-name (prompt &optional mustmatch) | |
| 636 "Read environment variable name, prompting with PROMPT. | |
| 637 Optional second arg MUSTMATCH, if non-nil, means require existing envvar name. | |
| 638 If it is also not t, RET does not exit if it does non-null completion." | |
| 639 (completing-read prompt | |
| 640 (mapcar (function | |
| 641 (lambda (enventry) | |
| 642 (list (substring enventry 0 | |
| 643 (string-match "=" enventry))))) | |
| 644 process-environment) | |
| 645 nil mustmatch nil 'read-envvar-name-history)) | |
| 646 | |
| 647 ;; History list for VALUE argument to setenv. | |
| 648 (defvar setenv-history nil) | |
| 649 | |
| 930 | 650 (defun substitute-env-vars (string) |
| 651 "Substitute environment variables referred to in STRING. | |
| 652 `$FOO' where FOO is an environment variable name means to substitute | |
| 653 the value of that variable. The variable name should be terminated | |
| 654 with a character not a letter, digit or underscore; otherwise, enclose | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
655 the entire variable name in braces. For instance, in `ab$cd-x', |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
656 `$cd' is treated as an environment variable. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
657 |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
658 Use `$$' to insert a single dollar sign." |
| 930 | 659 (let ((start 0)) |
| 660 (while (string-match | |
| 661 ;; XEmacs change - FSF use their rx macro to generate this regexp | |
| 662 "\\(?:\\$\\(\\(?:[a-zA-Z0-9_]\\)+\\)\\)\\|\\(?:\\${\\(\\(?:.\\|\n\\)*?\\)}\\)\\|\\$\\$" | |
| 663 string start) | |
| 664 (cond ((match-beginning 1) | |
| 665 (let ((value (getenv (match-string 1 string)))) | |
| 666 (setq string (replace-match (or value "") t t string) | |
| 667 start (+ (match-beginning 0) (length value))))) | |
| 668 ((match-beginning 2) | |
| 669 (let ((value (getenv (match-string 2 string)))) | |
| 670 (setq string (replace-match (or value "") t t string) | |
| 671 start (+ (match-beginning 0) (length value))))) | |
| 672 (t | |
| 673 (setq string (replace-match "$" t t string) | |
| 674 start (+ (match-beginning 0) 1))))) | |
| 675 string)) | |
| 676 | |
| 677 (defun setenv (variable &optional value unset substitute-env-vars) | |
| 771 | 678 "Set the value of the environment variable named VARIABLE to VALUE. |
| 679 VARIABLE should be a string. VALUE is optional; if not provided or is | |
| 680 `nil', the environment variable VARIABLE will be removed. | |
| 681 | |
| 930 | 682 UNSET, if non-nil, means to remove VARIABLE from the environment. |
| 683 SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment | |
| 684 variables in VALUE using `substitute-env-vars'. | |
| 685 | |
| 771 | 686 Interactively, a prefix argument means to unset the variable. |
| 687 Interactively, the current value (if any) of the variable | |
| 688 appears at the front of the history list when you type in the new value. | |
| 689 | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
690 This function works by modifying `process-environment'. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
691 |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
692 As a special case, setting variable `TZ' calls `set-time-zone-rule' as |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
693 a side-effect." |
| 771 | 694 (interactive |
| 695 (if current-prefix-arg | |
| 696 (list (read-envvar-name "Clear environment variable: " 'exact) nil t) | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
697 (let* ((var (read-envvar-name "Set environment variable: " nil)) |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
698 (value (getenv var))) |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
699 (when value |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
700 (push value setenv-history)) |
| 771 | 701 ;; Here finally we specify the args to call setenv with. |
| 702 (list var (read-from-minibuffer (format "Set %s to value: " var) | |
| 703 nil nil nil 'setenv-history | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
704 ;; XEmacs change; don't specify a |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
705 ;; default. (Nor an abbrev table.) |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
706 ))))) |
| 930 | 707 (if unset |
| 708 (setq value nil) | |
| 709 (if substitute-env-vars | |
| 710 (setq value (substitute-env-vars value)))) | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
711 |
|
4611
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
712 ;; GNU fuck around with coding systems here. We do it at a much lower |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
713 ;; level; an equivalent of the following code of Handa's would be |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
714 ;; worthwhile here, though: |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
715 |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
716 ; (let ((codings (find-coding-systems-string (concat variable value)))) |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
717 ; (unless (or (eq 'undecided (car codings)) |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
718 ; (memq (coding-system-base locale-coding-system) codings)) |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
719 ; (error "Can't encode `%s=%s' with `locale-coding-system'" |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
720 ; variable (or value ""))))) |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
721 |
|
9c97a5a8c241
Backed out changeset 38e8af61f38d
Aidan Kehoe <kehoea@parhasard.net>
parents:
4610
diff
changeset
|
722 ;; But then right now our find-coding-systems analogue is in packages. |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
723 |
| 771 | 724 (if (string-match "=" variable) |
| 725 (error "Environment variable name `%s' contains `='" variable) | |
| 726 (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) | |
| 727 (case-fold-search nil) | |
| 728 (scan process-environment) | |
| 729 found) | |
| 730 (if (string-equal "TZ" variable) | |
| 731 (set-time-zone-rule value)) | |
| 732 (while scan | |
| 733 (cond ((string-match pattern (car scan)) | |
| 734 (setq found t) | |
| 735 (if (eq nil value) | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5555
diff
changeset
|
736 (setq process-environment |
|
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5555
diff
changeset
|
737 (delete* (car scan) process-environment)) |
| 771 | 738 (setcar scan (concat variable "=" value))) |
| 739 (setq scan nil))) | |
| 740 (setq scan (cdr scan))) | |
| 741 (or found | |
| 742 (if value | |
| 743 (setq process-environment | |
| 744 (cons (concat variable "=" value) | |
| 745 process-environment))))))) | |
| 746 | |
| 747 ;; already in C. Can't move it to Lisp too easily because it's needed | |
| 748 ;; extremely early in the Lisp loadup sequence. | |
| 749 | |
| 750 ; (defun getenv (variable) | |
| 751 ; "Get the value of environment variable VARIABLE. | |
| 752 ; VARIABLE should be a string. Value is nil if VARIABLE is undefined in | |
| 753 ; the environment. Otherwise, value is a string. | |
| 754 ; | |
| 755 ; This function consults the variable `process-environment' | |
| 756 ; for its value." | |
| 757 ; (interactive (list (read-envvar-name "Get environment variable: " t))) | |
| 758 ; (let ((value (getenv-internal variable))) | |
| 759 ; (when (interactive-p) | |
| 760 ; (message "%s" (if value value "Not set"))) | |
| 761 ; value)) | |
| 762 | |
|
4327
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
763 |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
764 ;; GNU have an #'environment function here, as of 2007-12-14. If someone |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
765 ;; actually uses it in the wild, this would suffice as an implementation: |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
766 |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
767 ; (defun environment (&optional frame) |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
768 ; "Return a list of environment variables with their values. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
769 ; Each entry in the list is a string of the form NAME=VALUE. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
770 ; |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
771 ; Optional argument FRAME is ignored, for GNU compatibility. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
772 ; |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
773 ; Non-ASCII characters look like Mojibake (that is, they are unreadable.)" |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
774 ; (loop |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
775 ; for entry in process-environment |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
776 ; collect (encode-coding-string entry 'native))) |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
777 ; |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
778 |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
779 ;; but we shouldn't encourage that sort of ugliness and needless backwards |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
780 ;; incompatibility. |
|
466ad8ad5f13
Fix a #'setenv bug, merge other changes from GNU's env.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3491
diff
changeset
|
781 |
| 771 | 782 (provide 'env) ;; Yuck. Formerly the above were in env.el, which did this |
| 783 ;; provide. | |
| 428 | 784 |
| 785 ;;; process.el ends here |