]> code.delx.au - gnu-emacs/blobdiff - lisp/mh-e/mh-letter.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / mh-e / mh-letter.el
index 11aef2b51df6c4710082852cefc4f7f0b2da4603..8c54111470aa734b4e16efc94681120b2e079fc7 100644 (file)
@@ -1,7 +1,7 @@
 ;;; mh-letter.el --- MH-Letter mode
 
-;; Copyright (C) 1993, 1995, 1997,
-;;  2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
+;;  2006, 2007, 2008  Free Software Foundation, Inc.
 
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -21,9 +21,7 @@
 ;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -275,10 +273,8 @@ searching for `mh-mail-header-separator' in the buffer."
 
 ;;; MH-Letter Mode
 
-(defvar mh-letter-buttons-init-flag nil)
-
 ;; Shush compiler.
-(eval-when-compile (mh-do-in-xemacs (defvar font-lock-defaults)))
+(defvar font-lock-defaults)             ; XEmacs
 
 ;; Ensure new buffers won't get this mode if default-major-mode is nil.
 (put 'mh-letter-mode 'mode-class 'special)
@@ -312,14 +308,10 @@ order).
   (make-local-variable 'mh-sent-from-folder)
   (make-local-variable 'mh-sent-from-msg)
   (mh-do-in-gnu-emacs
-    (unless mh-letter-buttons-init-flag
-      (let ((load-path (mh-image-load-path-for-library
-                        "mh-e" "mh-logo.xpm" 'load-path))
-            (image-load-path (mh-image-load-path-for-library
-                              "mh-e" "mh-logo.xpm" 'image-load-path)))
-        (mh-tool-bar-letter-buttons-init)
-        (setq mh-letter-buttons-init-flag t)))
-    (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
+    (unless mh-letter-tool-bar-map
+      (mh-tool-bar-letter-buttons-init))
+    (if (boundp 'tool-bar-map)
+        (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)))
   (mh-do-in-xemacs
     (mh-tool-bar-init :letter))
   ;; Set the local value of mh-mail-header-separator according to what is
@@ -400,24 +392,26 @@ message is not indented, and \"> \" is not inserted before each line.
 This command leaves the mark before the letter and point after it."
   (interactive
    (let* ((folder
-           (mh-prompt-for-folder "Message from"
-                                 mh-sent-from-folder nil))
+           (mh-prompt-for-folder "Message from" mh-sent-from-folder nil))
           (default
-            (if (and (equal folder mh-sent-from-folder)
-                     (numberp mh-sent-from-msg))
-                mh-sent-from-msg
+            (if (equal folder mh-sent-from-folder)
+                (or mh-sent-from-msg (nth 0 (mh-translate-range folder "cur")))
               (nth 0 (mh-translate-range folder "cur"))))
           (message
            (read-string (concat "Message number"
                                 (or (and default
                                          (format " (default %d): " default))
-                                    ": ")))))
+                                    ": "))
+                        nil nil
+                        (if (numberp default)
+                            (int-to-string default)
+                          default))))
      (list folder message current-prefix-arg)))
+  (if (equal message "")
+      (error "No message number given"))
   (save-restriction
     (narrow-to-region (point) (point))
     (let ((start (point-min)))
-      (if (and (equal message "") (numberp mh-sent-from-msg))
-          (setq message (int-to-string mh-sent-from-msg)))
       (insert-file-contents
        (expand-file-name message (mh-expand-file-name folder)))
       (when (not verbatim)
@@ -849,7 +843,7 @@ body."
 (defun mh-position-on-field (field &optional ignored)
   "Move to the end of the FIELD in the header.
 Move to end of entire header if FIELD not found.
-Returns non-nil iff FIELD was found.
+Returns non-nil if FIELD was found.
 The optional second arg is for pre-version 4 compatibility and is
 IGNORED."
   (cond ((mh-goto-header-field field)
@@ -871,20 +865,17 @@ downcasing the field name."
   "Do folder name completion in Fcc header field."
   (let* ((end (point))
          (beg (mh-beginning-of-word))
-         (folder (buffer-substring beg end))
+         (folder (buffer-substring-no-properties beg end))
          (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
-         (last-slash (mh-search-from-end ?/ folder))
-         (prefix (and last-slash (substring folder 0 last-slash)))
-         (choices (mapcar #'(lambda (x)
-                              (list (cond (prefix (format "%s/%s" prefix x))
-                                          (leading-plus (format "+%s" x))
-                                          (t x))))
+         (choices (mapcar (lambda (x) (list x))
                           (mh-folder-completion-function folder nil t))))
+    (unless leading-plus
+      (setq folder (concat "+" folder)))
     (mh-complete-word folder choices beg end)))
 
 ;;;###mh-autoload
 (defun mh-complete-word (word choices begin end)
-  "Complete WORD at from CHOICES.
+  "Complete WORD from CHOICES.
 Any match found replaces the text from BEGIN to END."
   (let ((completion (try-completion word choices))
         (completions-buffer "*Completions*"))