;;; mh-utils.el --- MH-E code needed for both sending and reading
;; Copyright (C) 1993, 1995, 1997,
-;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;;; Code:
-(defvar recursive-load-depth-limit)
(eval-and-compile
+ (defvar recursive-load-depth-limit)
(if (and (boundp 'recursive-load-depth-limit)
(integerp recursive-load-depth-limit)
- (> 50 recursive-load-depth-limit))
+ (< recursive-load-depth-limit 50))
(setq recursive-load-depth-limit 50)))
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
-(require 'gnus-util)
+
(require 'font-lock)
-(require 'mouse)
-(load "tool-bar" t t)
-(require 'mh-loaddefs)
+(require 'gnus-util)
+(require 'mh-buffers)
(require 'mh-customize)
(require 'mh-inc)
+(require 'mouse)
+(require 'sendmail)
-(load "mm-decode" t t) ; Non-fatal dependency
-(load "mm-view" t t) ; Non-fatal dependency
-(load "vcard" t t) ; Non-fatal dependency
-(load "hl-line" t t) ; Non-fatal dependency
-(load "executable" t t) ; Non-fatal dependency on
- ; executable-find
-
-;; Shush the byte-compiler
-(defvar font-lock-auto-fontify)
-(defvar font-lock-defaults)
-(defvar mark-active)
+;; Non-fatal dependencies
+(load "hl-line" t t)
+(load "mm-decode" t t)
+(load "mm-view" t t)
+(load "tool-bar" t t)
+(load "vcard" t t)
\f
(autoload 'gnus-article-highlight-citation "gnus-cite")
(autoload 'message-fetch-field "message")
(autoload 'message-tokenize-header "message")
-(require 'sendmail)
(unless (fboundp 'make-hash-table)
(autoload 'make-hash-table "cl"))
(eval-and-compile
;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite'
(defvar mh-show-font-lock-keywords
- '(("^\\(From:\\|Sender:\\)\\(.*\\)" (1 'default) (2 mh-show-from-face))
- (mh-header-to-font-lock (0 'default) (1 mh-show-to-face))
- (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face))
+ '(("^\\(From:\\|Sender:\\)\\(.*\\)"
+ (1 'default)
+ (2 'mh-show-from))
+ (mh-header-to-font-lock
+ (0 'default)
+ (1 'mh-show-to))
+ (mh-header-cc-font-lock
+ (0 'default)
+ (1 'mh-show-cc))
("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
- (1 'default) (2 mh-show-from-face))
- (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face))
+ (1 'default)
+ (2 'mh-show-from))
+ (mh-header-subject-font-lock
+ (0 'default)
+ (1 'mh-show-subject))
("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
- (1 'default) (2 mh-show-cc-face))
+ (1 'default)
+ (2 'mh-show-cc))
("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
- (1 'default) (2 mh-show-date-face))
- (mh-letter-header-font-lock (0 mh-show-header-face append t)))
- "Additional expressions to highlight in MH-show mode."))
+ (1 'default)
+ (2 'mh-show-date))
+ (mh-letter-header-font-lock
+ (0 'mh-show-header append t)))
+ "Additional expressions to highlight in MH-Show buffers."))
(defvar mh-show-font-lock-keywords-with-cite
(eval-when-compile
(beginning-of-line) (end-of-line)
(2 font-lock-constant-face nil t)
(4 font-lock-comment-face nil t)))))))
- "Additional expressions to highlight in MH-show mode.")
+ "Additional expressions to highlight in MH-Show buffers.")
(defvar mh-letter-font-lock-keywords
`(,@mh-show-font-lock-keywords-with-cite
- (mh-font-lock-field-data (1 'mh-letter-header-field prepend t))))
+ (mh-font-lock-field-data
+ (1 'mh-letter-header-field prepend t)))
+ "Additional expressions to highlight in MH-Letter buffers.")
(defun mh-show-font-lock-fontify-region (beg end loudly)
"Limit font-lock in `mh-show-mode' to the header.
(t
nil))))
-;; Needed to help shush the byte-compiler.
+;; Shush compiler.
(if mh-xemacs-flag
- (progn
- (eval-and-compile
- (require 'gnus)
- (require 'gnus-art)
- (require 'gnus-cite))))
+ (eval-and-compile
+ (require 'gnus)
+ (require 'gnus-art)
+ (require 'gnus-cite)))
(defun mh-gnus-article-highlight-citation ()
"Highlight cited text in current buffer using Gnus."
Set to \"+inbox\" if no such component.
Name of the Inbox folder.")
-;; The names of ephemeral buffers have a " *mh-" prefix (so that they are
-;; hidden and can be programmatically removed in mh-quit), and the variable
-;; names have the form mh-temp-.*-buffer.
-(defconst mh-temp-buffer " *mh-temp*") ;scratch
-(defconst mh-temp-fetch-buffer " *mh-fetch*") ;wget/curl/fetch output
-
-;; The names of MH-E buffers that are not ephemeral and can be used by the
-;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
-;; (so they can be programmatically removed in mh-quit), and the variable
-;; names have the form mh-.*-buffer.
-(defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups
-(defconst mh-folders-buffer "*MH-E Folders*") ;folder list
-(defconst mh-help-buffer "*MH-E Help*") ;quick help
-(defconst mh-info-buffer "*MH-E Info*") ;version information buffer
-(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
-(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
-(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
-(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
-
-(defvar mh-log-buffer-lines 100
- "Number of lines to keep in `mh-log-buffer'.")
-
(defvar mh-previous-window-config nil
"Window configuration before MH-E command.")
(unlock-buffer)
(setq buffer-file-name nil))
-
(defun mh-get-msg-num (error-if-no-message)
"Return the message number of the displayed message.
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if
(and (> (length name) 0)
(eq (aref name 0) ?+))))
-
(defun mh-expand-file-name (filename &optional default)
"Expand FILENAME like `expand-file-name', but also handle MH folder names.
Any filename that starts with '+' is treated as a folder name.
(expand-file-name (substring filename 1) mh-user-path)
(expand-file-name filename default)))
-
(defun mh-msg-filename (msg &optional folder)
"Return the file name of MSG in FOLDER (default current folder)."
(expand-file-name (int-to-string msg)
(mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
(mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
(mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
-(mh-defun-show-buffer mh-show-search-folder mh-search-folder t)
(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
(mh-defun-show-buffer mh-show-delete-msg-from-seq
mh-delete-msg-from-seq)
"S" mh-show-sort-folder
"c" mh-show-catchup
"f" mh-show-visit-folder
- "i" mh-index-search
"k" mh-show-kill-folder
"l" mh-show-list-folders
"n" mh-index-new-messages
"o" mh-show-visit-folder
"q" mh-show-index-sequenced-messages
"r" mh-show-rescan-folder
- "s" mh-show-search-folder
+ "s" mh-search
"t" mh-show-toggle-threads
"u" mh-show-undo-folder
"v" mh-show-visit-folder)
["List Folders" mh-show-list-folders t]
["Visit a Folder..." mh-show-visit-folder t]
["View New Messages" mh-show-index-new-messages t]
- ["Search a Folder..." mh-show-search-folder t]
- ["Indexed Search..." mh-index-search t]
+ ["Search..." mh-search t]
"--"
["Quit MH-E" mh-quit t]))
-
;; Ensure new buffers won't get this mode if default-major-mode is nil.
(put 'mh-show-mode 'mode-class 'special)
-;; Avoid compiler warnings in XEmacs and Emacs 20
-(eval-when-compile
- (defvar tool-bar-mode)
- (defvar tool-bar-map))
+;; Shush compiler.
+(eval-when-compile (defvar font-lock-auto-fontify))
(define-derived-mode mh-show-mode text-mode "MH-Show"
"Major mode for showing messages in MH-E.\\<mh-show-mode-map>
(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
+(defmacro mh-face-foreground-compat (face &optional frame inherit)
+ "Return the foreground color name of FACE, or nil if unspecified.
+See documentation for `face-foreground' for a description of the
+arguments FACE, FRAME, and INHERIT.
+
+Calls `face-foreground' correctly in older environments. Versions
+of Emacs prior to version 22 lacked an INHERIT argument which
+when t tells `face-foreground' to consider an inherited value for
+the foreground if the face does not define one itself."
+ (if (>= emacs-major-version 22)
+ `(face-foreground ,face ,frame ,inherit)
+ `(face-foreground ,face ,frame)))
+
+(defmacro mh-face-background-compat (face &optional frame inherit)
+ "Return the background color name of face, or nil if unspecified.
+See documentation for `back-foreground' for a description of the
+arguments FACE, FRAME, and INHERIT.
+
+Calls `face-background' correctly in older environments. Versions
+of Emacs prior to version 22 lacked an INHERIT argument which
+when t tells `face-background' to consider an inherited value for
+the background if the face does not define one itself."
+ (if (>= emacs-major-version 22)
+ `(face-background ,face ,frame ,inherit)
+ `(face-background ,face ,frame)))
+
(defun mh-face-display-function ()
"Display a Face, X-Face, or X-Image-URL header field.
If more than one of these are present, then the first one found
(mh-funcall-if-exists
insert-image (create-image
raw type t
- :foreground (face-foreground 'mh-show-xface)
- :background (face-background 'mh-show-xface))
- " ")))
+ :foreground
+ (mh-face-foreground-compat 'mh-show-xface nil t)
+ :background
+ (mh-face-background-compat 'mh-show-xface nil t))
+ " ")))
;; XEmacs
(mh-do-in-xemacs
(cond
"Scale image in INPUT file and write to OUTPUT file using ImageMagick."
(call-process "convert" nil nil nil "-geometry" "96x48" input output))
+;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
+(if (not (boundp 'url-unreserved-chars))
+ (defconst url-unreserved-chars
+ '(
+ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+ ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+ ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
+ "A list of characters that are _NOT_ reserved in the URL spec.
+This is taken from RFC 2396."))
+
+;; Copy of function from url-util.el in Emacs 22; needed by Emacs 21.
+(mh-defun-compat url-hexify-string (str)
+ "Escape characters in a string."
+ (mapconcat
+ (lambda (char)
+ ;; Fixme: use a char table instead.
+ (if (not (memq char url-unreserved-chars))
+ (if (> char 255)
+ (error "Hexifying multibyte character %s" str)
+ (format "%%%02X" char))
+ (char-to-string char)))
+ str ""))
+
(defun mh-x-image-url-cache-canonicalize (url)
"Canonicalize URL.
-Replace the ?/ character with a ?! character and append .png."
- (format "%s/%s.png" mh-x-image-cache-directory
+Replace the ?/ character with a ?! character and append .png.
+Also replaces special characters with `url-hexify-string' since
+not all characters, such as :, are legal within Windows
+filenames. See URL `http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'."
+ (format "%s/%s.png" mh-x-image-cache-directory
+ (url-hexify-string
(with-temp-buffer
(insert url)
(mh-replace-string "/" "!")
- (buffer-string))))
+ (buffer-string)))))
(defun mh-x-image-set-download-state (file data)
"Setup a symbolic link from FILE to DATA."
(cond
;; Check if we have `convert'
((eq mh-x-image-scaling-function 'ignore)
- (message "The `convert' program is needed to display X-Image-URL")
+ (message "The \"convert\" program is needed to display X-Image-URL")
(mh-x-image-set-download-state cache-filename 'try-again))
;; Scale fetched image
((and (funcall mh-x-image-scaling-function temp-file cache-filename)
the superfluous header fields that mailers add to a message, but if
you wish to see all of them, use the command \\[mh-header-display].
+Two hooks can be used to control how messages are displayed. The
+first hook, `mh-show-mode-hook', is called early on in the
+process of the message display. It is usually used to perform
+some action on the message's content. The second hook,
+`mh-show-hook', is the last thing called after messages are
+displayed. It's used to affect the behavior of MH-E in general or
+when `mh-show-mode-hook' is too early.
+
From a program, optional argument MESSAGE can be used to display an
alternative message. The optional argument REDISPLAY-FLAG forces the
redisplay of the message even if the show buffer was already
editable buffer. When you are done editing, save and kill the
buffer as you would any other.
-From a program, edit MESSAGE instead if it is non-nil."
+From a program, edit MESSAGE; nil means edit current message."
(interactive)
(let* ((message (or message (mh-get-msg-num t)))
(msg-filename (mh-msg-filename message))
;; XXX Note that MH-E no longer supports the `mh-visible-headers'
;; variable, so this function could be trimmed of this feature too."
(let ((case-fold-search t)
- (buffer-read-only nil)
- (after-change-functions nil)) ;Work around emacs-20 font-lock bug
- ;causing an endless loop.
+ (buffer-read-only nil))
(save-restriction
(goto-char start)
(if (search-forward "\n\n" nil 'move)
(or dont-show (not return-value) (mh-maybe-show number))
return-value))
-(defun mh-get-profile-field (field)
- "Find and return the value of FIELD in the current buffer.
-Returns nil if the field is not in the buffer."
+(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" field) nil t)) nil)
+ (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil)
((looking-at "[\t ]*$") nil)
(t
(re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
(end-of-line)
(buffer-substring start (point)))))))
-(defvar mh-find-path-run nil
- "Non-nil if `mh-find-path' has been run already.")
-
-(defun mh-find-path ()
- "Set variables from user's MH profile.
-
-This function sets `mh-user-path' from your \"Path:\" MH profile
-component (but defaults to \"Mail\" if one isn't present),
-`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from
-\"Unseen-Sequence:\", `mh-previous-seq' from
-\"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults
-to \"+inbox\").
-
-The hook `mh-find-path-hook' is run after these variables have
-been set. This hook can be used the change the value of these
-variables if you need to run with different values between MH and
-MH-E."
- (mh-variants)
- (unless mh-find-path-run
- (setq mh-find-path-run t)
- (save-excursion
- ;; Be sure profile is fully expanded before switching buffers
- (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
- (set-buffer (get-buffer-create mh-temp-buffer))
- (setq buffer-offer-save nil) ;for people who set default to t
- (erase-buffer)
- (condition-case err
- (insert-file-contents profile)
- (file-error
- (mh-install profile err)))
- (setq mh-user-path (mh-get-profile-field "Path:"))
- (if (not mh-user-path)
- (setq mh-user-path "Mail"))
- (setq mh-user-path
- (file-name-as-directory
- (expand-file-name mh-user-path (expand-file-name "~"))))
- (unless mh-x-image-cache-directory
- (setq mh-x-image-cache-directory
- (expand-file-name ".mhe-x-image-cache" mh-user-path)))
- (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
- (if mh-draft-folder
- (progn
- (if (not (mh-folder-name-p mh-draft-folder))
- (setq mh-draft-folder (format "+%s" mh-draft-folder)))
- (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
- (error
- "Draft folder \"%s\" not found. Create it and try again"
- (mh-expand-file-name mh-draft-folder)))))
- (setq mh-inbox (mh-get-profile-field "Inbox:"))
- (cond ((not mh-inbox)
- (setq mh-inbox "+inbox"))
- ((not (mh-folder-name-p mh-inbox))
- (setq mh-inbox (format "+%s" mh-inbox))))
- (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
- (if mh-unseen-seq
- (setq mh-unseen-seq (intern mh-unseen-seq))
- (setq mh-unseen-seq 'unseen)) ;old MH default?
- (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
- (if mh-previous-seq
- (setq mh-previous-seq (intern mh-previous-seq)))
- (run-hooks 'mh-find-path-hook)
- (mh-collect-folder-names)))))
-
-(defun mh-file-command-p (file)
- "Return t if file FILE is the name of a executable regular file."
- (and (file-regular-p file) (file-executable-p file)))
-
-(defvar mh-no-install nil) ;do not run install-mh
-
-(defun mh-install (profile error-val)
- "Initialize the MH environment.
-This is called if we fail to read the PROFILE file. ERROR-VAL is
-the error that made this call necessary."
- (if (or (getenv "MH")
- (file-exists-p profile)
- mh-no-install)
- (signal (car error-val)
- (list (format "Cannot read MH profile \"%s\"" profile)
- (car (cdr (cdr error-val))))))
- ;; The "install-mh" command will output a short note which
- ;; mh-exec-cmd will display to the user.
- ;; The MH 5 version of install-mh might try prompt the user
- ;; for information, which would fail here.
- (mh-exec-cmd (expand-file-name "install-mh" mh-lib-progs) "-auto")
- ;; now try again to read the profile file
- (erase-buffer)
- (condition-case err
- (insert-file-contents profile)
- (file-error
- (signal (car err) ;re-signal with more specific msg
- (list (format "Cannot read MH profile \"%s\"" profile)
- (car (cdr (cdr err))))))))
-
(defun mh-set-folder-modified-p (flag)
"Mark current folder as modified or unmodified according to FLAG."
(set-buffer-modified-p flag))
(remhash nil mh-sub-folders-cache))))
(defvar mh-folder-hist nil)
-(defvar mh-speed-folder-map)
-(defvar mh-speed-flists-cache)
+
+;; Shush compiler.
+(eval-when-compile
+ (defvar mh-speed-folder-map)
+ (defvar mh-speed-flists-cache))
(defvar mh-allow-root-folder-flag nil
"Non-nil means \"+\" is an acceptable folder name.
This variable should never be set.")
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map))
-(define-key mh-folder-completion-map " " 'minibuffer-complete)
+(define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why???
(defvar mh-speed-flists-inhibit-flag nil)
(let ((new-file-flag
(not (file-exists-p (mh-expand-file-name folder-name)))))
(cond ((and new-file-flag
+ can-create
(y-or-n-p
(format "Folder %s does not exist. Create it? "
folder-name)))
(mh-speed-add-folder folder-name))
(message "Creating %s...done" folder-name))
(new-file-flag
- (error "Folder %s is not created" folder-name))
+ (error "Folder %s does not exist" folder-name))
((not (file-directory-p (mh-expand-file-name folder-name)))
- (error "\"%s\" is not a directory"
+ (error "%s is not a directory"
(mh-expand-file-name folder-name)))))
folder-name))
-(defun mh-truncate-log-buffer ()
- "If `mh-log-buffer' is too big then truncate it.
-If the number of lines in `mh-log-buffer' exceeds
-`mh-log-buffer-lines' then keep only the last
-`mh-log-buffer-lines'. As a side effect the point is set to the
-end of the log buffer.
+\f
-The function returns the size of the final size of the log buffer."
- (with-current-buffer (get-buffer-create mh-log-buffer)
- (goto-char (point-max))
- (save-excursion
- (when (equal (forward-line (- mh-log-buffer-lines)) 0)
- (delete-region (point-min) (point))))
- (unless (or (bobp)
- (save-excursion
- (and (equal (forward-line -1) 0) (equal (char-after) ?\f))))
- (insert "\n\f\n"))
- (buffer-size)))
+;;; Issue shell and MH commands.
-\f
+(defvar mh-index-max-cmdline-args 500
+ "Maximum number of command line args.")
-;;; Issue commands to MH.
+(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.
"PROCESS daemon that puts OUTPUT into a temporary buffer.
Any output from the process is displayed in an asynchronous
pop-up window."
- (set-buffer (get-buffer-create mh-log-buffer))
- (insert-before-markers output)
- (display-buffer mh-log-buffer))
+ (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.
(mh-handle-process-error command value)
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-get-profile-field (concat component ":"))))
-
-(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)))
+;; 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.
;; 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-buffer (get-buffer-create mh-log-buffer))
(mh-truncate-log-buffer)
(insert error-message)))
- (error "%s failed, check %s buffer for error message"
+ (error "%s failed, check buffer %s for error message"
command mh-log-buffer)))
+\f
+
+;;; List and string manipulation
+
(defun mh-list-to-string (l)
"Flatten the list L and make every element of the new list into a string."
(nreverse (mh-list-to-string-1 l)))
((listp (car l))
(setq new-list (nconc (mh-list-to-string-1 (car l))
new-list)))
- (t (error "Bad element in mh-list-to-string: %s" (car l))))
+ (t (error "Bad element in `mh-list-to-string': %s" (car l))))
(setq l (cdr l)))
new-list))
(defun mh-replace-string (old new)
- "Replace all occurrences of OLD with NEW in the current buffer."
+ "Replace all occurrences of OLD with NEW in the current buffer.
+Ignores case when searching for OLD."
(goto-char (point-min))
(let ((case-fold-search t))
(while (search-forward old nil t)
(replace-match new t t))))
-(defun mh-replace-in-string (regexp newtext string)
- "Replace REGEXP with NEWTEXT everywhere in STRING and return result.
-NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
-
-The function body was copied from `dired-replace-in-string' in
-dired.el.
-Emacs21 has `replace-regexp-in-string' while XEmacs has
-`replace-in-string'.
-Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1
-and above has `gnus-replace-in-string'. We should use that when we
-decide to not support older versions of Gnus."
- (let ((result "") (start 0) mb me)
- (while (string-match regexp string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result (substring string start mb) newtext)
- start me))
- (concat result (substring string start))))
-
(provide 'mh-utils)
;; Local Variables: