summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBill Wohler <wohler@newt.com>2012-11-24 20:13:04 -0800
committerBill Wohler <wohler@newt.com>2012-11-24 20:13:04 -0800
commitfb9958d7bc8239666dbb115182be607d7c0a0c77 (patch)
tree27b8f8a740266b2871ed47ddf0b78f32b7666d6b
parent5244bc019bf7376caff3bb198ff674e0ad9fb0e6 (diff)
downloademacs-fb9958d7bc8239666dbb115182be607d7c0a0c77.tar.gz
* 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.
-rw-r--r--lisp/mh-e/ChangeLog30
-rw-r--r--lisp/mh-e/mh-comp.el4
-rw-r--r--lisp/mh-e/mh-compat.el40
-rw-r--r--lisp/mh-e/mh-e.el4
-rw-r--r--lisp/mh-e/mh-letter.el2
-rw-r--r--lisp/mh-e/mh-mime.el125
-rw-r--r--lisp/mh-e/mh-show.el15
-rw-r--r--lisp/mh-e/mh-thread.el27
8 files changed, 161 insertions, 86 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 94ecfa138fe..75a06d39697 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -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>
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index d34de619268..3b24afd89ce 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -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
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 4a93109e7a4..973a5ca5833 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -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.
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 94905e7984f..20739ca9d82 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -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].
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 47554ce66a3..8965439a275 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -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")
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 66e1ba5ec69..5ce6159e2d5 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -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"))
-
- (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)))
-
- ;; 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))))))
+ (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)))
+
+ (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))
+
+ ;; 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.
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index ee516f8ede8..4fb9fad0919 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -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)
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index 48c06c3df87..ba2c61f1708 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -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.