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.

4 files changed, 25 insertions, 12 deletions

diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 10a8b6e219c..21ff5cb2cb8 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -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.
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index df3a42ec0f7..b8d700ddf5f 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -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))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index afe9812eea8..26e821696a8 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -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))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index 5135e7e88fa..e6acdba8b30 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -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))))