mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-20 13:00:51 -07:00
Code Issues Projects Releases Wiki Activity

* mh-compat.el (mh-define-obsolete-variable-alias)

Browse source 
(mh-make-obsolete-variable): New macros to fix XEmacs compiler
warnings.

* mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable
macro.

* mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use new
mh-define-obsolete-variable-alias macro.

* mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and
flet elsewhere.

* mh-thread.el (mh-thread-set-tables): Replace flet with new alias
mh-cl-flet.

* mh-show.el (mh-gnus-article-highlight-citation): Replace flet with
new alias mh-cl-flet.

* mh-mime.el (mh-display-with-external-viewer, mh-mime-display)
(mh-press-button, mh-push-button, mh-display-emphasis): Replace flet
with new alias mh-cl-flet.

* mh-e.el (mh-invisible-header-fields-internal): Remove trailing
  whitespace.
This commit is contained in:
Bill Wohler 2012-11-24 20:13:04 -08:00
parent 5244bc019b
commit fb9958d7bc
8 changed files with 157 additions and 82 deletions
Download patch file Download diff file Expand all files Collapse all files

30
lisp/mh-e/ChangeLog
View file

@ -1,3 +1,30 @@
2012-11-25 Bill Wohler <wohler@newt.com>
* mh-compat.el (mh-define-obsolete-variable-alias)
(mh-make-obsolete-variable): New macros to fix XEmacs compiler
warnings.
* mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable
macro.
* mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use
new mh-define-obsolete-variable-alias macro.
* mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and
flet elsewhere.
* mh-thread.el (mh-thread-set-tables): Replace flet with new alias
mh-cl-flet.
* mh-show.el (mh-gnus-article-highlight-citation): Replace flet with new alias
mh-cl-flet.
* mh-mime.el (mh-display-with-external-viewer, mh-mime-display)
(mh-press-button, mh-push-button, mh-display-emphasis): Replace
flet with new alias mh-cl-flet.
* mh-e.el (mh-invisible-header-fields-internal): Remove trailing whitespace.
2012-11-25 Jeffrey C Honig <jch@honig.net>
* mh-comp.el: (mh-edit-again): Use the components file to specify
@ -10,8 +37,7 @@
(mh-find-components, mh-send-sub): Move code to locate components
file into a new function.
(mh-insert-auto-fields, mh-modify-header-field): New syntax for
calling mh-regexp-in-field-p.
(closes SF #1708292)
calling mh-regexp-in-field-p (closes SF #1708292).
2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>

4
lisp/mh-e/mh-comp.el
View file

@ -888,7 +888,7 @@ Optional argument BUFFER can be used to specify the buffer."
(t
(error "Can't find %s in %s or %s"
mh-comp-formfile mh-user-path mh-lib)))))
(defun mh-send-sub (to cc subject config)
"Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
@ -1204,7 +1204,7 @@ discarded."
(setq syntax-table mh-fcc-syntax-table))
(t
(setq syntax-table (syntax-table)))
)))
)))
(if (and (mh-goto-header-field field)
(set-syntax-table syntax-table)
(re-search-forward

40
lisp/mh-e/mh-compat.el
View file

@ -75,6 +75,12 @@ introduced in Emacs 22."
'cancel-timer
'delete-itimer))
;; Emacs 24 renamed flet to cl-flet.
(defalias 'mh-cl-flet
(if (fboundp 'cl-flet)
'cl-flet
'flet))
(defun mh-display-color-cells (&optional display)
"Return the number of color cells supported by DISPLAY.
This function is used by XEmacs to return 2 when `device-color-cells'
@ -242,6 +248,40 @@ This function returns nil on those systems."
This function returns nil on those systems."
nil)
(defmacro mh-define-obsolete-variable-alias
(obsolete-name current-name &optional when docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
See documentation for `define-obsolete-variable-alias' for a description
of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
and DOCSTRING. This macro is used by XEmacs that lacks WHEN and
DOCSTRING arguments."
(if (featurep 'xemacs)
`(define-obsolete-variable-alias ,obsolete-name ,current-name)
`(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring)))
(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
See documentation for `make-obsolete-variable' for a description
of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and
ACCESS-TYPE arguments."
(if (featurep 'xemacs)
`(make-obsolete-variable ,obsolete-name ,current-name)
`(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type)))
(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
See documentation for `make-obsolete-variable' for a description
of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and
ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE,
introduced in Emacs 24."
(if (featurep 'xemacs)
`(make-obsolete-variable ,obsolete-name ,current-name)
(if (< emacs-major-version 24)
`(make-obsolete-variable ,obsolete-name ,current-name ,when)
`(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))))
(defun-mh mh-match-string-no-properties
match-string-no-properties (num &optional string)
"Return string of text matched by last search, without text properties.

4
lisp/mh-e/mh-e.el
View file

@ -2671,7 +2671,7 @@ of citations entirely, choose \"None\"."
"X-MailScanner" ; ListProc(tm) by CREN
"X-Mailutils-Message-Id" ; GNU Mailutils
"X-Majordomo:" ; Majordomo mailing list manager
"X-Match:"
"X-Match:"
"X-MaxCode-Template:" ; Paypal http://www.paypal.com
"X-MB-Message-" ; AOL WebMail
"X-MDaemon-Deliver-To:"
@ -3276,7 +3276,7 @@ function used to insert the signature with
:group 'mh-letter
:package-version '(MH-E . "8.0"))
(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
(mh-define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
'mh-kill-folder-suppress-prompt-functions "24.3")
(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p)
"Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder].

2
lisp/mh-e/mh-letter.el
View file

@ -68,7 +68,7 @@ citation text as modified.
This is a normal hook, misnamed for historical reasons.
It is obsolete and is only used if `mail-citation-hook' is nil.")
(make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
(mh-make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")

117
lisp/mh-e/mh-mime.el
View file

@ -268,10 +268,12 @@ usually reads the file \"/etc/mailcap\"."
(buffer-read-only nil))
(when (string-match "^[^% \t]+$" method)
(setq method (concat method " %s")))
(flet ((mm-handle-set-external-undisplayer (handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(unwind-protect (mm-display-external part method)
(set-buffer-modified-p nil)))))
(mh-cl-flet
((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(unwind-protect (mm-display-external part method)
(set-buffer-modified-p nil)))))
nil))
;;;###mh-autoload
@ -523,47 +525,48 @@ parsed and then displayed."
(let ((handles ())
(folder mh-show-folder-buffer)
(raw-message-data (buffer-string)))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(goto-char (point-min))
(unless (search-forward "\n\n" nil t)
(goto-char (point-max))
(insert "\n\n"))
(mh-cl-flet
((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(goto-char (point-min))
(unless (search-forward "\n\n" nil t)
(goto-char (point-max))
(insert "\n\n"))
(condition-case err
(progn
;; If needed dissect the current buffer
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(if (setq handles (mm-dissect-buffer nil))
(mh-mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mh-mm-merge-handles handles
(mh-mime-handles (mh-buffer-data))))
(unless handles
(mh-decode-message-body)))
(condition-case err
(progn
;; If needed dissect the current buffer
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(if (setq handles (mm-dissect-buffer nil))
(mh-mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mh-mm-merge-handles handles
(mh-mime-handles (mh-buffer-data))))
(unless handles
(mh-decode-message-body)))
(cond ((and handles
(or (not (stringp (car handles)))
(cdr handles)))
;; Go to start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t)
(goto-char (point-max)))
(cond ((and handles
(or (not (stringp (car handles)))
(cdr handles)))
;; Go to start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t)
(goto-char (point-max)))
;; Delete the body
(delete-region (point) (point-max))
;; Delete the body
(delete-region (point) (point-max))
;; Display the MIME handles
(mh-mime-display-part handles))
(t
(mh-signature-highlight))))
(error
(message "Could not display body: %s" (error-message-string err))
(delete-region (point-min) (point-max))
(insert raw-message-data))))))
;; Display the MIME handles
(mh-mime-display-part handles))
(t
(mh-signature-highlight))))
(error
(message "Could not display body: %s" (error-message-string err))
(delete-region (point-min) (point-max))
(insert raw-message-data))))))
(defun mh-decode-message-body ()
"Decode message based on charset.
@ -1046,13 +1049,14 @@ attachment, the attachment is hidden."
(function (get-text-property (point) 'mh-callback))
(buffer-read-only nil)
(folder mh-show-folder-buffer))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(when (and function (eolp))
(backward-char))
(unwind-protect (and function (funcall function data))
(set-buffer-modified-p nil)))))
(mh-cl-flet
((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(when (and function (eolp))
(backward-char))
(unwind-protect (and function (funcall function data))
(set-buffer-modified-p nil)))))
(defun mh-push-button (event)
"Click MIME button for EVENT.
@ -1066,9 +1070,11 @@ to click the MIME button."
(mm-inline-media-tests mh-mm-inline-media-tests)
(data (get-text-property (point) 'mh-data))
(function (get-text-property (point) 'mh-callback)))
(flet ((mm-handle-set-external-undisplayer (handle func)
(mh-handle-set-external-undisplayer folder handle func)))
(and function (funcall function data))))))
(mh-cl-flet
((mm-handle-set-external-undisplayer
(handle func)
(mh-handle-set-external-undisplayer folder handle func)))
(and function (funcall function data))))))
(defun mh-handle-set-external-undisplayer (folder handle function)
"Replacement for `mm-handle-set-external-undisplayer'.
@ -1160,10 +1166,11 @@ this ;-)"
(defun mh-display-emphasis ()
"Display graphical emphasis."
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
(flet ((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
(article-emphasize)))))
(mh-cl-flet
((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
(article-emphasize)))))
(defun mh-small-show-buffer-p ()
"Check if show buffer is small.

15
lisp/mh-e/mh-show.el
View file

@ -899,13 +899,14 @@ See also `mh-folder-mode'.
(interactive)
;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
;; style?
(flet ((gnus-article-add-button (&rest args) nil))
(let* ((modified (buffer-modified-p))
(gnus-article-buffer (buffer-name))
(gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
,(car gnus-cite-face-list))))
(gnus-article-highlight-citation t)
(set-buffer-modified-p modified))))
(mh-cl-flet
((gnus-article-add-button (&rest args) nil))
(let* ((modified (buffer-modified-p))
(gnus-article-buffer (buffer-name))
(gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
,(car gnus-cite-face-list))))
(gnus-article-highlight-citation t)
(set-buffer-modified-p modified))))
(provide 'mh-show)

27
lisp/mh-e/mh-thread.el
View file

@ -645,19 +645,20 @@ Only information about messages in MSG-LIST are added to the tree."
(defun mh-thread-set-tables (folder)
"Use the tables of FOLDER in current buffer."
(flet ((mh-get-table (symbol)
(with-current-buffer folder
(symbol-value symbol))))
(setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
(setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
(setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
(setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
(setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
(setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
(setq mh-thread-subject-container-hash
(mh-get-table 'mh-thread-subject-container-hash))
(setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
(setq mh-thread-history (mh-get-table 'mh-thread-history))))
(mh-cl-flet
((mh-get-table (symbol)
(with-current-buffer folder
(symbol-value symbol))))
(setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
(setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
(setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
(setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
(setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
(setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
(setq mh-thread-subject-container-hash
(mh-get-table 'mh-thread-subject-container-hash))
(setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
(setq mh-thread-history (mh-get-table 'mh-thread-history))))
(defun mh-thread-process-in-reply-to (reply-to-header)
"Extract message id's from REPLY-TO-HEADER.