mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-19 18:13:55 +00:00
Code Issues Releases Activity

* mh-comp.el (mh-letter-hide-all-skipped-fields)

Browse Source 
(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.
This commit is contained in:
Bill Wohler 2006-01-30 01:32:17 +00:00
parent a2c30782ec
commit a55f450f43
4 changed files with 131 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lisp/mh-e/ChangeLog
View File

@ -1,5 +1,26 @@
2006-01-29 Bill Wohler <wohler@newt.com>
* 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.

28
lisp/mh-e/mh-comp.el
View File

@ -967,19 +967,6 @@ If the field already exists, this function does nothing."
(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 @@ sequence."
(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

81
lisp/mh-e/mh-letter.el
View File

@ -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 @@ point to the last field from anywhere in the body."
(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.
@ -892,24 +839,6 @@ body."
(t (goto-char header-end)
(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.
@ -980,6 +909,7 @@ Any match found replaces the text from BEGIN to END."
(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 @@ callable from a mouse button."
(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

109
lisp/mh-e/mh-utils.el
View File

@ -804,6 +804,21 @@ used in searching."
(buffer-substring-no-properties
(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.
@ -861,6 +876,100 @@ Handles RFC 822 continuation lines."
(forward-line 1))
(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 \"^-- $\"."