Commit | Line | Data |
---|---|---|
30f24016 BW |
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 | ||
98eab4e4 BW |
36 | (eval-when-compile (require 'mh-acros)) |
37 | (mh-require-cl) | |
38 | ||
39 | (require 'mh-buffers) | |
40 | (require 'mh-utils) | |
41 | ||
42 | (defvar mh-progs nil | |
43 | "Directory containing MH commands, such as inc, repl, and rmm.") | |
44 | ||
45 | ;;;###autoload | |
46 | (put 'mh-progs 'risky-local-variable t) | |
47 | ||
48 | (defvar mh-lib nil | |
49 | "Directory containing the MH library. | |
50 | This directory contains, among other things, the components file.") | |
51 | ||
52 | ;;;###autoload | |
53 | (put 'mh-lib 'risky-local-variable t) | |
54 | ||
55 | (defvar mh-lib-progs nil | |
56 | "Directory containing MH helper programs. | |
57 | This directory contains, among other things, the mhl program.") | |
58 | ||
59 | ;;;###autoload | |
60 | (put 'mh-lib-progs 'risky-local-variable t) | |
30f24016 BW |
61 | |
62 | (defvar mh-index-max-cmdline-args 500 | |
63 | "Maximum number of command line args.") | |
64 | ||
65 | (defun mh-xargs (cmd &rest args) | |
66 | "Partial imitation of xargs. | |
67 | The current buffer contains a list of strings, one on each line. | |
68 | The function will execute CMD with ARGS and pass the first | |
69 | `mh-index-max-cmdline-args' strings to it. This is repeated till | |
70 | all the strings have been used." | |
71 | (goto-char (point-min)) | |
72 | (let ((current-buffer (current-buffer))) | |
73 | (with-temp-buffer | |
74 | (let ((out (current-buffer))) | |
75 | (set-buffer current-buffer) | |
76 | (while (not (eobp)) | |
77 | (let ((arg-list (reverse args)) | |
78 | (count 0)) | |
79 | (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | |
80 | (push (buffer-substring-no-properties (point) (line-end-position)) | |
81 | arg-list) | |
82 | (incf count) | |
83 | (forward-line)) | |
84 | (apply #'call-process cmd nil (list out nil) nil | |
85 | (nreverse arg-list)))) | |
86 | (erase-buffer) | |
87 | (insert-buffer-substring out))))) | |
88 | ||
89 | ;; XXX This should be applied anywhere MH-E calls out to /bin/sh. | |
90 | (defun mh-quote-for-shell (string) | |
91 | "Quote STRING for /bin/sh. | |
92 | Adds double-quotes around entire string and quotes the characters | |
93 | \\, `, and $ with a backslash." | |
94 | (concat "\"" | |
95 | (loop for x across string | |
96 | concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) | |
97 | "\"")) | |
98 | ||
99 | (defun mh-exec-cmd (command &rest args) | |
100 | "Execute mh-command COMMAND with ARGS. | |
101 | The side effects are what is desired. Any output is assumed to be | |
102 | an error and is shown to the user. The output is not read or | |
103 | parsed by MH-E." | |
104 | (save-excursion | |
105 | (set-buffer (get-buffer-create mh-log-buffer)) | |
106 | (let* ((initial-size (mh-truncate-log-buffer)) | |
107 | (start (point)) | |
108 | (args (mh-list-to-string args))) | |
109 | (apply 'call-process (expand-file-name command mh-progs) nil t nil args) | |
110 | (when (> (buffer-size) initial-size) | |
111 | (save-excursion | |
112 | (goto-char start) | |
113 | (insert "Errors when executing: " command) | |
114 | (loop for arg in args do (insert " " arg)) | |
115 | (insert "\n")) | |
116 | (save-window-excursion | |
117 | (switch-to-buffer-other-window mh-log-buffer) | |
118 | (sit-for 5)))))) | |
119 | ||
120 | (defun mh-exec-cmd-error (env command &rest args) | |
121 | "In environment ENV, execute mh-command COMMAND with ARGS. | |
122 | ENV is nil or a string of space-separated \"var=value\" elements. | |
123 | Signals an error if process does not complete successfully." | |
124 | (save-excursion | |
125 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
126 | (erase-buffer) | |
127 | (let ((process-environment process-environment)) | |
128 | ;; XXX: We should purge the list that split-string returns of empty | |
129 | ;; strings. This can happen in XEmacs if leading or trailing spaces | |
130 | ;; are present. | |
131 | (dolist (elem (if (stringp env) (split-string env " ") ())) | |
132 | (push elem process-environment)) | |
133 | (mh-handle-process-error | |
134 | command (apply #'call-process (expand-file-name command mh-progs) | |
135 | nil t nil (mh-list-to-string args)))))) | |
136 | ||
137 | (defun mh-exec-cmd-daemon (command filter &rest args) | |
138 | "Execute MH command COMMAND in the background. | |
139 | ||
140 | If FILTER is non-nil then it is used to process the output | |
141 | otherwise the default filter `mh-process-daemon' is used. See | |
142 | `set-process-filter' for more details of FILTER. | |
143 | ||
144 | ARGS are passed to COMMAND as command line arguments." | |
145 | (save-excursion | |
146 | (set-buffer (get-buffer-create mh-log-buffer)) | |
147 | (mh-truncate-log-buffer)) | |
148 | (let* ((process-connection-type nil) | |
149 | (process (apply 'start-process | |
150 | command nil | |
151 | (expand-file-name command mh-progs) | |
152 | (mh-list-to-string args)))) | |
153 | (set-process-filter process (or filter 'mh-process-daemon)) | |
154 | process)) | |
155 | ||
156 | (defun mh-exec-cmd-env-daemon (env command filter &rest args) | |
157 | "In ennvironment ENV, execute mh-command COMMAND in the background. | |
158 | ||
159 | ENV is nil or a string of space-separated \"var=value\" elements. | |
160 | Signals an error if process does not complete successfully. | |
161 | ||
162 | If FILTER is non-nil then it is used to process the output | |
163 | otherwise the default filter `mh-process-daemon' is used. See | |
164 | `set-process-filter' for more details of FILTER. | |
165 | ||
166 | ARGS are passed to COMMAND as command line arguments." | |
167 | (let ((process-environment process-environment)) | |
168 | (dolist (elem (if (stringp env) (split-string env " ") ())) | |
169 | (push elem process-environment)) | |
170 | (apply #'mh-exec-cmd-daemon command filter args))) | |
171 | ||
172 | (defun mh-process-daemon (process output) | |
173 | "PROCESS daemon that puts OUTPUT into a temporary buffer. | |
174 | Any output from the process is displayed in an asynchronous | |
175 | pop-up window." | |
176 | (with-current-buffer (get-buffer-create mh-log-buffer) | |
177 | (insert-before-markers output) | |
178 | (display-buffer mh-log-buffer))) | |
179 | ||
180 | (defun mh-exec-cmd-quiet (raise-error command &rest args) | |
181 | "Signal RAISE-ERROR if COMMAND with ARGS fails. | |
182 | Execute MH command COMMAND with ARGS. ARGS is a list of strings. | |
183 | Return at start of mh-temp buffer, where output can be parsed and | |
184 | used. | |
185 | Returns value of `call-process', which is 0 for success, unless | |
186 | RAISE-ERROR is non-nil, in which case an error is signaled if | |
187 | `call-process' returns non-0." | |
188 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
189 | (erase-buffer) | |
190 | (let ((value | |
191 | (apply 'call-process | |
192 | (expand-file-name command mh-progs) nil t nil | |
193 | args))) | |
194 | (goto-char (point-min)) | |
195 | (if raise-error | |
196 | (mh-handle-process-error command value) | |
197 | value))) | |
198 | ||
199 | ;; Shush compiler. | |
200 | (eval-when-compile (defvar mark-active)) | |
201 | ||
202 | (defun mh-exec-cmd-output (command display &rest args) | |
203 | "Execute MH command COMMAND with DISPLAY flag and ARGS. | |
204 | Put the output into buffer after point. | |
205 | Set mark after inserted text. | |
206 | Output is expected to be shown to user, not parsed by MH-E." | |
207 | (push-mark (point) t) | |
208 | (apply 'call-process | |
209 | (expand-file-name command mh-progs) nil t display | |
210 | (mh-list-to-string args)) | |
211 | ||
212 | ;; The following is used instead of 'exchange-point-and-mark because the | |
213 | ;; latter activates the current region (between point and mark), which | |
214 | ;; turns on highlighting. So prior to this bug fix, doing "inc" would | |
215 | ;; highlight a region containing the new messages, which is undesirable. | |
216 | ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. | |
217 | (mh-exchange-point-and-mark-preserving-active-mark)) | |
218 | ||
219 | (defun mh-exchange-point-and-mark-preserving-active-mark () | |
220 | "Put the mark where point is now, and point where the mark is now. | |
221 | This command works even when the mark is not active, and | |
222 | preserves whether the mark is active or not." | |
223 | (interactive nil) | |
224 | (let ((is-active (and (boundp 'mark-active) mark-active))) | |
225 | (let ((omark (mark t))) | |
226 | (if (null omark) | |
227 | (error "No mark set in this buffer")) | |
228 | (set-mark (point)) | |
229 | (goto-char omark) | |
230 | (if (boundp 'mark-active) | |
231 | (setq mark-active is-active)) | |
232 | nil))) | |
233 | ||
234 | (defun mh-exec-lib-cmd-output (command &rest args) | |
235 | "Execute MH library command COMMAND with ARGS. | |
236 | Put the output into buffer after point. | |
237 | Set mark after inserted text." | |
238 | (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) | |
239 | ||
240 | (defun mh-handle-process-error (command status) | |
241 | "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." | |
242 | (if (equal status 0) | |
243 | status | |
244 | (goto-char (point-min)) | |
245 | (insert (if (integerp status) | |
246 | (format "%s: exit code %d\n" command status) | |
247 | (format "%s: %s\n" command status))) | |
248 | (save-excursion | |
249 | (let ((error-message (buffer-substring (point-min) (point-max)))) | |
250 | (set-buffer (get-buffer-create mh-log-buffer)) | |
251 | (mh-truncate-log-buffer) | |
252 | (insert error-message))) | |
253 | (error "%s failed, check buffer %s for error message" | |
254 | command mh-log-buffer))) | |
255 | ||
256 | (provide 'mh-exec) | |
257 | ||
258 | ;; Local Variables: | |
259 | ;; indent-tabs-mode: nil | |
260 | ;; sentence-end-double-space: nil | |
261 | ;; End: | |
262 | ||
28f74fdf | 263 | ;; arch-tag: 2857996c-e624-46b2-a58d-979cd279d288 |
30f24016 | 264 | ;;; mh-utils.el ends here |