mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-26 19:18:50 +00:00
Correct cl-flet usage (Bug#22317)
* mh-compat.el: Rename mh-cl-flet to mh-flet and convert alias to macro using patch from Katsumi Yamaoka <yamaoka@jpl.org>. * mh-thread.el (mh-thread-set-tables): * mh-show.el (mh-gnus-article-highlight-citation): * mh-mime.el (mh-display-with-external-viewer): (mh-mime-display, mh-press-button, mh-push-button): (mh-display-emphasis): Call mh-flet instead of mh-cl-flet.
This commit is contained in:
parent
50caae30b0
commit
0992ec3b0b
@ -75,11 +75,24 @@ 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))
|
||||
;; Emacs 24 made flet obsolete and suggested either cl-flet or
|
||||
;; cl-letf. This macro is based upon gmm-flet from Gnus.
|
||||
(defmacro mh-flet (bindings &rest body)
|
||||
"Make temporary overriding function definitions.
|
||||
This is an analogue of a dynamically scoped `let' that operates on
|
||||
the function cell of FUNCs rather than their value cell.
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(if (fboundp 'cl-letf)
|
||||
`(cl-letf ,(mapcar (lambda (binding)
|
||||
`((symbol-function ',(car binding))
|
||||
(lambda ,@(cdr binding))))
|
||||
bindings)
|
||||
,@body)
|
||||
`(flet ,bindings ,@body)))
|
||||
(put 'mh-flet 'lisp-indent-function 1)
|
||||
(put 'mh-flet 'edebug-form-spec
|
||||
'((&rest (sexp sexp &rest form)) &rest form))
|
||||
|
||||
(defun mh-display-color-cells (&optional display)
|
||||
"Return the number of color cells supported by DISPLAY.
|
||||
|
@ -268,7 +268,7 @@ usually reads the file \"/etc/mailcap\"."
|
||||
(buffer-read-only nil))
|
||||
(when (string-match "^[^% \t]+$" method)
|
||||
(setq method (concat method " %s")))
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
@ -525,7 +525,7 @@ parsed and then displayed."
|
||||
(let ((handles ())
|
||||
(folder mh-show-folder-buffer)
|
||||
(raw-message-data (buffer-string)))
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
@ -1049,7 +1049,7 @@ attachment, the attachment is hidden."
|
||||
(function (get-text-property (point) 'mh-callback))
|
||||
(buffer-read-only nil)
|
||||
(folder mh-show-folder-buffer))
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((mm-handle-set-external-undisplayer
|
||||
(handle function)
|
||||
(mh-handle-set-external-undisplayer folder handle function)))
|
||||
@ -1070,7 +1070,7 @@ 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)))
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((mm-handle-set-external-undisplayer
|
||||
(handle func)
|
||||
(mh-handle-set-external-undisplayer folder handle func)))
|
||||
@ -1166,7 +1166,7 @@ this ;-)"
|
||||
(defun mh-display-emphasis ()
|
||||
"Display graphical emphasis."
|
||||
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((article-goto-body ())) ; shadow this function to do nothing
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
@ -900,7 +900,7 @@ See also `mh-folder-mode'.
|
||||
(interactive)
|
||||
;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
|
||||
;; style?
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((gnus-article-add-button (&rest args) nil))
|
||||
(let* ((modified (buffer-modified-p))
|
||||
(gnus-article-buffer (buffer-name))
|
||||
|
@ -647,7 +647,7 @@ 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."
|
||||
(mh-cl-flet
|
||||
(mh-flet
|
||||
((mh-get-table (symbol)
|
||||
(with-current-buffer folder
|
||||
(symbol-value symbol))))
|
||||
|
Loading…
Reference in New Issue
Block a user