Mercurial > emacs
comparison lisp/mh-e/mh-exec.el @ 68199:5012e59a73c7
* mh-comp.el (mh-pgp-support-flag): Move here from mh-utils.el; needed
to help remove dependency on mh-utils.
* mh-exec.el: New file. Move process support routines here from
mh-utils.el.
* mh-init.el (mh-utils): Remove require.
(mh-exec): Add require.
(mh-profile-component, mh-profile-component-value): Move here from
mh-utils.el.
* mh-utils.el (mh-pgp-support-flag): Move to mh-comp.el to reduce
dependencies on mh-utils.el.
(mh-profile-component, mh-profile-component-value): Move to mh-init.el
since that's the only place that uses them. (Other than mh-alias.el;
I'm thinking that mh-find-path can set variable from the Aliasfile
component like it does the other components).
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell)
(mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
(mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet)
(defvar, mh-exec-cmd-output)
(mh-exchange-point-and-mark-preserving-active-mark)
(mh-exec-lib-cmd-output, mh-handle-process-error): Move to new file
mh-exec.el so that mh-init.el doesn't have to depend on mh-utils.el,
breaking circular dependency.
* mh-alias.el: mh-customize.el: mh-e.el: mh-funcs.el: mh-gnus.el:
* mh-identity.el: mh-inc.el: mh-junk.el: mh-mime.el: mh-print.el:
* mh-search.el: mh-seq.el: mh-speed.el: Added debugging statements
(commented out) around requires to help find dependency loops. Will
remove them when issues are resolved.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Sun, 15 Jan 2006 08:17:56 +0000 |
parents | |
children | 3e14f7a3572e |
comparison
equal
deleted
inserted
replaced
68198:f00134dbd2a6 | 68199:5012e59a73c7 |
---|---|
1 ;;; mh-exec.el --- MH-E process support | |
2 | |
3 ;; Copyright (C) 1993, 1995, 1997, | |
4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Bill Wohler <wohler@newt.com> | |
7 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 ;; Keywords: mail | |
9 ;; See: mh-e.el | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;; it under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;; any later version. | |
17 | |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
26 ;; Boston, MA 02110-1301, USA. | |
27 | |
28 ;;; Commentary: | |
29 | |
30 ;; Issue shell and MH commands | |
31 | |
32 ;;; Change Log: | |
33 | |
34 ;;; Code: | |
35 | |
36 ;;; | |
37 | |
38 (defvar mh-index-max-cmdline-args 500 | |
39 "Maximum number of command line args.") | |
40 | |
41 (defun mh-xargs (cmd &rest args) | |
42 "Partial imitation of xargs. | |
43 The current buffer contains a list of strings, one on each line. | |
44 The function will execute CMD with ARGS and pass the first | |
45 `mh-index-max-cmdline-args' strings to it. This is repeated till | |
46 all the strings have been used." | |
47 (goto-char (point-min)) | |
48 (let ((current-buffer (current-buffer))) | |
49 (with-temp-buffer | |
50 (let ((out (current-buffer))) | |
51 (set-buffer current-buffer) | |
52 (while (not (eobp)) | |
53 (let ((arg-list (reverse args)) | |
54 (count 0)) | |
55 (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | |
56 (push (buffer-substring-no-properties (point) (line-end-position)) | |
57 arg-list) | |
58 (incf count) | |
59 (forward-line)) | |
60 (apply #'call-process cmd nil (list out nil) nil | |
61 (nreverse arg-list)))) | |
62 (erase-buffer) | |
63 (insert-buffer-substring out))))) | |
64 | |
65 ;; XXX This should be applied anywhere MH-E calls out to /bin/sh. | |
66 (defun mh-quote-for-shell (string) | |
67 "Quote STRING for /bin/sh. | |
68 Adds double-quotes around entire string and quotes the characters | |
69 \\, `, and $ with a backslash." | |
70 (concat "\"" | |
71 (loop for x across string | |
72 concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) | |
73 "\"")) | |
74 | |
75 (defun mh-exec-cmd (command &rest args) | |
76 "Execute mh-command COMMAND with ARGS. | |
77 The side effects are what is desired. Any output is assumed to be | |
78 an error and is shown to the user. The output is not read or | |
79 parsed by MH-E." | |
80 (save-excursion | |
81 (set-buffer (get-buffer-create mh-log-buffer)) | |
82 (let* ((initial-size (mh-truncate-log-buffer)) | |
83 (start (point)) | |
84 (args (mh-list-to-string args))) | |
85 (apply 'call-process (expand-file-name command mh-progs) nil t nil args) | |
86 (when (> (buffer-size) initial-size) | |
87 (save-excursion | |
88 (goto-char start) | |
89 (insert "Errors when executing: " command) | |
90 (loop for arg in args do (insert " " arg)) | |
91 (insert "\n")) | |
92 (save-window-excursion | |
93 (switch-to-buffer-other-window mh-log-buffer) | |
94 (sit-for 5)))))) | |
95 | |
96 (defun mh-exec-cmd-error (env command &rest args) | |
97 "In environment ENV, execute mh-command COMMAND with ARGS. | |
98 ENV is nil or a string of space-separated \"var=value\" elements. | |
99 Signals an error if process does not complete successfully." | |
100 (save-excursion | |
101 (set-buffer (get-buffer-create mh-temp-buffer)) | |
102 (erase-buffer) | |
103 (let ((process-environment process-environment)) | |
104 ;; XXX: We should purge the list that split-string returns of empty | |
105 ;; strings. This can happen in XEmacs if leading or trailing spaces | |
106 ;; are present. | |
107 (dolist (elem (if (stringp env) (split-string env " ") ())) | |
108 (push elem process-environment)) | |
109 (mh-handle-process-error | |
110 command (apply #'call-process (expand-file-name command mh-progs) | |
111 nil t nil (mh-list-to-string args)))))) | |
112 | |
113 (defun mh-exec-cmd-daemon (command filter &rest args) | |
114 "Execute MH command COMMAND in the background. | |
115 | |
116 If FILTER is non-nil then it is used to process the output | |
117 otherwise the default filter `mh-process-daemon' is used. See | |
118 `set-process-filter' for more details of FILTER. | |
119 | |
120 ARGS are passed to COMMAND as command line arguments." | |
121 (save-excursion | |
122 (set-buffer (get-buffer-create mh-log-buffer)) | |
123 (mh-truncate-log-buffer)) | |
124 (let* ((process-connection-type nil) | |
125 (process (apply 'start-process | |
126 command nil | |
127 (expand-file-name command mh-progs) | |
128 (mh-list-to-string args)))) | |
129 (set-process-filter process (or filter 'mh-process-daemon)) | |
130 process)) | |
131 | |
132 (defun mh-exec-cmd-env-daemon (env command filter &rest args) | |
133 "In ennvironment ENV, execute mh-command COMMAND in the background. | |
134 | |
135 ENV is nil or a string of space-separated \"var=value\" elements. | |
136 Signals an error if process does not complete successfully. | |
137 | |
138 If FILTER is non-nil then it is used to process the output | |
139 otherwise the default filter `mh-process-daemon' is used. See | |
140 `set-process-filter' for more details of FILTER. | |
141 | |
142 ARGS are passed to COMMAND as command line arguments." | |
143 (let ((process-environment process-environment)) | |
144 (dolist (elem (if (stringp env) (split-string env " ") ())) | |
145 (push elem process-environment)) | |
146 (apply #'mh-exec-cmd-daemon command filter args))) | |
147 | |
148 (defun mh-process-daemon (process output) | |
149 "PROCESS daemon that puts OUTPUT into a temporary buffer. | |
150 Any output from the process is displayed in an asynchronous | |
151 pop-up window." | |
152 (with-current-buffer (get-buffer-create mh-log-buffer) | |
153 (insert-before-markers output) | |
154 (display-buffer mh-log-buffer))) | |
155 | |
156 (defun mh-exec-cmd-quiet (raise-error command &rest args) | |
157 "Signal RAISE-ERROR if COMMAND with ARGS fails. | |
158 Execute MH command COMMAND with ARGS. ARGS is a list of strings. | |
159 Return at start of mh-temp buffer, where output can be parsed and | |
160 used. | |
161 Returns value of `call-process', which is 0 for success, unless | |
162 RAISE-ERROR is non-nil, in which case an error is signaled if | |
163 `call-process' returns non-0." | |
164 (set-buffer (get-buffer-create mh-temp-buffer)) | |
165 (erase-buffer) | |
166 (let ((value | |
167 (apply 'call-process | |
168 (expand-file-name command mh-progs) nil t nil | |
169 args))) | |
170 (goto-char (point-min)) | |
171 (if raise-error | |
172 (mh-handle-process-error command value) | |
173 value))) | |
174 | |
175 ;; Shush compiler. | |
176 (eval-when-compile (defvar mark-active)) | |
177 | |
178 (defun mh-exec-cmd-output (command display &rest args) | |
179 "Execute MH command COMMAND with DISPLAY flag and ARGS. | |
180 Put the output into buffer after point. | |
181 Set mark after inserted text. | |
182 Output is expected to be shown to user, not parsed by MH-E." | |
183 (push-mark (point) t) | |
184 (apply 'call-process | |
185 (expand-file-name command mh-progs) nil t display | |
186 (mh-list-to-string args)) | |
187 | |
188 ;; The following is used instead of 'exchange-point-and-mark because the | |
189 ;; latter activates the current region (between point and mark), which | |
190 ;; turns on highlighting. So prior to this bug fix, doing "inc" would | |
191 ;; highlight a region containing the new messages, which is undesirable. | |
192 ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. | |
193 (mh-exchange-point-and-mark-preserving-active-mark)) | |
194 | |
195 (defun mh-exchange-point-and-mark-preserving-active-mark () | |
196 "Put the mark where point is now, and point where the mark is now. | |
197 This command works even when the mark is not active, and | |
198 preserves whether the mark is active or not." | |
199 (interactive nil) | |
200 (let ((is-active (and (boundp 'mark-active) mark-active))) | |
201 (let ((omark (mark t))) | |
202 (if (null omark) | |
203 (error "No mark set in this buffer")) | |
204 (set-mark (point)) | |
205 (goto-char omark) | |
206 (if (boundp 'mark-active) | |
207 (setq mark-active is-active)) | |
208 nil))) | |
209 | |
210 (defun mh-exec-lib-cmd-output (command &rest args) | |
211 "Execute MH library command COMMAND with ARGS. | |
212 Put the output into buffer after point. | |
213 Set mark after inserted text." | |
214 (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) | |
215 | |
216 (defun mh-handle-process-error (command status) | |
217 "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." | |
218 (if (equal status 0) | |
219 status | |
220 (goto-char (point-min)) | |
221 (insert (if (integerp status) | |
222 (format "%s: exit code %d\n" command status) | |
223 (format "%s: %s\n" command status))) | |
224 (save-excursion | |
225 (let ((error-message (buffer-substring (point-min) (point-max)))) | |
226 (set-buffer (get-buffer-create mh-log-buffer)) | |
227 (mh-truncate-log-buffer) | |
228 (insert error-message))) | |
229 (error "%s failed, check buffer %s for error message" | |
230 command mh-log-buffer))) | |
231 | |
232 (provide 'mh-exec) | |
233 | |
234 ;; Local Variables: | |
235 ;; indent-tabs-mode: nil | |
236 ;; sentence-end-double-space: nil | |
237 ;; End: | |
238 | |
239 ;;; mh-utils.el ends here |