annotate lisp/process.el @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents a634e3b7acc8
children 84762348c6f9
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.
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
4 ;; Copyright (C) 1995, 2000, 2001, 2002 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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
27 ;;; Synched up with: FSF 19.30, except for setenv/getenv (synched with FSF
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
28 ;;; 21.0.105).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30 ;;; Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 ;; 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
33 ;; 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
34 ;; be redefined in a Mule world.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35 ;; 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
36
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;; Code:
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (defgroup processes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 "Process, subshell, compilation, and job control support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 :group 'external
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (defgroup processes-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 "Basic stuff dealing with processes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 :group 'processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (defgroup execute nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 "Executing external commands."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 :group 'processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
57 ;; This may be changed to "/c" in win32-native.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (defvar shell-command-switch "-c"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 "Switch used to have the shell execute its command line argument.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (defun start-process-shell-command (name buffer &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 "Start a program in a subprocess. Return the process object for it.
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
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
78 (defun call-process-internal (program &optional infile buffer display
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
79 &rest args)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
80 "Internal function to call PROGRAM synchronously in separate process.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
81 Lisp callers should use `call-process' or `call-process-region'.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
82
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
83 The program's input comes from file INFILE (nil means `/dev/null').
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
84 XEmacs feature: INFILE can also be a list of (BUFFER [START [END]]), i.e.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
85 a list of one to three elements, consisting of a buffer and optionally
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
86 a start position or start and end position. In this case, input comes
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
87 from the buffer, starting from START (defaults to the beginning of the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
88 buffer) and ending at END (defaults to the end of the buffer).
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
89
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
90 Insert output in BUFFER before point; t means current buffer;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
91 nil for BUFFER means discard it; 0 means discard and don't wait.
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
92 If BUFFER is a string, then find or create a buffer with that name,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
93 then insert the output in that buffer, before point.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
94 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
95 REAL-BUFFER says what to do with standard output, as above,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
96 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
97 STDERR-FILE may be nil (discard standard error output),
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
98 t (mix it with ordinary output), a file name string, or (XEmacs feature)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
99 a buffer object. If STDERR-FILE is a buffer object (but not the name of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
100 a buffer, since that would be interpreted as a file), the standard error
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
101 output will be inserted into the buffer before point.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
102
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
103 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
104 Remaining arguments are strings passed as command arguments to PROGRAM.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
105
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
106 If BUFFER is 0, returns immediately with value nil.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
107 Otherwise waits for PROGRAM to terminate and returns a numeric exit status
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
108 or a signal description string. If you quit, the process is first killed
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
109 with SIGINT, then with SIGKILL if you quit again before the process exits.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
110
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
111 Coding systems for the process are the same as for `start-process-internal'."
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
112 (let (proc inbuf errbuf kill-inbuf kill-errbuf no-wait start end)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
113 ;; first set up an unwind-protect to clean everything up. this will:
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
114 ;;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
115 ;; -- kill the process. (when we're not waiting for it to finish, we
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
116 ;; set PROC to nil when we're ready to exit so this doesn't happen --
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
117 ;; if we're interrupted before we're ready to exit, we should still
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
118 ;; kill the process)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
119 ;; -- kill temporary buffers created to handle I/O to or from a file.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
120 ;; KILL-INBUF/KILL-ERRBUF tell us if we should do so.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
121 ;;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
122 ;; note that we need to be *very* careful in this code to handle C-g
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
123 ;; at any point.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
124 (unwind-protect
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
125 (progn
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
126 ;; first handle INFILE.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
127 (cond ((stringp infile)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
128 (setq infile (expand-file-name infile))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
129 (setq kill-inbuf t)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
130 (setq inbuf (generate-new-buffer "*call-process*"))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
131 ;; transfer the exact contents of the file to the process.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
132 ;; we do that by reading in and writing out in
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
133 ;; binary. #### is this even correct? should we be doing
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
134 ;; the same thing with stderr? if so we'd need a way of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
135 ;; controlling the stderr coding system separate from
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
136 ;; everything else.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
137 (with-current-buffer inbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
138 ;; Make sure this works with jka-compr
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
139 (let ((file-name-handler-alist nil))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
140 (insert-file-contents-internal infile nil nil nil nil
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
141 'binary))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
142 (setq start (point-min) end (point-max))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
143 ((consp infile)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
144 (setq inbuf (get-buffer (car infile)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
145 (setq start (or (nth 1 infile) (point-min inbuf)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
146 (setq end (or (nth 2 infile) (point-max inbuf))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
147 ((null infile) nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
148 (t
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
149 (error 'wrong-type-argument
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
150 "Must be filename or (BUFFER [START [END]])"
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
151 infile)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
152 ;; now handle BUFFER
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
153 (let ((stderr (if (consp buffer) (second buffer) t)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
154 (if (consp buffer) (setq buffer (car buffer)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
155 (setq buffer
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
156 (cond ((null buffer) nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
157 ((eq buffer t) (current-buffer))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
158 ;; use integerp for compatibility with existing
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
159 ;; call-process rmsism.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
160 ((integerp buffer) (setq no-wait t) nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
161 (t (get-buffer-create buffer))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
162 (when (and stderr (not (eq t stderr)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
163 ;; both ERRBUF and STDERR being non-nil indicates to the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
164 ;; code below that STDERR is a file and we should write
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
165 ;; ERRBUF to it; so clear out STDERR if we don't want this.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
166 (if (bufferp stderr) (setq errbuf stderr stderr nil)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 (setq stderr (expand-file-name stderr))
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
168 (setq kill-errbuf t)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
169 (setq errbuf (generate-new-buffer "*call-process*"))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
170 ;; now start process. using a pty causes all sorts of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
171 ;; weirdness, at least under cygwin, when there's input. #### i
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
172 ;; don't know what's going wrong and whether it's a cygwin-only
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
173 ;; problem. suffice to say that there were NO pty connections
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
174 ;; in the old version.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
175 (let ((process-connection-type nil))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
176 (setq proc
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 (apply 'start-process-internal "*call-process*"
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
178 (if (eq t stderr) buffer (list buffer errbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
179 program args)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
180 ;; see comment above where the data was read from the file.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
181 (if kill-inbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
182 (set-process-output-coding-system proc 'binary))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
183 ;; point mark/stderr-mark at the right place (by default it's
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
184 ;; end of buffer).
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
185 (if buffer
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
186 (set-marker (process-mark proc) (point buffer) buffer))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
187 (if errbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
188 (set-marker (process-stderr-mark proc) (point errbuf) errbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
189 ;; now do I/O, very carefully! the unwind-protect makes sure
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
190 ;; to clear out the sentinel, since it does a `throw', which would
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
191 ;; have no catch (or writes to a file -- we only want this on
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
192 ;; normal exit)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
193 (unwind-protect
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
194 ;; if not NO-WAIT, set a sentinel to return the exit
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
195 ;; status. it will throw to this catch so we can exit
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
196 ;; properly.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
197 (catch 'call-process-done
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
198 (set-process-sentinel
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
199 proc
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
200 (if no-wait
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
201 ;; we're trying really really hard to emulate
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
202 ;; the old call-process, which would save the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
203 ;; stderr to a file even if discarding output. so
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
204 ;; we set a sentinel to save the output when
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
205 ;; we finish.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
206 ;;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
207 ;; #### not clear if we should be doing this.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
208 ;;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
209 ;; NOTE NOTE NOTE: Due to the total bogosity of
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
210 ;; dynamic scoping, and the lack of closures, we
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
211 ;; have to be careful how we write the first
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
212 ;; sentinel below since it may be executed after
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
213 ;; this function has returned -- thus we fake a
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
214 ;; closure. (This doesn't apply to the second one,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
215 ;; which only gets executed within the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
216 ;; unwind-protect.)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
217 (if (and errbuf stderr)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
218 (set-process-sentinel
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
219 proc
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
220 `(lambda (proc status)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
221 (set-process-sentinel proc nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
222 (with-current-buffer ,errbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
223 (write-region-internal
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
224 1 (1+ (buffer-size))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
225 ,stderr
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
226 nil 'major-rms-kludge-city nil
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
227 coding-system-for-write))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
228 (kill-buffer ,errbuf))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
229 ;; normal sentinel: maybe write out stderr and return
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
230 ;; status.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
231 #'(lambda (proc status)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
232 (when (and errbuf stderr)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
233 (with-current-buffer errbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
234 (write-region-internal
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
235 1 (1+ (buffer-size)) stderr
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
236 nil 'major-rms-kludge-city nil
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
237 coding-system-for-write)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
238 (cond ((eq 'exit (process-status proc))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
239 (set-process-sentinel proc nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
240 (throw 'call-process-done
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
241 (process-exit-status proc)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
242 ((eq 'signal (process-status proc))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
243 (set-process-sentinel proc nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
244 (throw 'call-process-done status))))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
245 (if (not no-wait)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
246 ;; we're waiting. send the input and loop forever,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
247 ;; handling process output and maybe redisplaying.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
248 ;; exit happens through the sentinel or C-g. if
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
249 ;; C-g, send SIGINT the first time, EOF if not
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
250 ;; already done so (might make the process exit),
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
251 ;; and keep waiting. Another C-g will exit the
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
252 ;; whole function, and the unwind-protect will
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
253 ;; kill the process. (Hence the documented semantics
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
254 ;; of SIGINT/SIGKILL.)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
255 (let (eof-sent)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
256 (condition-case nil
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
257 (progn
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
258 (when inbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
259 (process-send-region proc start end inbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
260 (process-send-eof proc)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
261 (setq eof-sent t)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
262 (while t
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
263 (accept-process-output proc)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
264 (if display (sit-for 0))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
265 (quit
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
266 (process-send-signal 'SIGINT proc)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
267 (unless eof-sent
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
268 (process-send-eof proc))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
269 (while t
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
270 (accept-process-output proc)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
271 (if display (sit-for 0))))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
272 ;; discard and no wait: send the input, set PROC
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
273 ;; and ERRBUF to nil so that the unwind-protect
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
274 ;; forms don't erase the sentinel, kill the process,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
275 ;; or kill ERRBUF (the sentinel does that), and exit.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
276 (when inbuf
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
277 (process-send-region proc start end inbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
278 (process-send-eof proc)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
279 (setq errbuf nil)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
280 (setq proc nil)))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
281 (if proc (set-process-sentinel proc nil)))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
282 ;; unwind-protect forms.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
283 (if (and inbuf kill-inbuf) (kill-buffer inbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
284 (if (and errbuf kill-errbuf) (kill-buffer errbuf))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
285 (condition-case nil
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
286 (if (and proc (process-live-p proc)) (kill-process proc))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 814
diff changeset
287 (error nil)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (defun shell-command (command &optional output-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 "Execute string COMMAND in inferior shell; display output, if any.
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 If COMMAND ends in ampersand, execute it asynchronously.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 The output appears in the buffer `*Async Shell Command*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 That buffer is in shell mode.
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 Otherwise, COMMAND is executed synchronously. The output appears in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 buffer `*Shell Command Output*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 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
300 but it is nonetheless available in buffer `*Shell Command Output*',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 even though that buffer is not automatically displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 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
303 then `*Shell Command Output*' is deleted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 The optional second argument OUTPUT-BUFFER, if non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 says to put the output in some other buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 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
308 If OUTPUT-BUFFER is not a buffer and not nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 insert output in current buffer. (This cannot be done asynchronously.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 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
311 (interactive (list (read-shell-command "Shell command: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (if (and output-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (not (or (bufferp output-buffer) (stringp output-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (progn (barf-if-buffer-read-only)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
316 (push-mark nil (not (interactive-p)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 ;; 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
318 ;; .cshrcs. Even the BSD csh manual says to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 ;; "if ($?prompt) exit" before things which are not useful
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ;; non-interactively. Besides, if someone wants their other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ;; aliases for shell commands then they can still have them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (call-process shell-file-name nil t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 shell-command-switch command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (exchange-point-and-mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ;; Preserve the match data in case called from a program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (if (string-match "[ \t]*&[ \t]*$" command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ;; Command ending with ampersand means asynchronous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (progn
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
330 (if-fboundp 'background
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
331 (background (substring command 0
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
332 (match-beginning 0)))
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
333 (error
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
334 'unimplemented
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
335 "backgrounding a shell command requires package `background'")))
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
336
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (shell-command-on-region (point) (point) command output-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;; We have a sentinel to prevent insertion of a termination message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 ;; in the buffer itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (defun shell-command-sentinel (process signal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (if (memq (process-status process) '(exit signal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (message "%s: %s."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (car (cdr (cdr (process-command process))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (substring signal 0 -1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (defun shell-command-on-region (start end command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 &optional output-buffer replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 "Execute string COMMAND in inferior shell with region as input.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Normally display output (if any) in temp buffer `*Shell Command Output*';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 Prefix arg means replace the region with it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 If REPLACE is non-nil, that means insert the output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 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
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 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
358 but it is nonetheless available in buffer `*Shell Command Output*'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 even though that buffer is not automatically displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 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
361 then `*Shell Command Output*' is deleted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 If the optional fourth argument OUTPUT-BUFFER is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 that says to put the output in some other buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 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
366 If OUTPUT-BUFFER is not a buffer and not nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 insert output in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 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
369 (interactive (let ((string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 ;; Do this before calling region-beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 ;; and region-end, in case subprocess output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 ;; relocates them while we are in the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (read-shell-command "Shell command on region: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 ;; call-interactively recognizes region-beginning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 ;; region-end specially, leaving them in the history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (list (region-beginning) (region-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 current-prefix-arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (if (or replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (and output-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (not (or (bufferp output-buffer) (stringp output-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 ;; Replace specified region with output from command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (let ((swap (and replace (< start end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;; Don't muck with mark unless REPLACE says we should.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (and replace (push-mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (call-process-region start end shell-file-name t t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 shell-command-switch command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (and shell-buffer (not (eq shell-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (kill-buffer shell-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 ;; Don't muck with mark unless REPLACE says we should.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (and replace swap (exchange-point-and-mark t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ;; No prefix argument: put the output in a temp buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;; replacing its entire contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (let ((buffer (get-buffer-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (or output-buffer "*Shell Command Output*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (success nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (exit-status nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (directory default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (if (eq buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;; If the input is the same buffer as the output,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 ;; delete everything but the specified region,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 ;; then replace that region with the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (progn (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (delete-region (max start end) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (delete-region (point-min) (max start end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (setq exit-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (call-process-region (point-min) (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 shell-file-name t t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 shell-command-switch command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (setq success t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ;; Clear the output buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ;; then run the command with output there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (setq default-directory directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (erase-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (setq exit-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (call-process-region start end shell-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 nil buffer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 shell-command-switch command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (setq success t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 ;; Report the amount of output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (let ((lines (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (if (= (buffer-size) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (count-lines (point-min) (point-max))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (cond ((= lines 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (if success
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 'command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (if (eql exit-status 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 "(Shell command succeeded with no output)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 "(Shell command failed with no output)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (kill-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 ((and success (= lines 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (message "%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (progn (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (set-window-start (display-buffer buffer) 1))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (defun shell-quote-argument (argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 "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
455 (if (and (eq system-type 'windows-nt)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
456 (let ((progname (downcase (file-name-nondirectory
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
457 shell-file-name))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
458 (or (equal progname "command.com")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
459 (equal progname "cmd.exe"))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
460 ;; the expectation is that you can take the result of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
461 ;; shell-quote-argument and pass it to as an arg to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462 ;; (start-process shell-quote-argument ...) and have it end
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
463 ;; 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
464 ;; 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
465 ;; quoting conventions (and our own conventions in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 ;; mswindows-construct-process-command-line!). Putting quotes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
467 ;; around shell metachars gets through the last two, and applying
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468 ;; the normal VC runtime quoting works with practically all apps.
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
469 (declare-fboundp (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
470 (if (equal argument "")
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
471 "\"\""
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
472 ;; Quote everything except POSIX filename characters.
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
473 ;; 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
474 (let ((result "") (start 0) end)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
475 (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
476 (setq end (match-beginning 0)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
477 result (concat result (substring argument start end)
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
478 "\\" (substring argument end (1+ end)))
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
479 start (1+ end)))
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 444
diff changeset
480 (concat result (substring argument start))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
482 (defun shell-command-to-string (command)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
483 "Execute shell command COMMAND and return its output as a string."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (with-output-to-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (call-process shell-file-name nil t nil shell-command-switch command)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
487 (defalias 'exec-to-string 'shell-command-to-string)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
488
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
489
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
490 ;; History list for environment variable names.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
491 (defvar read-envvar-name-history nil)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
492
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
493 (defun read-envvar-name (prompt &optional mustmatch)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
494 "Read environment variable name, prompting with PROMPT.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
495 Optional second arg MUSTMATCH, if non-nil, means require existing envvar name.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
496 If it is also not t, RET does not exit if it does non-null completion."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
497 (completing-read prompt
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
498 (mapcar (function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
499 (lambda (enventry)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
500 (list (substring enventry 0
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
501 (string-match "=" enventry)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
502 process-environment)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
503 nil mustmatch nil 'read-envvar-name-history))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
504
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
505 ;; History list for VALUE argument to setenv.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
506 (defvar setenv-history nil)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
507
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
508 (defun setenv (variable &optional value unset)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
509 "Set the value of the environment variable named VARIABLE to VALUE.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
510 VARIABLE should be a string. VALUE is optional; if not provided or is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
511 `nil', the environment variable VARIABLE will be removed.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
512
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
513 Interactively, a prefix argument means to unset the variable.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
514 Interactively, the current value (if any) of the variable
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
515 appears at the front of the history list when you type in the new value.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
516
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
517 This function works by modifying `process-environment'."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
518 (interactive
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
519 (if current-prefix-arg
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
520 (list (read-envvar-name "Clear environment variable: " 'exact) nil t)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
521 (let ((var (read-envvar-name "Set environment variable: " nil)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
522 ;; Here finally we specify the args to call setenv with.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
523 (list var (read-from-minibuffer (format "Set %s to value: " var)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
524 nil nil nil 'setenv-history
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
525 (getenv var))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
526 (if unset (setq value nil))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
527 (if (string-match "=" variable)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
528 (error "Environment variable name `%s' contains `='" variable)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
529 (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
530 (case-fold-search nil)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
531 (scan process-environment)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
532 found)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
533 (if (string-equal "TZ" variable)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
534 (set-time-zone-rule value))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
535 (while scan
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
536 (cond ((string-match pattern (car scan))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
537 (setq found t)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
538 (if (eq nil value)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
539 (setq process-environment (delq (car scan) process-environment))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
540 (setcar scan (concat variable "=" value)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
541 (setq scan nil)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
542 (setq scan (cdr scan)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
543 (or found
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
544 (if value
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
545 (setq process-environment
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
546 (cons (concat variable "=" value)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
547 process-environment)))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
548
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
549 ;; already in C. Can't move it to Lisp too easily because it's needed
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
550 ;; extremely early in the Lisp loadup sequence.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
551
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
552 ; (defun getenv (variable)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
553 ; "Get the value of environment variable VARIABLE.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
554 ; VARIABLE should be a string. Value is nil if VARIABLE is undefined in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
555 ; the environment. Otherwise, value is a string.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
556 ;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
557 ; This function consults the variable `process-environment'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
558 ; for its value."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
559 ; (interactive (list (read-envvar-name "Get environment variable: " t)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
560 ; (let ((value (getenv-internal variable)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
561 ; (when (interactive-p)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
562 ; (message "%s" (if value value "Not set")))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
563 ; value))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
564
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
565 (provide 'env) ;; Yuck. Formerly the above were in env.el, which did this
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 611
diff changeset
566 ;; provide.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 ;;; process.el ends here