diff options
| author | Bill Wohler | 2006-01-15 08:17:56 +0000 |
|---|---|---|
| committer | Bill Wohler | 2006-01-15 08:17:56 +0000 |
| commit | 30f240162b6647aa84aed84b4e51fd381e18b5eb (patch) | |
| tree | 91c9e810f9f0b900119d98e09edaea5ec4b94c13 | |
| parent | d83d8efe0bd87813f2859d74c2203c5c1c190459 (diff) | |
| download | emacs-30f240162b6647aa84aed84b4e51fd381e18b5eb.tar.gz emacs-30f240162b6647aa84aed84b4e51fd381e18b5eb.zip | |
* 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.
| -rw-r--r-- | lisp/mh-e/ChangeLog | 44 | ||||
| -rw-r--r-- | lisp/mh-e/mh-alias.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-comp.el | 5 | ||||
| -rw-r--r-- | lisp/mh-e/mh-customize.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-e.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-exec.el | 239 | ||||
| -rw-r--r-- | lisp/mh-e/mh-funcs.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-gnus.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-identity.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-inc.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-init.el | 29 | ||||
| -rw-r--r-- | lisp/mh-e/mh-junk.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-mime.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-print.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-search.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-seq.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-speed.el | 3 | ||||
| -rw-r--r-- | lisp/mh-e/mh-utils.el | 222 |
18 files changed, 344 insertions, 222 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index f99269fb555..fb3b1d70069 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog | |||
| @@ -1,3 +1,47 @@ | |||
| 1 | 2006-01-15 Bill Wohler <wohler@newt.com> | ||
| 2 | |||
| 3 | * mh-comp.el (mh-pgp-support-flag): Move here from mh-utils.el; | ||
| 4 | needed to help remove dependency on mh-utils. | ||
| 5 | |||
| 6 | * mh-exec.el: New file. Move process support routines here from | ||
| 7 | mh-utils.el. | ||
| 8 | |||
| 9 | * mh-init.el (mh-utils): Remove require. | ||
| 10 | (mh-exec): Add require. | ||
| 11 | (mh-profile-component, mh-profile-component-value): Move here from | ||
| 12 | mh-utils.el. | ||
| 13 | |||
| 14 | * mh-utils.el (mh-pgp-support-flag): Move to mh-comp.el to reduce | ||
| 15 | dependencies on mh-utils.el. | ||
| 16 | (mh-profile-component, mh-profile-component-value): Move to | ||
| 17 | mh-init.el since that's the only place that uses them. (Other than | ||
| 18 | mh-alias.el; I'm thinking that mh-find-path can set variable from | ||
| 19 | the Aliasfile component like it does the other components). | ||
| 20 | (mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell) | ||
| 21 | (mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon) | ||
| 22 | (mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet) | ||
| 23 | (defvar, mh-exec-cmd-output) | ||
| 24 | (mh-exchange-point-and-mark-preserving-active-mark) | ||
| 25 | (mh-exec-lib-cmd-output, mh-handle-process-error): Move to new | ||
| 26 | file mh-exec.el so that mh-init.el doesn't have to depend on | ||
| 27 | mh-utils.el, breaking circular dependency. | ||
| 28 | |||
| 29 | * mh-alias.el: | ||
| 30 | * mh-customize.el: | ||
| 31 | * mh-e.el: | ||
| 32 | * mh-funcs.el: | ||
| 33 | * mh-gnus.el: | ||
| 34 | * mh-identity.el: | ||
| 35 | * mh-inc.el: | ||
| 36 | * mh-junk.el: | ||
| 37 | * mh-mime.el: | ||
| 38 | * mh-print.el: | ||
| 39 | * mh-search.el: | ||
| 40 | * mh-seq.el: | ||
| 41 | * mh-speed.el: Added debugging statements (commented out) around | ||
| 42 | requires to help find dependency loops. Will remove them when | ||
| 43 | issues are resolved. | ||
| 44 | |||
| 1 | 2006-01-14 Bill Wohler <wohler@newt.com> | 45 | 2006-01-14 Bill Wohler <wohler@newt.com> |
| 2 | 46 | ||
| 3 | * mh-customize.el (mh-index): Rename group to mh-search and sort | 47 | * mh-customize.el (mh-index): Rename group to mh-search and sort |
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index af369e0a477..399113e318d 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el | |||
| @@ -31,10 +31,12 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | ;;(message "> mh-alias") | ||
| 34 | (eval-when-compile (require 'mh-acros)) | 35 | (eval-when-compile (require 'mh-acros)) |
| 35 | (mh-require-cl) | 36 | (mh-require-cl) |
| 36 | (require 'mh-buffers) | 37 | (require 'mh-buffers) |
| 37 | (require 'mh-e) | 38 | (require 'mh-e) |
| 39 | ;;(message "< mh-alias") | ||
| 38 | (load "cmr" t t) ; Non-fatal dependency for | 40 | (load "cmr" t t) ; Non-fatal dependency for |
| 39 | ; completing-read-multiple. | 41 | ; completing-read-multiple. |
| 40 | (eval-when-compile (defvar mail-abbrev-syntax-table)) | 42 | (eval-when-compile (defvar mail-abbrev-syntax-table)) |
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 6457638b29a..07f4bc60dc7 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el | |||
| @@ -33,6 +33,7 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | ;;(message "> mh-comp") | ||
| 36 | (eval-when-compile (require 'mh-acros)) | 37 | (eval-when-compile (require 'mh-acros)) |
| 37 | (mh-require-cl) | 38 | (mh-require-cl) |
| 38 | 39 | ||
| @@ -44,6 +45,7 @@ | |||
| 44 | 45 | ||
| 45 | (eval-when (compile load eval) | 46 | (eval-when (compile load eval) |
| 46 | (ignore-errors (require 'mailabbrev))) | 47 | (ignore-errors (require 'mailabbrev))) |
| 48 | ;;(message "< mh-comp") | ||
| 47 | 49 | ||
| 48 | 50 | ||
| 49 | 51 | ||
| @@ -862,6 +864,9 @@ Returns t if found, nil if not." | |||
| 862 | 864 | ||
| 863 | ;;; Mode for composing and sending a draft message. | 865 | ;;; Mode for composing and sending a draft message. |
| 864 | 866 | ||
| 867 | (defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) | ||
| 868 | "Non-nil means PGP support is available.") | ||
| 869 | |||
| 865 | (put 'mh-letter-mode 'mode-class 'special) | 870 | (put 'mh-letter-mode 'mode-class 'special) |
| 866 | 871 | ||
| 867 | ;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) | 872 | ;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) |
diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el index 17df6397938..7089636d9fb 100644 --- a/lisp/mh-e/mh-customize.el +++ b/lisp/mh-e/mh-customize.el | |||
| @@ -63,6 +63,7 @@ | |||
| 63 | 63 | ||
| 64 | ;;; Code: | 64 | ;;; Code: |
| 65 | 65 | ||
| 66 | ;;(message "> mh-customize") | ||
| 66 | (provide 'mh-customize) | 67 | (provide 'mh-customize) |
| 67 | 68 | ||
| 68 | (eval-when-compile (require 'mh-acros)) | 69 | (eval-when-compile (require 'mh-acros)) |
| @@ -78,6 +79,7 @@ | |||
| 78 | (require 'mh-identity) | 79 | (require 'mh-identity) |
| 79 | (require 'mh-init) | 80 | (require 'mh-init) |
| 80 | (require 'mh-loaddefs)) | 81 | (require 'mh-loaddefs)) |
| 82 | ;;(message "< mh-customize") | ||
| 81 | 83 | ||
| 82 | ;; For compiler warnings... | 84 | ;; For compiler warnings... |
| 83 | (eval-when-compile | 85 | (eval-when-compile |
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 42697ed6c8a..8319738d482 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el | |||
| @@ -85,6 +85,7 @@ | |||
| 85 | 85 | ||
| 86 | ;;; Code: | 86 | ;;; Code: |
| 87 | 87 | ||
| 88 | ;;(message "> mh-e") | ||
| 88 | (provide 'mh-e) | 89 | (provide 'mh-e) |
| 89 | 90 | ||
| 90 | (eval-when-compile (require 'mh-acros)) | 91 | (eval-when-compile (require 'mh-acros)) |
| @@ -95,6 +96,7 @@ | |||
| 95 | (require 'mh-buffers) | 96 | (require 'mh-buffers) |
| 96 | (require 'mh-seq) | 97 | (require 'mh-seq) |
| 97 | (require 'mh-utils) | 98 | (require 'mh-utils) |
| 99 | ;;(message "< mh-e") | ||
| 98 | 100 | ||
| 99 | (defconst mh-version "7.85+cvs" "Version number of MH-E.") | 101 | (defconst mh-version "7.85+cvs" "Version number of MH-E.") |
| 100 | 102 | ||
diff --git a/lisp/mh-e/mh-exec.el b/lisp/mh-e/mh-exec.el new file mode 100644 index 00000000000..71e40e5bdb0 --- /dev/null +++ b/lisp/mh-e/mh-exec.el | |||
| @@ -0,0 +1,239 @@ | |||
| 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 | ||
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index ac5f80adbff..b05fdd9fc02 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el | |||
| @@ -35,10 +35,12 @@ | |||
| 35 | 35 | ||
| 36 | ;;; Code: | 36 | ;;; Code: |
| 37 | 37 | ||
| 38 | ;;(message "> mh-funcs") | ||
| 38 | (eval-when-compile (require 'mh-acros)) | 39 | (eval-when-compile (require 'mh-acros)) |
| 39 | (mh-require-cl) | 40 | (mh-require-cl) |
| 40 | (require 'mh-buffers) | 41 | (require 'mh-buffers) |
| 41 | (require 'mh-e) | 42 | (require 'mh-e) |
| 43 | ;;(message "< mh-funcs") | ||
| 42 | 44 | ||
| 43 | 45 | ||
| 44 | 46 | ||
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 6e9698901bd..2a5a9989b37 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el | |||
| @@ -30,7 +30,9 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Code: | 31 | ;;; Code: |
| 32 | 32 | ||
| 33 | ;;(message "> mh-gnus") | ||
| 33 | (eval-when-compile (require 'mh-acros)) | 34 | (eval-when-compile (require 'mh-acros)) |
| 35 | ;;(message "< mh-gnus") | ||
| 34 | 36 | ||
| 35 | ;; Load libraries in a non-fatal way in order to see if certain functions are | 37 | ;; Load libraries in a non-fatal way in order to see if certain functions are |
| 36 | ;; pre-defined. | 38 | ;; pre-defined. |
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index 5f17d0be4ef..92467b783a9 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el | |||
| @@ -39,9 +39,11 @@ | |||
| 39 | 39 | ||
| 40 | ;;; Code: | 40 | ;;; Code: |
| 41 | 41 | ||
| 42 | ;;(message "> mh-identity") | ||
| 42 | (eval-when-compile (require 'mh-acros)) | 43 | (eval-when-compile (require 'mh-acros)) |
| 43 | 44 | ||
| 44 | (require 'mh-comp) | 45 | (require 'mh-comp) |
| 46 | ;;(message "< mh-identity") | ||
| 45 | 47 | ||
| 46 | (autoload 'mml-insert-tag "mml") | 48 | (autoload 'mml-insert-tag "mml") |
| 47 | 49 | ||
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el index 60765316c7a..72d84353ff6 100644 --- a/lisp/mh-e/mh-inc.el +++ b/lisp/mh-e/mh-inc.el | |||
| @@ -34,8 +34,10 @@ | |||
| 34 | 34 | ||
| 35 | ;;; Code: | 35 | ;;; Code: |
| 36 | 36 | ||
| 37 | ;;(message "> mh-inc") | ||
| 37 | (eval-when-compile (require 'mh-acros)) | 38 | (eval-when-compile (require 'mh-acros)) |
| 38 | (mh-require-cl) | 39 | (mh-require-cl) |
| 40 | ;;(message "< mh-inc") | ||
| 39 | 41 | ||
| 40 | (defvar mh-inc-spool-map (make-sparse-keymap) | 42 | (defvar mh-inc-spool-map (make-sparse-keymap) |
| 41 | "Keymap for MH-E's mh-inc-spool commands.") | 43 | "Keymap for MH-E's mh-inc-spool commands.") |
diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el index 6d2f5f5d137..86a62768980 100644 --- a/lisp/mh-e/mh-init.el +++ b/lisp/mh-e/mh-init.el | |||
| @@ -39,10 +39,12 @@ | |||
| 39 | 39 | ||
| 40 | ;;; Code: | 40 | ;;; Code: |
| 41 | 41 | ||
| 42 | ;;(message "> mh-init") | ||
| 42 | (eval-when-compile (require 'mh-acros)) | 43 | (eval-when-compile (require 'mh-acros)) |
| 43 | (mh-require-cl) | 44 | (mh-require-cl) |
| 44 | (require 'mh-buffers) | 45 | (require 'mh-buffers) |
| 45 | (require 'mh-utils) | 46 | (require 'mh-exec) |
| 47 | ;;(message "< mh-init") | ||
| 46 | 48 | ||
| 47 | (defvar mh-sys-path | 49 | (defvar mh-sys-path |
| 48 | '("/usr/local/nmh/bin" ; nmh default | 50 | '("/usr/local/nmh/bin" ; nmh default |
| @@ -357,6 +359,31 @@ MH-E." | |||
| 357 | 359 | ||
| 358 | 360 | ||
| 359 | 361 | ||
| 362 | ;;; MH profile | ||
| 363 | |||
| 364 | (defun mh-profile-component (component) | ||
| 365 | "Return COMPONENT value from mhparam, or nil if unset." | ||
| 366 | (save-excursion | ||
| 367 | (mh-exec-cmd-quiet nil "mhparam" "-components" component) | ||
| 368 | (mh-profile-component-value component))) | ||
| 369 | |||
| 370 | (defun mh-profile-component-value (component) | ||
| 371 | "Find and return the value of COMPONENT in the current buffer. | ||
| 372 | Returns nil if the component is not in the buffer." | ||
| 373 | (let ((case-fold-search t)) | ||
| 374 | (goto-char (point-min)) | ||
| 375 | (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) | ||
| 376 | ((looking-at "[\t ]*$") nil) | ||
| 377 | (t | ||
| 378 | (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) | ||
| 379 | (let ((start (match-beginning 1))) | ||
| 380 | (end-of-line) | ||
| 381 | (buffer-substring start (point))))))) | ||
| 382 | |||
| 383 | |||
| 384 | |||
| 385 | ;;; MH-E images | ||
| 386 | |||
| 360 | ;; Shush compiler. | 387 | ;; Shush compiler. |
| 361 | (eval-when-compile (defvar image-load-path)) | 388 | (eval-when-compile (defvar image-load-path)) |
| 362 | 389 | ||
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index c94bb153025..24a2e3020e1 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el | |||
| @@ -32,10 +32,12 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| 35 | ;;(message "< mh-junk") | ||
| 35 | (eval-when-compile (require 'mh-acros)) | 36 | (eval-when-compile (require 'mh-acros)) |
| 36 | (mh-require-cl) | 37 | (mh-require-cl) |
| 37 | (require 'mh-buffers) | 38 | (require 'mh-buffers) |
| 38 | (require 'mh-e) | 39 | (require 'mh-e) |
| 40 | ;;(message "> mh-junk") | ||
| 39 | 41 | ||
| 40 | ;; Interactive functions callable from the folder buffer | 42 | ;; Interactive functions callable from the folder buffer |
| 41 | ;;;###mh-autoload | 43 | ;;;###mh-autoload |
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 613eec23fe1..0f2396d1804 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el | |||
| @@ -36,6 +36,7 @@ | |||
| 36 | 36 | ||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | ;;(message "> mh-mime") | ||
| 39 | (eval-when-compile (require 'mh-acros)) | 40 | (eval-when-compile (require 'mh-acros)) |
| 40 | (mh-require-cl) | 41 | (mh-require-cl) |
| 41 | 42 | ||
| @@ -43,6 +44,7 @@ | |||
| 43 | (require 'mh-buffers) | 44 | (require 'mh-buffers) |
| 44 | (require 'mh-comp) | 45 | (require 'mh-comp) |
| 45 | (require 'mh-gnus) | 46 | (require 'mh-gnus) |
| 47 | ;;(message "< mh-mime") | ||
| 46 | 48 | ||
| 47 | (autoload 'article-emphasize "gnus-art") | 49 | (autoload 'article-emphasize "gnus-art") |
| 48 | (autoload 'gnus-article-goto-header "gnus-art") | 50 | (autoload 'gnus-article-goto-header "gnus-art") |
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el index fd837072014..79534789caf 100644 --- a/lisp/mh-e/mh-print.el +++ b/lisp/mh-e/mh-print.el | |||
| @@ -30,6 +30,7 @@ | |||
| 30 | 30 | ||
| 31 | ;;; Code: | 31 | ;;; Code: |
| 32 | 32 | ||
| 33 | ;;(message "> mh-print") | ||
| 33 | (eval-when-compile (require 'mh-acros)) | 34 | (eval-when-compile (require 'mh-acros)) |
| 34 | (mh-require-cl) | 35 | (mh-require-cl) |
| 35 | (require 'ps-print) | 36 | (require 'ps-print) |
| @@ -37,6 +38,7 @@ | |||
| 37 | (require 'mh-utils) | 38 | (require 'mh-utils) |
| 38 | (require 'mh-funcs) | 39 | (require 'mh-funcs) |
| 39 | (eval-when-compile (require 'mh-seq)) | 40 | (eval-when-compile (require 'mh-seq)) |
| 41 | ;;(message "< mh-print") | ||
| 40 | 42 | ||
| 41 | (defvar mh-ps-print-color-option ps-print-color-p | 43 | (defvar mh-ps-print-color-option ps-print-color-p |
| 42 | "Specify how buffer's text color is printed. | 44 | "Specify how buffer's text color is printed. |
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index e98e376b87b..55cbd02dd97 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el | |||
| @@ -44,12 +44,14 @@ | |||
| 44 | 44 | ||
| 45 | ;;; Code: | 45 | ;;; Code: |
| 46 | 46 | ||
| 47 | ;;(message "> mh-search") | ||
| 47 | (eval-when-compile (require 'mh-acros)) | 48 | (eval-when-compile (require 'mh-acros)) |
| 48 | (mh-require-cl) | 49 | (mh-require-cl) |
| 49 | 50 | ||
| 50 | (require 'gnus-util) | 51 | (require 'gnus-util) |
| 51 | (require 'mh-buffers) | 52 | (require 'mh-buffers) |
| 52 | (require 'mh-e) | 53 | (require 'mh-e) |
| 54 | ;;(message "< mh-search") | ||
| 53 | 55 | ||
| 54 | (defvar mh-searcher nil | 56 | (defvar mh-searcher nil |
| 55 | "Cached value of chosen search program.") | 57 | "Cached value of chosen search program.") |
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index d5e5c7f6a2d..4f2f7de5916 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el | |||
| @@ -71,11 +71,13 @@ | |||
| 71 | 71 | ||
| 72 | ;;; Code: | 72 | ;;; Code: |
| 73 | 73 | ||
| 74 | ;;(message "> mh-seq") | ||
| 74 | (eval-when-compile (require 'mh-acros)) | 75 | (eval-when-compile (require 'mh-acros)) |
| 75 | (mh-require-cl) | 76 | (mh-require-cl) |
| 76 | 77 | ||
| 77 | (require 'mh-buffers) | 78 | (require 'mh-buffers) |
| 78 | (require 'mh-e) | 79 | (require 'mh-e) |
| 80 | ;;(message "< mh-seq") | ||
| 79 | 81 | ||
| 80 | 82 | ||
| 81 | 83 | ||
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 5c7f5cda3ba..5019381ac3c 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el | |||
| @@ -33,12 +33,13 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | ;; Requires | 36 | ;;(message "> mh-speed") |
| 37 | (eval-when-compile (require 'mh-acros)) | 37 | (eval-when-compile (require 'mh-acros)) |
| 38 | (mh-require-cl) | 38 | (mh-require-cl) |
| 39 | (require 'mh-e) | 39 | (require 'mh-e) |
| 40 | (require 'speedbar) | 40 | (require 'speedbar) |
| 41 | (require 'timer) | 41 | (require 'timer) |
| 42 | ;;(message "< mh-speed") | ||
| 42 | 43 | ||
| 43 | ;; Global variables | 44 | ;; Global variables |
| 44 | (defvar mh-speed-refresh-flag nil) | 45 | (defvar mh-speed-refresh-flag nil) |
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 63ba0def8ff..b37326b7701 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el | |||
| @@ -33,6 +33,7 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | ;;(message "> mh-utils") | ||
| 36 | (eval-and-compile | 37 | (eval-and-compile |
| 37 | (defvar recursive-load-depth-limit) | 38 | (defvar recursive-load-depth-limit) |
| 38 | (if (and (boundp 'recursive-load-depth-limit) | 39 | (if (and (boundp 'recursive-load-depth-limit) |
| @@ -50,6 +51,7 @@ | |||
| 50 | (require 'mh-inc) | 51 | (require 'mh-inc) |
| 51 | (require 'mouse) | 52 | (require 'mouse) |
| 52 | (require 'sendmail) | 53 | (require 'sendmail) |
| 54 | ;;(message "< mh-utils") | ||
| 53 | 55 | ||
| 54 | ;; Non-fatal dependencies | 56 | ;; Non-fatal dependencies |
| 55 | (load "hl-line" t t) | 57 | (load "hl-line" t t) |
| @@ -197,9 +199,6 @@ when searching for a separator.") | |||
| 197 | (defvar mh-globals-hash (make-hash-table) | 199 | (defvar mh-globals-hash (make-hash-table) |
| 198 | "Keeps track of MIME data on a per buffer basis.") | 200 | "Keeps track of MIME data on a per buffer basis.") |
| 199 | 201 | ||
| 200 | (defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) | ||
| 201 | "Non-nil means PGP support is available.") | ||
| 202 | |||
| 203 | (defvar mh-mm-inline-media-tests | 202 | (defvar mh-mm-inline-media-tests |
| 204 | `(("image/jpeg" | 203 | `(("image/jpeg" |
| 205 | mm-inline-image | 204 | mm-inline-image |
| @@ -1954,25 +1953,6 @@ the message." | |||
| 1954 | (or dont-show (not return-value) (mh-maybe-show number)) | 1953 | (or dont-show (not return-value) (mh-maybe-show number)) |
| 1955 | return-value)) | 1954 | return-value)) |
| 1956 | 1955 | ||
| 1957 | (defun mh-profile-component (component) | ||
| 1958 | "Return COMPONENT value from mhparam, or nil if unset." | ||
| 1959 | (save-excursion | ||
| 1960 | (mh-exec-cmd-quiet nil "mhparam" "-components" component) | ||
| 1961 | (mh-profile-component-value component))) | ||
| 1962 | |||
| 1963 | (defun mh-profile-component-value (component) | ||
| 1964 | "Find and return the value of COMPONENT in the current buffer. | ||
| 1965 | Returns nil if the component is not in the buffer." | ||
| 1966 | (let ((case-fold-search t)) | ||
| 1967 | (goto-char (point-min)) | ||
| 1968 | (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) | ||
| 1969 | ((looking-at "[\t ]*$") nil) | ||
| 1970 | (t | ||
| 1971 | (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) | ||
| 1972 | (let ((start (match-beginning 1))) | ||
| 1973 | (end-of-line) | ||
| 1974 | (buffer-substring start (point))))))) | ||
| 1975 | |||
| 1976 | (defun mh-set-folder-modified-p (flag) | 1956 | (defun mh-set-folder-modified-p (flag) |
| 1977 | "Mark current folder as modified or unmodified according to FLAG." | 1957 | "Mark current folder as modified or unmodified according to FLAG." |
| 1978 | (set-buffer-modified-p flag)) | 1958 | (set-buffer-modified-p flag)) |
| @@ -2428,204 +2408,6 @@ used in searching." | |||
| 2428 | 2408 | ||
| 2429 | 2409 | ||
| 2430 | 2410 | ||
| 2431 | ;;; Issue shell and MH commands. | ||
| 2432 | |||
| 2433 | (defvar mh-index-max-cmdline-args 500 | ||
| 2434 | "Maximum number of command line args.") | ||
| 2435 | |||
| 2436 | (defun mh-xargs (cmd &rest args) | ||
| 2437 | "Partial imitation of xargs. | ||
| 2438 | The current buffer contains a list of strings, one on each line. | ||
| 2439 | The function will execute CMD with ARGS and pass the first | ||
| 2440 | `mh-index-max-cmdline-args' strings to it. This is repeated till | ||
| 2441 | all the strings have been used." | ||
| 2442 | (goto-char (point-min)) | ||
| 2443 | (let ((current-buffer (current-buffer))) | ||
| 2444 | (with-temp-buffer | ||
| 2445 | (let ((out (current-buffer))) | ||
| 2446 | (set-buffer current-buffer) | ||
| 2447 | (while (not (eobp)) | ||
| 2448 | (let ((arg-list (reverse args)) | ||
| 2449 | (count 0)) | ||
| 2450 | (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | ||
| 2451 | (push (buffer-substring-no-properties (point) (line-end-position)) | ||
| 2452 | arg-list) | ||
| 2453 | (incf count) | ||
| 2454 | (forward-line)) | ||
| 2455 | (apply #'call-process cmd nil (list out nil) nil | ||
| 2456 | (nreverse arg-list)))) | ||
| 2457 | (erase-buffer) | ||
| 2458 | (insert-buffer-substring out))))) | ||
| 2459 | |||
| 2460 | ;; XXX This should be applied anywhere MH-E calls out to /bin/sh. | ||
| 2461 | (defun mh-quote-for-shell (string) | ||
| 2462 | "Quote STRING for /bin/sh. | ||
| 2463 | Adds double-quotes around entire string and quotes the characters | ||
| 2464 | \\, `, and $ with a backslash." | ||
| 2465 | (concat "\"" | ||
| 2466 | (loop for x across string | ||
| 2467 | concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) | ||
| 2468 | "\"")) | ||
| 2469 | |||
| 2470 | (defun mh-exec-cmd (command &rest args) | ||
| 2471 | "Execute mh-command COMMAND with ARGS. | ||
| 2472 | The side effects are what is desired. Any output is assumed to be | ||
| 2473 | an error and is shown to the user. The output is not read or | ||
| 2474 | parsed by MH-E." | ||
| 2475 | (save-excursion | ||
| 2476 | (set-buffer (get-buffer-create mh-log-buffer)) | ||
| 2477 | (let* ((initial-size (mh-truncate-log-buffer)) | ||
| 2478 | (start (point)) | ||
| 2479 | (args (mh-list-to-string args))) | ||
| 2480 | (apply 'call-process (expand-file-name command mh-progs) nil t nil args) | ||
| 2481 | (when (> (buffer-size) initial-size) | ||
| 2482 | (save-excursion | ||
| 2483 | (goto-char start) | ||
| 2484 | (insert "Errors when executing: " command) | ||
| 2485 | (loop for arg in args do (insert " " arg)) | ||
| 2486 | (insert "\n")) | ||
| 2487 | (save-window-excursion | ||
| 2488 | (switch-to-buffer-other-window mh-log-buffer) | ||
| 2489 | (sit-for 5)))))) | ||
| 2490 | |||
| 2491 | (defun mh-exec-cmd-error (env command &rest args) | ||
| 2492 | "In environment ENV, execute mh-command COMMAND with ARGS. | ||
| 2493 | ENV is nil or a string of space-separated \"var=value\" elements. | ||
| 2494 | Signals an error if process does not complete successfully." | ||
| 2495 | (save-excursion | ||
| 2496 | (set-buffer (get-buffer-create mh-temp-buffer)) | ||
| 2497 | (erase-buffer) | ||
| 2498 | (let ((process-environment process-environment)) | ||
| 2499 | ;; XXX: We should purge the list that split-string returns of empty | ||
| 2500 | ;; strings. This can happen in XEmacs if leading or trailing spaces | ||
| 2501 | ;; are present. | ||
| 2502 | (dolist (elem (if (stringp env) (split-string env " ") ())) | ||
| 2503 | (push elem process-environment)) | ||
| 2504 | (mh-handle-process-error | ||
| 2505 | command (apply #'call-process (expand-file-name command mh-progs) | ||
| 2506 | nil t nil (mh-list-to-string args)))))) | ||
| 2507 | |||
| 2508 | (defun mh-exec-cmd-daemon (command filter &rest args) | ||
| 2509 | "Execute MH command COMMAND in the background. | ||
| 2510 | |||
| 2511 | If FILTER is non-nil then it is used to process the output | ||
| 2512 | otherwise the default filter `mh-process-daemon' is used. See | ||
| 2513 | `set-process-filter' for more details of FILTER. | ||
| 2514 | |||
| 2515 | ARGS are passed to COMMAND as command line arguments." | ||
| 2516 | (save-excursion | ||
| 2517 | (set-buffer (get-buffer-create mh-log-buffer)) | ||
| 2518 | (mh-truncate-log-buffer)) | ||
| 2519 | (let* ((process-connection-type nil) | ||
| 2520 | (process (apply 'start-process | ||
| 2521 | command nil | ||
| 2522 | (expand-file-name command mh-progs) | ||
| 2523 | (mh-list-to-string args)))) | ||
| 2524 | (set-process-filter process (or filter 'mh-process-daemon)) | ||
| 2525 | process)) | ||
| 2526 | |||
| 2527 | (defun mh-exec-cmd-env-daemon (env command filter &rest args) | ||
| 2528 | "In ennvironment ENV, execute mh-command COMMAND in the background. | ||
| 2529 | |||
| 2530 | ENV is nil or a string of space-separated \"var=value\" elements. | ||
| 2531 | Signals an error if process does not complete successfully. | ||
| 2532 | |||
| 2533 | If FILTER is non-nil then it is used to process the output | ||
| 2534 | otherwise the default filter `mh-process-daemon' is used. See | ||
| 2535 | `set-process-filter' for more details of FILTER. | ||
| 2536 | |||
| 2537 | ARGS are passed to COMMAND as command line arguments." | ||
| 2538 | (let ((process-environment process-environment)) | ||
| 2539 | (dolist (elem (if (stringp env) (split-string env " ") ())) | ||
| 2540 | (push elem process-environment)) | ||
| 2541 | (apply #'mh-exec-cmd-daemon command filter args))) | ||
| 2542 | |||
| 2543 | (defun mh-process-daemon (process output) | ||
| 2544 | "PROCESS daemon that puts OUTPUT into a temporary buffer. | ||
| 2545 | Any output from the process is displayed in an asynchronous | ||
| 2546 | pop-up window." | ||
| 2547 | (with-current-buffer (get-buffer-create mh-log-buffer) | ||
| 2548 | (insert-before-markers output) | ||
| 2549 | (display-buffer mh-log-buffer))) | ||
| 2550 | |||
| 2551 | (defun mh-exec-cmd-quiet (raise-error command &rest args) | ||
| 2552 | "Signal RAISE-ERROR if COMMAND with ARGS fails. | ||
| 2553 | Execute MH command COMMAND with ARGS. ARGS is a list of strings. | ||
| 2554 | Return at start of mh-temp buffer, where output can be parsed and | ||
| 2555 | used. | ||
| 2556 | Returns value of `call-process', which is 0 for success, unless | ||
| 2557 | RAISE-ERROR is non-nil, in which case an error is signaled if | ||
| 2558 | `call-process' returns non-0." | ||
| 2559 | (set-buffer (get-buffer-create mh-temp-buffer)) | ||
| 2560 | (erase-buffer) | ||
| 2561 | (let ((value | ||
| 2562 | (apply 'call-process | ||
| 2563 | (expand-file-name command mh-progs) nil t nil | ||
| 2564 | args))) | ||
| 2565 | (goto-char (point-min)) | ||
| 2566 | (if raise-error | ||
| 2567 | (mh-handle-process-error command value) | ||
| 2568 | value))) | ||
| 2569 | |||
| 2570 | ;; Shush compiler. | ||
| 2571 | (eval-when-compile (defvar mark-active)) | ||
| 2572 | |||
| 2573 | (defun mh-exec-cmd-output (command display &rest args) | ||
| 2574 | "Execute MH command COMMAND with DISPLAY flag and ARGS. | ||
| 2575 | Put the output into buffer after point. | ||
| 2576 | Set mark after inserted text. | ||
| 2577 | Output is expected to be shown to user, not parsed by MH-E." | ||
| 2578 | (push-mark (point) t) | ||
| 2579 | (apply 'call-process | ||
| 2580 | (expand-file-name command mh-progs) nil t display | ||
| 2581 | (mh-list-to-string args)) | ||
| 2582 | |||
| 2583 | ;; The following is used instead of 'exchange-point-and-mark because the | ||
| 2584 | ;; latter activates the current region (between point and mark), which | ||
| 2585 | ;; turns on highlighting. So prior to this bug fix, doing "inc" would | ||
| 2586 | ;; highlight a region containing the new messages, which is undesirable. | ||
| 2587 | ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. | ||
| 2588 | (mh-exchange-point-and-mark-preserving-active-mark)) | ||
| 2589 | |||
| 2590 | (defun mh-exchange-point-and-mark-preserving-active-mark () | ||
| 2591 | "Put the mark where point is now, and point where the mark is now. | ||
| 2592 | This command works even when the mark is not active, and | ||
| 2593 | preserves whether the mark is active or not." | ||
| 2594 | (interactive nil) | ||
| 2595 | (let ((is-active (and (boundp 'mark-active) mark-active))) | ||
| 2596 | (let ((omark (mark t))) | ||
| 2597 | (if (null omark) | ||
| 2598 | (error "No mark set in this buffer")) | ||
| 2599 | (set-mark (point)) | ||
| 2600 | (goto-char omark) | ||
| 2601 | (if (boundp 'mark-active) | ||
| 2602 | (setq mark-active is-active)) | ||
| 2603 | nil))) | ||
| 2604 | |||
| 2605 | (defun mh-exec-lib-cmd-output (command &rest args) | ||
| 2606 | "Execute MH library command COMMAND with ARGS. | ||
| 2607 | Put the output into buffer after point. | ||
| 2608 | Set mark after inserted text." | ||
| 2609 | (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) | ||
| 2610 | |||
| 2611 | (defun mh-handle-process-error (command status) | ||
| 2612 | "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." | ||
| 2613 | (if (equal status 0) | ||
| 2614 | status | ||
| 2615 | (goto-char (point-min)) | ||
| 2616 | (insert (if (integerp status) | ||
| 2617 | (format "%s: exit code %d\n" command status) | ||
| 2618 | (format "%s: %s\n" command status))) | ||
| 2619 | (save-excursion | ||
| 2620 | (let ((error-message (buffer-substring (point-min) (point-max)))) | ||
| 2621 | (set-buffer (get-buffer-create mh-log-buffer)) | ||
| 2622 | (mh-truncate-log-buffer) | ||
| 2623 | (insert error-message))) | ||
| 2624 | (error "%s failed, check buffer %s for error message" | ||
| 2625 | command mh-log-buffer))) | ||
| 2626 | |||
| 2627 | |||
| 2628 | |||
| 2629 | ;;; List and string manipulation | 2411 | ;;; List and string manipulation |
| 2630 | 2412 | ||
| 2631 | (defun mh-list-to-string (l) | 2413 | (defun mh-list-to-string (l) |