* 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.
This commit is contained in:
Bill Wohler
parent
d83d8efe0b
commit
30f240162b
18 changed files with 344 additions and 222 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 @@ Returns t if found, nil if not."
|
|||
|
||||
;;; 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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
||||
|
|
|
|||
239
lisp/mh-e/mh-exec.el
Normal file
239
lisp/mh-e/mh-exec.el
Normal file
|
|
@ -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
|
||||
|
|
@ -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")
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
|
|
|||
|
|
@ -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-E."
|
|||
|
||||
|
||||
|
||||
;;; 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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 @@ when searching for a separator.")
|
|||
(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 @@ the message."
|
|||
(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 @@ used in searching."
|
|||
|
||||
|
||||
|
||||
;;; 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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue