From fb9958d7bc8239666dbb115182be607d7c0a0c77 Mon Sep 17 00:00:00 2001 From: Bill Wohler Date: Sat, 24 Nov 2012 20:13:04 -0800 Subject: [PATCH] * 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. --- lisp/mh-e/ChangeLog | 30 +++++++++- lisp/mh-e/mh-comp.el | 4 +- lisp/mh-e/mh-compat.el | 40 +++++++++++++ lisp/mh-e/mh-e.el | 4 +- lisp/mh-e/mh-letter.el | 2 +- lisp/mh-e/mh-mime.el | 125 ++++++++++++++++++++++------------------- lisp/mh-e/mh-show.el | 15 ++--- lisp/mh-e/mh-thread.el | 27 ++++----- 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 + + * 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 * 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 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-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. -- 2.39.5