Mercurial > emacs
changeset 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 | f00134dbd2a6 |
children | 5fc4d9faaa2f |
files | lisp/mh-e/ChangeLog lisp/mh-e/mh-alias.el lisp/mh-e/mh-comp.el lisp/mh-e/mh-customize.el lisp/mh-e/mh-e.el lisp/mh-e/mh-exec.el lisp/mh-e/mh-funcs.el lisp/mh-e/mh-gnus.el lisp/mh-e/mh-identity.el lisp/mh-e/mh-inc.el lisp/mh-e/mh-init.el lisp/mh-e/mh-junk.el lisp/mh-e/mh-mime.el lisp/mh-e/mh-print.el lisp/mh-e/mh-search.el lisp/mh-e/mh-seq.el lisp/mh-e/mh-speed.el lisp/mh-e/mh-utils.el |
diffstat | 18 files changed, 344 insertions(+), 222 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mh-e/ChangeLog Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/ChangeLog Sun Jan 15 08:17:56 2006 +0000 @@ -1,3 +1,47 @@ +2006-01-15 Bill Wohler <wohler@newt.com> + + * 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. + 2006-01-14 Bill Wohler <wohler@newt.com> * mh-customize.el (mh-index): Rename group to mh-search and sort
--- a/lisp/mh-e/mh-alias.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-alias.el Sun Jan 15 08:17:56 2006 +0000 @@ -31,10 +31,12 @@ ;;; Code: +;;(message "> mh-alias") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-buffers) (require 'mh-e) +;;(message "< mh-alias") (load "cmr" t t) ; Non-fatal dependency for ; completing-read-multiple. (eval-when-compile (defvar mail-abbrev-syntax-table))
--- a/lisp/mh-e/mh-comp.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-comp.el Sun Jan 15 08:17:56 2006 +0000 @@ -33,6 +33,7 @@ ;;; Code: +;;(message "> mh-comp") (eval-when-compile (require 'mh-acros)) (mh-require-cl) @@ -44,6 +45,7 @@ (eval-when (compile load eval) (ignore-errors (require 'mailabbrev))) +;;(message "< mh-comp") @@ -862,6 +864,9 @@ ;;; Mode for composing and sending a draft message. +(defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) + "Non-nil means PGP support is available.") + (put 'mh-letter-mode 'mode-class 'special) ;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
--- a/lisp/mh-e/mh-customize.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-customize.el Sun Jan 15 08:17:56 2006 +0000 @@ -63,6 +63,7 @@ ;;; Code: +;;(message "> mh-customize") (provide 'mh-customize) (eval-when-compile (require 'mh-acros)) @@ -78,6 +79,7 @@ (require 'mh-identity) (require 'mh-init) (require 'mh-loaddefs)) +;;(message "< mh-customize") ;; For compiler warnings... (eval-when-compile
--- a/lisp/mh-e/mh-e.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-e.el Sun Jan 15 08:17:56 2006 +0000 @@ -85,6 +85,7 @@ ;;; Code: +;;(message "> mh-e") (provide 'mh-e) (eval-when-compile (require 'mh-acros)) @@ -95,6 +96,7 @@ (require 'mh-buffers) (require 'mh-seq) (require 'mh-utils) +;;(message "< mh-e") (defconst mh-version "7.85+cvs" "Version number of MH-E.")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mh-e/mh-exec.el Sun Jan 15 08:17:56 2006 +0000 @@ -0,0 +1,239 @@ +;;; mh-exec.el --- MH-E process support + +;; Copyright (C) 1993, 1995, 1997, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Author: Bill Wohler <wohler@newt.com> +;; Maintainer: Bill Wohler <wohler@newt.com> +;; Keywords: mail +;; See: mh-e.el + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Issue shell and MH commands + +;;; Change Log: + +;;; Code: + +;;; + +(defvar mh-index-max-cmdline-args 500 + "Maximum number of command line args.") + +(defun mh-xargs (cmd &rest args) + "Partial imitation of xargs. +The current buffer contains a list of strings, one on each line. +The function will execute CMD with ARGS and pass the first +`mh-index-max-cmdline-args' strings to it. This is repeated till +all the strings have been used." + (goto-char (point-min)) + (let ((current-buffer (current-buffer))) + (with-temp-buffer + (let ((out (current-buffer))) + (set-buffer current-buffer) + (while (not (eobp)) + (let ((arg-list (reverse args)) + (count 0)) + (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) + (push (buffer-substring-no-properties (point) (line-end-position)) + arg-list) + (incf count) + (forward-line)) + (apply #'call-process cmd nil (list out nil) nil + (nreverse arg-list)))) + (erase-buffer) + (insert-buffer-substring out))))) + +;; XXX This should be applied anywhere MH-E calls out to /bin/sh. +(defun mh-quote-for-shell (string) + "Quote STRING for /bin/sh. +Adds double-quotes around entire string and quotes the characters +\\, `, and $ with a backslash." + (concat "\"" + (loop for x across string + concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) + "\"")) + +(defun mh-exec-cmd (command &rest args) + "Execute mh-command COMMAND with ARGS. +The side effects are what is desired. Any output is assumed to be +an error and is shown to the user. The output is not read or +parsed by MH-E." + (save-excursion + (set-buffer (get-buffer-create mh-log-buffer)) + (let* ((initial-size (mh-truncate-log-buffer)) + (start (point)) + (args (mh-list-to-string args))) + (apply 'call-process (expand-file-name command mh-progs) nil t nil args) + (when (> (buffer-size) initial-size) + (save-excursion + (goto-char start) + (insert "Errors when executing: " command) + (loop for arg in args do (insert " " arg)) + (insert "\n")) + (save-window-excursion + (switch-to-buffer-other-window mh-log-buffer) + (sit-for 5)))))) + +(defun mh-exec-cmd-error (env command &rest args) + "In environment ENV, execute mh-command COMMAND with ARGS. +ENV is nil or a string of space-separated \"var=value\" elements. +Signals an error if process does not complete successfully." + (save-excursion + (set-buffer (get-buffer-create mh-temp-buffer)) + (erase-buffer) + (let ((process-environment process-environment)) + ;; XXX: We should purge the list that split-string returns of empty + ;; strings. This can happen in XEmacs if leading or trailing spaces + ;; are present. + (dolist (elem (if (stringp env) (split-string env " ") ())) + (push elem process-environment)) + (mh-handle-process-error + command (apply #'call-process (expand-file-name command mh-progs) + nil t nil (mh-list-to-string args)))))) + +(defun mh-exec-cmd-daemon (command filter &rest args) + "Execute MH command COMMAND in the background. + +If FILTER is non-nil then it is used to process the output +otherwise the default filter `mh-process-daemon' is used. See +`set-process-filter' for more details of FILTER. + +ARGS are passed to COMMAND as command line arguments." + (save-excursion + (set-buffer (get-buffer-create mh-log-buffer)) + (mh-truncate-log-buffer)) + (let* ((process-connection-type nil) + (process (apply 'start-process + command nil + (expand-file-name command mh-progs) + (mh-list-to-string args)))) + (set-process-filter process (or filter 'mh-process-daemon)) + process)) + +(defun mh-exec-cmd-env-daemon (env command filter &rest args) + "In ennvironment ENV, execute mh-command COMMAND in the background. + +ENV is nil or a string of space-separated \"var=value\" elements. +Signals an error if process does not complete successfully. + +If FILTER is non-nil then it is used to process the output +otherwise the default filter `mh-process-daemon' is used. See +`set-process-filter' for more details of FILTER. + +ARGS are passed to COMMAND as command line arguments." + (let ((process-environment process-environment)) + (dolist (elem (if (stringp env) (split-string env " ") ())) + (push elem process-environment)) + (apply #'mh-exec-cmd-daemon command filter args))) + +(defun mh-process-daemon (process output) + "PROCESS daemon that puts OUTPUT into a temporary buffer. +Any output from the process is displayed in an asynchronous +pop-up window." + (with-current-buffer (get-buffer-create mh-log-buffer) + (insert-before-markers output) + (display-buffer mh-log-buffer))) + +(defun mh-exec-cmd-quiet (raise-error command &rest args) + "Signal RAISE-ERROR if COMMAND with ARGS fails. +Execute MH command COMMAND with ARGS. ARGS is a list of strings. +Return at start of mh-temp buffer, where output can be parsed and +used. +Returns value of `call-process', which is 0 for success, unless +RAISE-ERROR is non-nil, in which case an error is signaled if +`call-process' returns non-0." + (set-buffer (get-buffer-create mh-temp-buffer)) + (erase-buffer) + (let ((value + (apply 'call-process + (expand-file-name command mh-progs) nil t nil + args))) + (goto-char (point-min)) + (if raise-error + (mh-handle-process-error command value) + value))) + +;; Shush compiler. +(eval-when-compile (defvar mark-active)) + +(defun mh-exec-cmd-output (command display &rest args) + "Execute MH command COMMAND with DISPLAY flag and ARGS. +Put the output into buffer after point. +Set mark after inserted text. +Output is expected to be shown to user, not parsed by MH-E." + (push-mark (point) t) + (apply 'call-process + (expand-file-name command mh-progs) nil t display + (mh-list-to-string args)) + + ;; The following is used instead of 'exchange-point-and-mark because the + ;; latter activates the current region (between point and mark), which + ;; turns on highlighting. So prior to this bug fix, doing "inc" would + ;; highlight a region containing the new messages, which is undesirable. + ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. + (mh-exchange-point-and-mark-preserving-active-mark)) + +(defun mh-exchange-point-and-mark-preserving-active-mark () + "Put the mark where point is now, and point where the mark is now. +This command works even when the mark is not active, and +preserves whether the mark is active or not." + (interactive nil) + (let ((is-active (and (boundp 'mark-active) mark-active))) + (let ((omark (mark t))) + (if (null omark) + (error "No mark set in this buffer")) + (set-mark (point)) + (goto-char omark) + (if (boundp 'mark-active) + (setq mark-active is-active)) + nil))) + +(defun mh-exec-lib-cmd-output (command &rest args) + "Execute MH library command COMMAND with ARGS. +Put the output into buffer after point. +Set mark after inserted text." + (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) + +(defun mh-handle-process-error (command status) + "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." + (if (equal status 0) + status + (goto-char (point-min)) + (insert (if (integerp status) + (format "%s: exit code %d\n" command status) + (format "%s: %s\n" command status))) + (save-excursion + (let ((error-message (buffer-substring (point-min) (point-max)))) + (set-buffer (get-buffer-create mh-log-buffer)) + (mh-truncate-log-buffer) + (insert error-message))) + (error "%s failed, check buffer %s for error message" + command mh-log-buffer))) + +(provide 'mh-exec) + +;; Local Variables: +;; indent-tabs-mode: nil +;; sentence-end-double-space: nil +;; End: + +;;; mh-utils.el ends here
--- a/lisp/mh-e/mh-funcs.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-funcs.el Sun Jan 15 08:17:56 2006 +0000 @@ -35,10 +35,12 @@ ;;; Code: +;;(message "> mh-funcs") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-buffers) (require 'mh-e) +;;(message "< mh-funcs")
--- a/lisp/mh-e/mh-gnus.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-gnus.el Sun Jan 15 08:17:56 2006 +0000 @@ -30,7 +30,9 @@ ;;; Code: +;;(message "> mh-gnus") (eval-when-compile (require 'mh-acros)) +;;(message "< mh-gnus") ;; Load libraries in a non-fatal way in order to see if certain functions are ;; pre-defined.
--- a/lisp/mh-e/mh-identity.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-identity.el Sun Jan 15 08:17:56 2006 +0000 @@ -39,9 +39,11 @@ ;;; Code: +;;(message "> mh-identity") (eval-when-compile (require 'mh-acros)) (require 'mh-comp) +;;(message "< mh-identity") (autoload 'mml-insert-tag "mml")
--- a/lisp/mh-e/mh-inc.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-inc.el Sun Jan 15 08:17:56 2006 +0000 @@ -34,8 +34,10 @@ ;;; Code: +;;(message "> mh-inc") (eval-when-compile (require 'mh-acros)) (mh-require-cl) +;;(message "< mh-inc") (defvar mh-inc-spool-map (make-sparse-keymap) "Keymap for MH-E's mh-inc-spool commands.")
--- a/lisp/mh-e/mh-init.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-init.el Sun Jan 15 08:17:56 2006 +0000 @@ -39,10 +39,12 @@ ;;; Code: +;;(message "> mh-init") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-buffers) -(require 'mh-utils) +(require 'mh-exec) +;;(message "< mh-init") (defvar mh-sys-path '("/usr/local/nmh/bin" ; nmh default @@ -357,6 +359,31 @@ +;;; MH profile + +(defun mh-profile-component (component) + "Return COMPONENT value from mhparam, or nil if unset." + (save-excursion + (mh-exec-cmd-quiet nil "mhparam" "-components" component) + (mh-profile-component-value component))) + +(defun mh-profile-component-value (component) + "Find and return the value of COMPONENT in the current buffer. +Returns nil if the component is not in the buffer." + (let ((case-fold-search t)) + (goto-char (point-min)) + (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) + ((looking-at "[\t ]*$") nil) + (t + (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) + (let ((start (match-beginning 1))) + (end-of-line) + (buffer-substring start (point))))))) + + + +;;; MH-E images + ;; Shush compiler. (eval-when-compile (defvar image-load-path))
--- a/lisp/mh-e/mh-junk.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-junk.el Sun Jan 15 08:17:56 2006 +0000 @@ -32,10 +32,12 @@ ;;; Code: +;;(message "< mh-junk") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-buffers) (require 'mh-e) +;;(message "> mh-junk") ;; Interactive functions callable from the folder buffer ;;;###mh-autoload
--- a/lisp/mh-e/mh-mime.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-mime.el Sun Jan 15 08:17:56 2006 +0000 @@ -36,6 +36,7 @@ ;;; Code: +;;(message "> mh-mime") (eval-when-compile (require 'mh-acros)) (mh-require-cl) @@ -43,6 +44,7 @@ (require 'mh-buffers) (require 'mh-comp) (require 'mh-gnus) +;;(message "< mh-mime") (autoload 'article-emphasize "gnus-art") (autoload 'gnus-article-goto-header "gnus-art")
--- a/lisp/mh-e/mh-print.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-print.el Sun Jan 15 08:17:56 2006 +0000 @@ -30,6 +30,7 @@ ;;; Code: +;;(message "> mh-print") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'ps-print) @@ -37,6 +38,7 @@ (require 'mh-utils) (require 'mh-funcs) (eval-when-compile (require 'mh-seq)) +;;(message "< mh-print") (defvar mh-ps-print-color-option ps-print-color-p "Specify how buffer's text color is printed.
--- a/lisp/mh-e/mh-search.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-search.el Sun Jan 15 08:17:56 2006 +0000 @@ -44,12 +44,14 @@ ;;; Code: +;;(message "> mh-search") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'gnus-util) (require 'mh-buffers) (require 'mh-e) +;;(message "< mh-search") (defvar mh-searcher nil "Cached value of chosen search program.")
--- a/lisp/mh-e/mh-seq.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-seq.el Sun Jan 15 08:17:56 2006 +0000 @@ -71,11 +71,13 @@ ;;; Code: +;;(message "> mh-seq") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-buffers) (require 'mh-e) +;;(message "< mh-seq")
--- a/lisp/mh-e/mh-speed.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-speed.el Sun Jan 15 08:17:56 2006 +0000 @@ -33,12 +33,13 @@ ;;; Code: -;; Requires +;;(message "> mh-speed") (eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-e) (require 'speedbar) (require 'timer) +;;(message "< mh-speed") ;; Global variables (defvar mh-speed-refresh-flag nil)
--- a/lisp/mh-e/mh-utils.el Sun Jan 15 06:05:50 2006 +0000 +++ b/lisp/mh-e/mh-utils.el Sun Jan 15 08:17:56 2006 +0000 @@ -33,6 +33,7 @@ ;;; Code: +;;(message "> mh-utils") (eval-and-compile (defvar recursive-load-depth-limit) (if (and (boundp 'recursive-load-depth-limit) @@ -50,6 +51,7 @@ (require 'mh-inc) (require 'mouse) (require 'sendmail) +;;(message "< mh-utils") ;; Non-fatal dependencies (load "hl-line" t t) @@ -197,9 +199,6 @@ (defvar mh-globals-hash (make-hash-table) "Keeps track of MIME data on a per buffer basis.") -(defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) - "Non-nil means PGP support is available.") - (defvar mh-mm-inline-media-tests `(("image/jpeg" mm-inline-image @@ -1954,25 +1953,6 @@ (or dont-show (not return-value) (mh-maybe-show number)) return-value)) -(defun mh-profile-component (component) - "Return COMPONENT value from mhparam, or nil if unset." - (save-excursion - (mh-exec-cmd-quiet nil "mhparam" "-components" component) - (mh-profile-component-value component))) - -(defun mh-profile-component-value (component) - "Find and return the value of COMPONENT in the current buffer. -Returns nil if the component is not in the buffer." - (let ((case-fold-search t)) - (goto-char (point-min)) - (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) - ((looking-at "[\t ]*$") nil) - (t - (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) - (let ((start (match-beginning 1))) - (end-of-line) - (buffer-substring start (point))))))) - (defun mh-set-folder-modified-p (flag) "Mark current folder as modified or unmodified according to FLAG." (set-buffer-modified-p flag)) @@ -2428,204 +2408,6 @@ -;;; Issue shell and MH commands. - -(defvar mh-index-max-cmdline-args 500 - "Maximum number of command line args.") - -(defun mh-xargs (cmd &rest args) - "Partial imitation of xargs. -The current buffer contains a list of strings, one on each line. -The function will execute CMD with ARGS and pass the first -`mh-index-max-cmdline-args' strings to it. This is repeated till -all the strings have been used." - (goto-char (point-min)) - (let ((current-buffer (current-buffer))) - (with-temp-buffer - (let ((out (current-buffer))) - (set-buffer current-buffer) - (while (not (eobp)) - (let ((arg-list (reverse args)) - (count 0)) - (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) - (push (buffer-substring-no-properties (point) (line-end-position)) - arg-list) - (incf count) - (forward-line)) - (apply #'call-process cmd nil (list out nil) nil - (nreverse arg-list)))) - (erase-buffer) - (insert-buffer-substring out))))) - -;; XXX This should be applied anywhere MH-E calls out to /bin/sh. -(defun mh-quote-for-shell (string) - "Quote STRING for /bin/sh. -Adds double-quotes around entire string and quotes the characters -\\, `, and $ with a backslash." - (concat "\"" - (loop for x across string - concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) - "\"")) - -(defun mh-exec-cmd (command &rest args) - "Execute mh-command COMMAND with ARGS. -The side effects are what is desired. Any output is assumed to be -an error and is shown to the user. The output is not read or -parsed by MH-E." - (save-excursion - (set-buffer (get-buffer-create mh-log-buffer)) - (let* ((initial-size (mh-truncate-log-buffer)) - (start (point)) - (args (mh-list-to-string args))) - (apply 'call-process (expand-file-name command mh-progs) nil t nil args) - (when (> (buffer-size) initial-size) - (save-excursion - (goto-char start) - (insert "Errors when executing: " command) - (loop for arg in args do (insert " " arg)) - (insert "\n")) - (save-window-excursion - (switch-to-buffer-other-window mh-log-buffer) - (sit-for 5)))))) - -(defun mh-exec-cmd-error (env command &rest args) - "In environment ENV, execute mh-command COMMAND with ARGS. -ENV is nil or a string of space-separated \"var=value\" elements. -Signals an error if process does not complete successfully." - (save-excursion - (set-buffer (get-buffer-create mh-temp-buffer)) - (erase-buffer) - (let ((process-environment process-environment)) - ;; XXX: We should purge the list that split-string returns of empty - ;; strings. This can happen in XEmacs if leading or trailing spaces - ;; are present. - (dolist (elem (if (stringp env) (split-string env " ") ())) - (push elem process-environment)) - (mh-handle-process-error - command (apply #'call-process (expand-file-name command mh-progs) - nil t nil (mh-list-to-string args)))))) - -(defun mh-exec-cmd-daemon (command filter &rest args) - "Execute MH command COMMAND in the background. - -If FILTER is non-nil then it is used to process the output -otherwise the default filter `mh-process-daemon' is used. See -`set-process-filter' for more details of FILTER. - -ARGS are passed to COMMAND as command line arguments." - (save-excursion - (set-buffer (get-buffer-create mh-log-buffer)) - (mh-truncate-log-buffer)) - (let* ((process-connection-type nil) - (process (apply 'start-process - command nil - (expand-file-name command mh-progs) - (mh-list-to-string args)))) - (set-process-filter process (or filter 'mh-process-daemon)) - process)) - -(defun mh-exec-cmd-env-daemon (env command filter &rest args) - "In ennvironment ENV, execute mh-command COMMAND in the background. - -ENV is nil or a string of space-separated \"var=value\" elements. -Signals an error if process does not complete successfully. - -If FILTER is non-nil then it is used to process the output -otherwise the default filter `mh-process-daemon' is used. See -`set-process-filter' for more details of FILTER. - -ARGS are passed to COMMAND as command line arguments." - (let ((process-environment process-environment)) - (dolist (elem (if (stringp env) (split-string env " ") ())) - (push elem process-environment)) - (apply #'mh-exec-cmd-daemon command filter args))) - -(defun mh-process-daemon (process output) - "PROCESS daemon that puts OUTPUT into a temporary buffer. -Any output from the process is displayed in an asynchronous -pop-up window." - (with-current-buffer (get-buffer-create mh-log-buffer) - (insert-before-markers output) - (display-buffer mh-log-buffer))) - -(defun mh-exec-cmd-quiet (raise-error command &rest args) - "Signal RAISE-ERROR if COMMAND with ARGS fails. -Execute MH command COMMAND with ARGS. ARGS is a list of strings. -Return at start of mh-temp buffer, where output can be parsed and -used. -Returns value of `call-process', which is 0 for success, unless -RAISE-ERROR is non-nil, in which case an error is signaled if -`call-process' returns non-0." - (set-buffer (get-buffer-create mh-temp-buffer)) - (erase-buffer) - (let ((value - (apply 'call-process - (expand-file-name command mh-progs) nil t nil - args))) - (goto-char (point-min)) - (if raise-error - (mh-handle-process-error command value) - value))) - -;; Shush compiler. -(eval-when-compile (defvar mark-active)) - -(defun mh-exec-cmd-output (command display &rest args) - "Execute MH command COMMAND with DISPLAY flag and ARGS. -Put the output into buffer after point. -Set mark after inserted text. -Output is expected to be shown to user, not parsed by MH-E." - (push-mark (point) t) - (apply 'call-process - (expand-file-name command mh-progs) nil t display - (mh-list-to-string args)) - - ;; The following is used instead of 'exchange-point-and-mark because the - ;; latter activates the current region (between point and mark), which - ;; turns on highlighting. So prior to this bug fix, doing "inc" would - ;; highlight a region containing the new messages, which is undesirable. - ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. - (mh-exchange-point-and-mark-preserving-active-mark)) - -(defun mh-exchange-point-and-mark-preserving-active-mark () - "Put the mark where point is now, and point where the mark is now. -This command works even when the mark is not active, and -preserves whether the mark is active or not." - (interactive nil) - (let ((is-active (and (boundp 'mark-active) mark-active))) - (let ((omark (mark t))) - (if (null omark) - (error "No mark set in this buffer")) - (set-mark (point)) - (goto-char omark) - (if (boundp 'mark-active) - (setq mark-active is-active)) - nil))) - -(defun mh-exec-lib-cmd-output (command &rest args) - "Execute MH library command COMMAND with ARGS. -Put the output into buffer after point. -Set mark after inserted text." - (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) - -(defun mh-handle-process-error (command status) - "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." - (if (equal status 0) - status - (goto-char (point-min)) - (insert (if (integerp status) - (format "%s: exit code %d\n" command status) - (format "%s: %s\n" command status))) - (save-excursion - (let ((error-message (buffer-substring (point-min) (point-max)))) - (set-buffer (get-buffer-create mh-log-buffer)) - (mh-truncate-log-buffer) - (insert error-message))) - (error "%s failed, check buffer %s for error message" - command mh-log-buffer))) - - - ;;; List and string manipulation (defun mh-list-to-string (l)