aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2006-01-30 01:32:17 +0000
committerBill Wohler2006-01-30 01:32:17 +0000
commita55f450f43bc0d37f660f08ce75734f5c43d9995 (patch)
tree10c87f84f79b81055e5779a6c895ea17208e93f6
parenta2c30782ecd2e0540e2989a0c531ccdc78869c7c (diff)
downloademacs-a55f450f43bc0d37f660f08ce75734f5c43d9995.tar.gz
emacs-a55f450f43bc0d37f660f08ce75734f5c43d9995.zip
* 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.
-rw-r--r--lisp/mh-e/ChangeLog21
-rw-r--r--lisp/mh-e/mh-comp.el28
-rw-r--r--lisp/mh-e/mh-letter.el81
-rw-r--r--lisp/mh-e/mh-utils.el109
4 files changed, 131 insertions, 108 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index d9df3290743..98b97dbb3c8 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,5 +1,26 @@
12006-01-29 Bill Wohler <wohler@newt.com> 12006-01-29 Bill Wohler <wohler@newt.com>
2 2
3 * mh-comp.el (mh-letter-hide-all-skipped-fields)
4 (mh-get-header-field): Move to mh-utils.el so that you can read
5 messages without having to load mh-comp.el and mh-letter.el.
6
7 * mh-letter.el (mh-hidden-header-keymap)
8 (mh-letter-toggle-header-field-display)
9 (mh-letter-skipped-header-field-p)
10 (mh-letter-skip-leading-whitespace-in-header-field)
11 (mh-letter-truncate-header-field): Move to mh-utils.el so that you
12 can read messages without having to load mh-comp.el and
13 mh-letter.el.
14
15 * mh-utils.el (mh-get-header-field)
16 (mh-letter-hide-all-skipped-fields)
17 (mh-letter-skipped-header-field-p, mh-hidden-header-keymap)
18 (mh-letter-toggle-header-field-display)
19 (mh-letter-skip-leading-whitespace-in-header-field)
20 (mh-letter-truncate-header-field): Move here from mh-comp.el and
21 mh-letter.el so that you can read messages without having to load
22 mh-comp.el and mh-letter.el.
23
3 * mh-comp.el (mh-insert-fields): Handle nil values. Rmail, at 24 * mh-comp.el (mh-insert-fields): Handle nil values. Rmail, at
4 least, will deliver them to us. 25 least, will deliver them to us.
5 26
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 529aac777d2..1122290a948 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -967,19 +967,6 @@ If the field already exists, this function does nothing."
967 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ") 967 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
968 (insert "X-Face: ")))))) 968 (insert "X-Face: "))))))
969 969
970;;;###mh-autoload
971(defun mh-letter-hide-all-skipped-fields ()
972 "Hide all skipped fields."
973 (save-excursion
974 (goto-char (point-min))
975 (save-restriction
976 (narrow-to-region (point) (mh-mail-header-end))
977 (while (re-search-forward mh-letter-header-field-regexp nil t)
978 (if (mh-letter-skipped-header-field-p (match-string 1))
979 (mh-letter-toggle-header-field-display -1)
980 (mh-letter-toggle-header-field-display 'long))
981 (beginning-of-line 2)))))
982
983(defun mh-tidy-draft-buffer () 970(defun mh-tidy-draft-buffer ()
984 "Run when a draft buffer is destroyed." 971 "Run when a draft buffer is destroyed."
985 (let ((buffer (get-buffer mh-recipients-buffer))) 972 (let ((buffer (get-buffer mh-recipients-buffer)))
@@ -1012,21 +999,6 @@ sequence."
1012 (mh-notate nil note 999 (mh-notate nil note
1013 (+ mh-cmd-note mh-scan-field-destination-offset))))))) 1000 (+ mh-cmd-note mh-scan-field-destination-offset)))))))
1014 1001
1015;;;###mh-autoload
1016(defun mh-get-header-field (field)
1017 "Find and return the body of FIELD in the mail header.
1018Returns the empty string if the field is not in the header of the
1019current buffer."
1020 (if (mh-goto-header-field field)
1021 (progn
1022 (skip-chars-forward " \t") ;strip leading white space in body
1023 (let ((start (point)))
1024 (mh-header-field-end)
1025 (buffer-substring-no-properties start (point))))
1026 ""))
1027
1028(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
1029
1030(defun mh-insert-header-separator () 1002(defun mh-insert-header-separator ()
1031 "Insert `mh-mail-header-separator', if absent." 1003 "Insert `mh-mail-header-separator', if absent."
1032 (save-excursion 1004 (save-excursion
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index b9fa52858fd..dfa96c63b5a 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -61,15 +61,6 @@
61 (to . mh-alias-letter-expand-alias)) 61 (to . mh-alias-letter-expand-alias))
62 "Alist of header fields and completion functions to use.") 62 "Alist of header fields and completion functions to use.")
63 63
64(defvar mh-hidden-header-keymap
65 (let ((map (make-sparse-keymap)))
66 (mh-do-in-gnu-emacs
67 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
68 (mh-do-in-xemacs
69 (define-key map '(button2)
70 'mh-letter-toggle-header-field-display-button))
71 map))
72
73(defvar mh-yank-hooks nil 64(defvar mh-yank-hooks nil
74 "Obsolete hook for modifying a citation just inserted in the mail buffer. 65 "Obsolete hook for modifying a citation just inserted in the mail buffer.
75 66
@@ -593,50 +584,6 @@ point to the last field from anywhere in the body."
593 (t (goto-char header-end) 584 (t (goto-char header-end)
594 (forward-line))))) 585 (forward-line)))))
595 586
596;;;###mh-autoload
597(defun mh-letter-toggle-header-field-display (arg)
598 "Toggle display of header field at point.
599
600Use this command to display truncated header fields. This command
601is a toggle so entering it again will hide the field. This
602command takes a prefix argument ARG: if negative then the field
603is hidden, if positive then the field is displayed."
604 (interactive (list nil))
605 (when (and (mh-in-header-p)
606 (progn
607 (end-of-line)
608 (re-search-backward mh-letter-header-field-regexp nil t)))
609 (let ((buffer-read-only nil)
610 (modified-flag (buffer-modified-p))
611 (begin (point))
612 end)
613 (end-of-line)
614 (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
615 (match-beginning 0)
616 (point-max))))
617 (goto-char begin)
618 ;; Make it clickable...
619 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
620 mouse-face highlight))
621 (unwind-protect
622 (cond ((or (and (not arg)
623 (text-property-any begin end 'invisible 'vanish))
624 (and (numberp arg) (>= arg 0))
625 (and (eq arg 'long) (> (line-beginning-position 5) end)))
626 (remove-text-properties begin end '(invisible nil))
627 (search-forward ":" (line-end-position) t)
628 (mh-letter-skip-leading-whitespace-in-header-field))
629 ;; XXX Redesign to make usable by user. Perhaps use a positive
630 ;; numeric prefix to make that many lines visible.
631 ((eq arg 'long)
632 (end-of-line 4)
633 (mh-letter-truncate-header-field end)
634 (beginning-of-line))
635 (t (end-of-line)
636 (mh-letter-truncate-header-field end)
637 (beginning-of-line)))
638 (set-buffer-modified-p modified-flag)))))
639
640(defun mh-open-line () 587(defun mh-open-line ()
641 "Insert a newline and leave point before it. 588 "Insert a newline and leave point before it.
642 589
@@ -893,24 +840,6 @@ body."
893 (forward-line))))) 840 (forward-line)))))
894 841
895;;;###mh-autoload 842;;;###mh-autoload
896(defun mh-letter-skipped-header-field-p (field)
897 "Check if FIELD is to be skipped."
898 (let ((field (downcase field)))
899 (loop for x in mh-compose-skipped-header-fields
900 when (equal (downcase x) field) return t
901 finally return nil)))
902
903(defun mh-letter-skip-leading-whitespace-in-header-field ()
904 "Skip leading whitespace in a header field.
905If the header field doesn't have at least one space after the
906colon then a space character is added."
907 (let ((need-space t))
908 (while (memq (char-after) '(?\t ?\ ))
909 (forward-char)
910 (setq need-space nil))
911 (when need-space (insert " "))))
912
913;;;###mh-autoload
914(defun mh-position-on-field (field &optional ignored) 843(defun mh-position-on-field (field &optional ignored)
915 "Move to the end of the FIELD in the header. 844 "Move to the end of the FIELD in the header.
916Move to end of entire header if FIELD not found. 845Move to end of entire header if FIELD not found.
@@ -980,6 +909,7 @@ Any match found replaces the text from BEGIN to END."
980 (not (null (string-match "\.vcf$" file)))) 909 (not (null (string-match "\.vcf$" file))))
981 (string-equal "text/x-vcard" (mh-file-mime-type file)))))) 910 (string-equal "text/x-vcard" (mh-file-mime-type file))))))
982 911
912;;;###mh-autoload
983(defun mh-letter-toggle-header-field-display-button (event) 913(defun mh-letter-toggle-header-field-display-button (event)
984 "Toggle header field display at location of EVENT. 914 "Toggle header field display at location of EVENT.
985This function does the same thing as 915This function does the same thing as
@@ -989,15 +919,6 @@ callable from a mouse button."
989 (mh-do-at-event-location event 919 (mh-do-at-event-location event
990 (mh-letter-toggle-header-field-display nil))) 920 (mh-letter-toggle-header-field-display nil)))
991 921
992(defun mh-letter-truncate-header-field (end)
993 "Replace text from current line till END with an ellipsis.
994If the current line is too long truncate a part of it as well."
995 (let ((max-len (min (window-width) 62)))
996 (when (> (+ (current-column) 4) max-len)
997 (backward-char (- (+ (current-column) 5) max-len)))
998 (when (> end (point))
999 (add-text-properties (point) end '(invisible vanish)))))
1000
1001(defun mh-extract-from-attribution () 922(defun mh-extract-from-attribution ()
1002 "Extract phrase or comment from From header field." 923 "Extract phrase or comment from From header field."
1003 (save-excursion 924 (save-excursion
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index a777cbfa68a..ec26a6a140c 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -805,6 +805,21 @@ used in searching."
805 (point) (progn (mh-header-field-end)(point)))))) 805 (point) (progn (mh-header-field-end)(point))))))
806 806
807;;;###mh-autoload 807;;;###mh-autoload
808(defun mh-get-header-field (field)
809 "Find and return the body of FIELD in the mail header.
810Returns the empty string if the field is not in the header of the
811current buffer."
812 (if (mh-goto-header-field field)
813 (progn
814 (skip-chars-forward " \t") ;strip leading white space in body
815 (let ((start (point)))
816 (mh-header-field-end)
817 (buffer-substring-no-properties start (point))))
818 ""))
819
820(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
821
822;;;###mh-autoload
808(defun mh-goto-header-field (field) 823(defun mh-goto-header-field (field)
809 "Move to FIELD in the message header. 824 "Move to FIELD in the message header.
810Move to the end of the FIELD name, which should end in a colon. 825Move to the end of the FIELD name, which should end in a colon.
@@ -862,6 +877,100 @@ Handles RFC 822 continuation lines."
862 (backward-char 1)) ;to end of previous line 877 (backward-char 1)) ;to end of previous line
863 878
864;;;###mh-autoload 879;;;###mh-autoload
880(defun mh-letter-hide-all-skipped-fields ()
881 "Hide all skipped fields."
882 (save-excursion
883 (goto-char (point-min))
884 (save-restriction
885 (narrow-to-region (point) (mh-mail-header-end))
886 (while (re-search-forward mh-letter-header-field-regexp nil t)
887 (if (mh-letter-skipped-header-field-p (match-string 1))
888 (mh-letter-toggle-header-field-display -1)
889 (mh-letter-toggle-header-field-display 'long))
890 (beginning-of-line 2)))))
891
892;;;###mh-autoload
893(defun mh-letter-skipped-header-field-p (field)
894 "Check if FIELD is to be skipped."
895 (let ((field (downcase field)))
896 (loop for x in mh-compose-skipped-header-fields
897 when (equal (downcase x) field) return t
898 finally return nil)))
899
900(defvar mh-hidden-header-keymap
901 (let ((map (make-sparse-keymap)))
902 (mh-do-in-gnu-emacs
903 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
904 (mh-do-in-xemacs
905 (define-key map '(button2)
906 'mh-letter-toggle-header-field-display-button))
907 map))
908
909;;;###mh-autoload
910(defun mh-letter-toggle-header-field-display (arg)
911 "Toggle display of header field at point.
912
913Use this command to display truncated header fields. This command
914is a toggle so entering it again will hide the field. This
915command takes a prefix argument ARG: if negative then the field
916is hidden, if positive then the field is displayed."
917 (interactive (list nil))
918 (when (and (mh-in-header-p)
919 (progn
920 (end-of-line)
921 (re-search-backward mh-letter-header-field-regexp nil t)))
922 (let ((buffer-read-only nil)
923 (modified-flag (buffer-modified-p))
924 (begin (point))
925 end)
926 (end-of-line)
927 (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
928 (match-beginning 0)
929 (point-max))))
930 (goto-char begin)
931 ;; Make it clickable...
932 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
933 mouse-face highlight))
934 (unwind-protect
935 (cond ((or (and (not arg)
936 (text-property-any begin end 'invisible 'vanish))
937 (and (numberp arg) (>= arg 0))
938 (and (eq arg 'long) (> (line-beginning-position 5) end)))
939 (remove-text-properties begin end '(invisible nil))
940 (search-forward ":" (line-end-position) t)
941 (mh-letter-skip-leading-whitespace-in-header-field))
942 ;; XXX Redesign to make usable by user. Perhaps use a positive
943 ;; numeric prefix to make that many lines visible.
944 ((eq arg 'long)
945 (end-of-line 4)
946 (mh-letter-truncate-header-field end)
947 (beginning-of-line))
948 (t (end-of-line)
949 (mh-letter-truncate-header-field end)
950 (beginning-of-line)))
951 (set-buffer-modified-p modified-flag)))))
952
953;;;###mh-autoload
954(defun mh-letter-skip-leading-whitespace-in-header-field ()
955 "Skip leading whitespace in a header field.
956If the header field doesn't have at least one space after the
957colon then a space character is added."
958 (let ((need-space t))
959 (while (memq (char-after) '(?\t ?\ ))
960 (forward-char)
961 (setq need-space nil))
962 (when need-space (insert " "))))
963
964(defun mh-letter-truncate-header-field (end)
965 "Replace text from current line till END with an ellipsis.
966If the current line is too long truncate a part of it as well."
967 (let ((max-len (min (window-width) 62)))
968 (when (> (+ (current-column) 4) max-len)
969 (backward-char (- (+ (current-column) 5) max-len)))
970 (when (> end (point))
971 (add-text-properties (point) end '(invisible vanish)))))
972
973;;;###mh-autoload
865(defun mh-signature-separator-p () 974(defun mh-signature-separator-p ()
866 "Return non-nil if buffer includes \"^-- $\"." 975 "Return non-nil if buffer includes \"^-- $\"."
867 (save-excursion 976 (save-excursion