diff options
| author | Bill Wohler | 2006-01-30 01:32:17 +0000 |
|---|---|---|
| committer | Bill Wohler | 2006-01-30 01:32:17 +0000 |
| commit | a55f450f43bc0d37f660f08ce75734f5c43d9995 (patch) | |
| tree | 10c87f84f79b81055e5779a6c895ea17208e93f6 | |
| parent | a2c30782ecd2e0540e2989a0c531ccdc78869c7c (diff) | |
| download | emacs-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/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/mh-e/mh-comp.el | 28 | ||||
| -rw-r--r-- | lisp/mh-e/mh-letter.el | 81 | ||||
| -rw-r--r-- | lisp/mh-e/mh-utils.el | 109 |
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 @@ | |||
| 1 | 2006-01-29 Bill Wohler <wohler@newt.com> | 1 | 2006-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. | ||
| 1018 | Returns the empty string if the field is not in the header of the | ||
| 1019 | current 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 | |||
| 600 | Use this command to display truncated header fields. This command | ||
| 601 | is a toggle so entering it again will hide the field. This | ||
| 602 | command takes a prefix argument ARG: if negative then the field | ||
| 603 | is 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. | ||
| 905 | If the header field doesn't have at least one space after the | ||
| 906 | colon 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. |
| 916 | Move to end of entire header if FIELD not found. | 845 | Move 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. |
| 985 | This function does the same thing as | 915 | This 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. | ||
| 994 | If 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. | ||
| 810 | Returns the empty string if the field is not in the header of the | ||
| 811 | current 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. |
| 810 | Move to the end of the FIELD name, which should end in a colon. | 825 | Move 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 | |||
| 913 | Use this command to display truncated header fields. This command | ||
| 914 | is a toggle so entering it again will hide the field. This | ||
| 915 | command takes a prefix argument ARG: if negative then the field | ||
| 916 | is 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. | ||
| 956 | If the header field doesn't have at least one space after the | ||
| 957 | colon 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. | ||
| 966 | If 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 |