# HG changeset patch # User Bill Wohler # Date 1138584737 0 # Node ID 0f44616074ba29c45f00c61f9ae6eb0e050325db # Parent a58223a143bc2d15d30684e54fcf070debe698d9 * 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. diff -r a58223a143bc -r 0f44616074ba lisp/mh-e/ChangeLog --- a/lisp/mh-e/ChangeLog Mon Jan 30 00:53:30 2006 +0000 +++ b/lisp/mh-e/ChangeLog Mon Jan 30 01:32:17 2006 +0000 @@ -1,5 +1,26 @@ 2006-01-29 Bill Wohler + * 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. diff -r a58223a143bc -r 0f44616074ba lisp/mh-e/mh-comp.el --- a/lisp/mh-e/mh-comp.el Mon Jan 30 00:53:30 2006 +0000 +++ b/lisp/mh-e/mh-comp.el Mon Jan 30 01:32:17 2006 +0000 @@ -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 diff -r a58223a143bc -r 0f44616074ba lisp/mh-e/mh-letter.el --- a/lisp/mh-e/mh-letter.el Mon Jan 30 00:53:30 2006 +0000 +++ b/lisp/mh-e/mh-letter.el Mon Jan 30 01:32:17 2006 +0000 @@ -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 diff -r a58223a143bc -r 0f44616074ba lisp/mh-e/mh-utils.el --- a/lisp/mh-e/mh-utils.el Mon Jan 30 00:53:30 2006 +0000 +++ b/lisp/mh-e/mh-utils.el Mon Jan 30 01:32:17 2006 +0000 @@ -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