[Emacs-commit] emacs/lisp/mh-e mh-utils.el mh-letter.el mh-com...

[Bill Wohler]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Branch:         
Changes by:     Bill Wohler <address@hidden>    06/01/30 01:32:17

Modified files:
        lisp/mh-e      : mh-utils.el mh-letter.el mh-comp.el ChangeLog 

Log message:
        * mh-comp.el (mh-letter-hide-all-skipped-fields)
        (mh-get-header-field): Move to mh-utils.el so that you can read
        messages without having to load mh-comp.el and mh-letter.el.
        
        * mh-letter.el (mh-hidden-header-keymap)
        (mh-letter-toggle-header-field-display)
        (mh-letter-skipped-header-field-p)
        (mh-letter-skip-leading-whitespace-in-header-field)
        (mh-letter-truncate-header-field): Move to mh-utils.el so that you can
        read messages without having to load mh-comp.el and mh-letter.el.
        
        * mh-utils.el (mh-get-header-field)
        (mh-letter-hide-all-skipped-fields)
        (mh-letter-skipped-header-field-p, mh-hidden-header-keymap)
        (mh-letter-toggle-header-field-display)
        (mh-letter-skip-leading-whitespace-in-header-field)
        (mh-letter-truncate-header-field): Move here from mh-comp.el and
        mh-letter.el so that you can read messages without having to load
        mh-comp.el and mh-letter.el.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/lisp/mh-e/mh-utils.el.diff?tr1=1.43&tr2=1.44&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/lisp/mh-e/mh-letter.el.diff?tr1=1.3&tr2=1.4&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/lisp/mh-e/mh-comp.el.diff?tr1=1.44&tr2=1.45&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/lisp/mh-e/ChangeLog.diff?tr1=1.126&tr2=1.127&r1=text&r2=text

Patches:
Index: emacs/lisp/mh-e/ChangeLog
diff -u emacs/lisp/mh-e/ChangeLog:1.126 emacs/lisp/mh-e/ChangeLog:1.127
--- emacs/lisp/mh-e/ChangeLog:1.126     Mon Jan 30 00:53:30 2006
+++ emacs/lisp/mh-e/ChangeLog   Mon Jan 30 01:32:17 2006
@@ -1,5 +1,26 @@
 2006-01-29  Bill Wohler  <address@hidden>
 
+       * mh-comp.el (mh-letter-hide-all-skipped-fields)
+       (mh-get-header-field): Move to mh-utils.el so that you can read
+       messages without having to load mh-comp.el and mh-letter.el.
+
+       * mh-letter.el (mh-hidden-header-keymap)
+       (mh-letter-toggle-header-field-display)
+       (mh-letter-skipped-header-field-p)
+       (mh-letter-skip-leading-whitespace-in-header-field)
+       (mh-letter-truncate-header-field): Move to mh-utils.el so that you
+       can read messages without having to load mh-comp.el and
+       mh-letter.el.
+
+       * mh-utils.el (mh-get-header-field)
+       (mh-letter-hide-all-skipped-fields) 
+       (mh-letter-skipped-header-field-p, mh-hidden-header-keymap)
+       (mh-letter-toggle-header-field-display)
+       (mh-letter-skip-leading-whitespace-in-header-field)
+       (mh-letter-truncate-header-field): Move here from mh-comp.el and
+       mh-letter.el so that you can read messages without having to load
+       mh-comp.el and mh-letter.el.
+
        * mh-comp.el (mh-insert-fields): Handle nil values. Rmail, at
        least, will deliver them to us.
 
Index: emacs/lisp/mh-e/mh-comp.el
diff -u emacs/lisp/mh-e/mh-comp.el:1.44 emacs/lisp/mh-e/mh-comp.el:1.45
--- emacs/lisp/mh-e/mh-comp.el:1.44     Mon Jan 30 00:53:30 2006
+++ emacs/lisp/mh-e/mh-comp.el  Mon Jan 30 01:32:17 2006
@@ -967,19 +967,6 @@
         (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
           (insert "X-Face: "))))))
 
-;;;###mh-autoload
-(defun mh-letter-hide-all-skipped-fields ()
-  "Hide all skipped fields."
-  (save-excursion
-    (goto-char (point-min))
-    (save-restriction
-      (narrow-to-region (point) (mh-mail-header-end))
-      (while (re-search-forward mh-letter-header-field-regexp nil t)
-        (if (mh-letter-skipped-header-field-p (match-string 1))
-            (mh-letter-toggle-header-field-display -1)
-          (mh-letter-toggle-header-field-display 'long))
-        (beginning-of-line 2)))))
-
 (defun mh-tidy-draft-buffer ()
   "Run when a draft buffer is destroyed."
   (let ((buffer (get-buffer mh-recipients-buffer)))
@@ -1012,21 +999,6 @@
              (mh-notate nil note
                         (+ mh-cmd-note mh-scan-field-destination-offset)))))))
 
-;;;###mh-autoload
-(defun mh-get-header-field (field)
-  "Find and return the body of FIELD in the mail header.
-Returns the empty string if the field is not in the header of the
-current buffer."
-  (if (mh-goto-header-field field)
-      (progn
-        (skip-chars-forward " \t")      ;strip leading white space in body
-        (let ((start (point)))
-          (mh-header-field-end)
-          (buffer-substring-no-properties start (point))))
-    ""))
-
-(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
-
 (defun mh-insert-header-separator ()
   "Insert `mh-mail-header-separator', if absent."
   (save-excursion
Index: emacs/lisp/mh-e/mh-letter.el
diff -u emacs/lisp/mh-e/mh-letter.el:1.3 emacs/lisp/mh-e/mh-letter.el:1.4
--- emacs/lisp/mh-e/mh-letter.el:1.3    Mon Jan 30 00:49:56 2006
+++ emacs/lisp/mh-e/mh-letter.el        Mon Jan 30 01:32:17 2006
@@ -61,15 +61,6 @@
     (to . mh-alias-letter-expand-alias))
   "Alist of header fields and completion functions to use.")
 
-(defvar mh-hidden-header-keymap
-  (let ((map (make-sparse-keymap)))
-    (mh-do-in-gnu-emacs
-      (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
-    (mh-do-in-xemacs
-      (define-key map '(button2)
-        'mh-letter-toggle-header-field-display-button))
-    map))
-
 (defvar mh-yank-hooks nil
   "Obsolete hook for modifying a citation just inserted in the mail buffer.
 
@@ -593,50 +584,6 @@
           (t (goto-char header-end)
              (forward-line)))))
 
-;;;###mh-autoload
-(defun mh-letter-toggle-header-field-display (arg)
-  "Toggle display of header field at point.
-
-Use this command to display truncated header fields. This command
-is a toggle so entering it again will hide the field. This
-command takes a prefix argument ARG: if negative then the field
-is hidden, if positive then the field is displayed."
-  (interactive (list nil))
-  (when (and (mh-in-header-p)
-             (progn
-               (end-of-line)
-               (re-search-backward mh-letter-header-field-regexp nil t)))
-    (let ((buffer-read-only nil)
-          (modified-flag (buffer-modified-p))
-          (begin (point))
-          end)
-      (end-of-line)
-      (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
-                        (match-beginning 0)
-                      (point-max))))
-      (goto-char begin)
-      ;; Make it clickable...
-      (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
-                                       mouse-face highlight))
-      (unwind-protect
-          (cond ((or (and (not arg)
-                          (text-property-any begin end 'invisible 'vanish))
-                     (and (numberp arg) (>= arg 0))
-                     (and (eq arg 'long) (> (line-beginning-position 5) end)))
-                 (remove-text-properties begin end '(invisible nil))
-                 (search-forward ":" (line-end-position) t)
-                 (mh-letter-skip-leading-whitespace-in-header-field))
-                ;; XXX Redesign to make usable by user. Perhaps use a positive
-                ;; numeric prefix to make that many lines visible.
-                ((eq arg 'long)
-                 (end-of-line 4)
-                 (mh-letter-truncate-header-field end)
-                 (beginning-of-line))
-                (t (end-of-line)
-                   (mh-letter-truncate-header-field end)
-                   (beginning-of-line)))
-        (set-buffer-modified-p modified-flag)))))
-
 (defun mh-open-line ()
   "Insert a newline and leave point before it.
 
@@ -893,24 +840,6 @@
              (forward-line)))))
 
 ;;;###mh-autoload
-(defun mh-letter-skipped-header-field-p (field)
-  "Check if FIELD is to be skipped."
-  (let ((field (downcase field)))
-    (loop for x in mh-compose-skipped-header-fields
-          when (equal (downcase x) field) return t
-          finally return nil)))
-
-(defun mh-letter-skip-leading-whitespace-in-header-field ()
-  "Skip leading whitespace in a header field.
-If the header field doesn't have at least one space after the
-colon then a space character is added."
-  (let ((need-space t))
-    (while (memq (char-after) '(?\t ?\ ))
-      (forward-char)
-      (setq need-space nil))
-    (when need-space (insert " "))))
-
-;;;###mh-autoload
 (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.
@@ -980,6 +909,7 @@
                   (not (null (string-match "\.vcf$" file))))
              (string-equal "text/x-vcard" (mh-file-mime-type file))))))
 
+;;;###mh-autoload
 (defun mh-letter-toggle-header-field-display-button (event)
   "Toggle header field display at location of EVENT.
 This function does the same thing as
@@ -989,15 +919,6 @@
   (mh-do-at-event-location event
     (mh-letter-toggle-header-field-display nil)))
 
-(defun mh-letter-truncate-header-field (end)
-  "Replace text from current line till END with an ellipsis.
-If the current line is too long truncate a part of it as well."
-  (let ((max-len (min (window-width) 62)))
-    (when (> (+ (current-column) 4) max-len)
-      (backward-char (- (+ (current-column) 5) max-len)))
-    (when (> end (point))
-      (add-text-properties (point) end '(invisible vanish)))))
-
 (defun mh-extract-from-attribution ()
   "Extract phrase or comment from From header field."
   (save-excursion
Index: emacs/lisp/mh-e/mh-utils.el
diff -u emacs/lisp/mh-e/mh-utils.el:1.43 emacs/lisp/mh-e/mh-utils.el:1.44
--- emacs/lisp/mh-e/mh-utils.el:1.43    Sun Jan 29 19:34:54 2006
+++ emacs/lisp/mh-e/mh-utils.el Mon Jan 30 01:32:17 2006
@@ -805,6 +805,21 @@
        (point) (progn (mh-header-field-end)(point))))))
 
 ;;;###mh-autoload
+(defun mh-get-header-field (field)
+  "Find and return the body of FIELD in the mail header.
+Returns the empty string if the field is not in the header of the
+current buffer."
+  (if (mh-goto-header-field field)
+      (progn
+        (skip-chars-forward " \t")      ;strip leading white space in body
+        (let ((start (point)))
+          (mh-header-field-end)
+          (buffer-substring-no-properties start (point))))
+    ""))
+
+(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
+
+;;;###mh-autoload
 (defun mh-goto-header-field (field)
   "Move to FIELD in the message header.
 Move to the end of the FIELD name, which should end in a colon.
@@ -862,6 +877,100 @@
   (backward-char 1))                    ;to end of previous line
 
 ;;;###mh-autoload
+(defun mh-letter-hide-all-skipped-fields ()
+  "Hide all skipped fields."
+  (save-excursion
+    (goto-char (point-min))
+    (save-restriction
+      (narrow-to-region (point) (mh-mail-header-end))
+      (while (re-search-forward mh-letter-header-field-regexp nil t)
+        (if (mh-letter-skipped-header-field-p (match-string 1))
+            (mh-letter-toggle-header-field-display -1)
+          (mh-letter-toggle-header-field-display 'long))
+        (beginning-of-line 2)))))
+
+;;;###mh-autoload
+(defun mh-letter-skipped-header-field-p (field)
+  "Check if FIELD is to be skipped."
+  (let ((field (downcase field)))
+    (loop for x in mh-compose-skipped-header-fields
+          when (equal (downcase x) field) return t
+          finally return nil)))
+
+(defvar mh-hidden-header-keymap
+  (let ((map (make-sparse-keymap)))
+    (mh-do-in-gnu-emacs
+      (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
+    (mh-do-in-xemacs
+      (define-key map '(button2)
+        'mh-letter-toggle-header-field-display-button))
+    map))
+
+;;;###mh-autoload
+(defun mh-letter-toggle-header-field-display (arg)
+  "Toggle display of header field at point.
+
+Use this command to display truncated header fields. This command
+is a toggle so entering it again will hide the field. This
+command takes a prefix argument ARG: if negative then the field
+is hidden, if positive then the field is displayed."
+  (interactive (list nil))
+  (when (and (mh-in-header-p)
+             (progn
+               (end-of-line)
+               (re-search-backward mh-letter-header-field-regexp nil t)))
+    (let ((buffer-read-only nil)
+          (modified-flag (buffer-modified-p))
+          (begin (point))
+          end)
+      (end-of-line)
+      (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
+                        (match-beginning 0)
+                      (point-max))))
+      (goto-char begin)
+      ;; Make it clickable...
+      (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
+                                       mouse-face highlight))
+      (unwind-protect
+          (cond ((or (and (not arg)
+                          (text-property-any begin end 'invisible 'vanish))
+                     (and (numberp arg) (>= arg 0))
+                     (and (eq arg 'long) (> (line-beginning-position 5) end)))
+                 (remove-text-properties begin end '(invisible nil))
+                 (search-forward ":" (line-end-position) t)
+                 (mh-letter-skip-leading-whitespace-in-header-field))
+                ;; XXX Redesign to make usable by user. Perhaps use a positive
+                ;; numeric prefix to make that many lines visible.
+                ((eq arg 'long)
+                 (end-of-line 4)
+                 (mh-letter-truncate-header-field end)
+                 (beginning-of-line))
+                (t (end-of-line)
+                   (mh-letter-truncate-header-field end)
+                   (beginning-of-line)))
+        (set-buffer-modified-p modified-flag)))))
+
+;;;###mh-autoload
+(defun mh-letter-skip-leading-whitespace-in-header-field ()
+  "Skip leading whitespace in a header field.
+If the header field doesn't have at least one space after the
+colon then a space character is added."
+  (let ((need-space t))
+    (while (memq (char-after) '(?\t ?\ ))
+      (forward-char)
+      (setq need-space nil))
+    (when need-space (insert " "))))
+
+(defun mh-letter-truncate-header-field (end)
+  "Replace text from current line till END with an ellipsis.
+If the current line is too long truncate a part of it as well."
+  (let ((max-len (min (window-width) 62)))
+    (when (> (+ (current-column) 4) max-len)
+      (backward-char (- (+ (current-column) 5) max-len)))
+    (when (> end (point))
+      (add-text-properties (point) end '(invisible vanish)))))
+
+;;;###mh-autoload
 (defun mh-signature-separator-p ()
   "Return non-nil if buffer includes \"^-- $\"."
   (save-excursion