+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
(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>
(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.
(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
'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'
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.
"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:"
: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].
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")
\f
(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
(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.
(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.
(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'.
(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.
(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)
(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.