emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Where to put fix for #22317, mh-e: wrong usage of cl-flet


From: Bill Wohler
Subject: Where to put fix for #22317, mh-e: wrong usage of cl-flet
Date: Sun, 01 May 2016 19:19:48 -0700

I've applied Katsumi's fix to MH-E and have been using it for a while
now. I haven't noticed any difference.

Please consider the following short patch and recommend whether I should
1) apply it to emacs-25, 2) apply it to master, or 3) apply it to master
with a note to apply it to emacs-25 after the release. If 3), please
suggest specific text that catches your attention.

-- 
Bill Wohler <address@hidden> aka <address@hidden>
http://www.newt.com/wohler/
GnuPG ID:610BD9AD

diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 10a8b6e..21ff5cb 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -75,11 +75,24 @@ 'mh-cancel-timer
       '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 df3a42e..b8d700d 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -268,7 +268,7 @@ mh-display-with-external-viewer
               (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 @@ mh-mime-display
   (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 @@ mh-press-button
         (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 @@ mh-push-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 @@ mh-display-smileys
 (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 afe9812..26e8216 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -900,7 +900,7 @@ mh-gnus-article-highlight-citation
   (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 5135e7e..e6acdba 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -647,7 +647,7 @@ mh-thread-generate
 
 (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))))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]