#482 Incorrect usage of cl-flet

[Bill Wohler]

Katsumi Yamaoka yamaoka@jpl.org submitted Emacs bug#22317:
25.0.50; mh-e: wrong usage of cl-flet

Hi,

mh-e uses Gnus functions to render MIME messages and uses the mh-cl-flet macro to modify some of them. Currently mh-e always loads cl (see mh-acros.el), so both cl-flet and flet are available and mh-cl-flet will become cl-flet:

,----
| ;; Emacs 24 renamed flet to cl-flet.
| (defalias 'mh-cl-flet
|   (if (fboundp 'cl-flet)
|       'cl-flet
|     'flet))
`----

However, cl-flet is quite unlike flet, IIUC. For instance, if cl-flet is used, the mh-cl-flet code in mh-display-emphasis

,----
| ;; (defun mh-display-emphasis ()
| ;;   "Display graphical emphasis."
| ;;   (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
|        (mh-cl-flet
|         ((article-goto-body ()))      ; shadow this function to do nothing
|         (save-excursion
|           (goto-char (point-min))
|           (article-emphasize)))
| ;;     ))
`----

will be expanded to

,----
| (progn
|   (save-excursion
|     (goto-char (point-min))
|     (article-emphasize)))
`----

whereas if flet is used, it will be expanded to:

,----
| (let* ((vnew (cl-function (lambda nil
|                           (cl-block article-goto-body))))
|        (old (symbol-function 'article-goto-body)))
|   (unwind-protect
|       (progn
|       (fset 'article-goto-body vnew)
|       (save-excursion
|         (goto-char (point-min))
|         (article-emphasize)))
|     (fset 'article-goto-body old)))
`----

Note that the former doesn't achieve the original target, i.e.,article-goto-body is not modified while running article-emphasize.

I don't know how it damages the behavior of mh-e, but I think it should be fixed anyway. If mh-e keeps loading cl as ever,mh-cl-flet can be:

(defalias 'mh-cl-flet 'flet)

Otherwise use this complete Emacs-Lisp style flet emulation macro (a copy of gmm-flet that exists in only the Gnus git master):

(defmacro mh-cl-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...)"
  (require 'cl)
  (if (fboundp 'cl-letf)
      `(cl-letf ,(mapcar (lambda (binding)
                           `((symbol-function ',(car binding))
                             (lambda ,@(cdr binding))))
                         bindings)
         ,@body)
    `(flet ,bindings ,@body)))
(put 'mh-cl-flet 'lisp-indent-function 1)
(put 'mh-cl-flet 'edebug-form-spec
     '((&rest (sexp sexp &rest form)) &rest form))

I'm not the right person to install it since I'm not a mh-e user,sorry.

Regards,

[Bill Wohler]

Katsumi had previously posted this in 2012-12-06:

Hi,

IMHO, isn't what you really want cl-letf, not cl-flet? Though it needs to have some accessories so as to work like flet.

;; This does not override `mm-handle-set-external-undisplayer'.
(progn (pp (macroexpand-all
'(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)
 => (let ((--cl-mm-handle-set-external-undisplayer--
           #'(lambda (handle function)
               (mh-handle-set-external-undisplayer folder handle function))))
      (unwind-protect
          (mm-display-external part method)
        (set-buffer-modified-p nil)))

;; This does it.
(progn (pp (macroexpand-all
'(gmm-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)
 => (let* ((vnew
            #'(lambda (handle function)
                (mh-handle-set-external-undisplayer folder handle function)))
           (old (symbol-function 'mm-handle-set-external-undisplayer)))
      (unwind-protect
          (progn
            (fset 'mm-handle-set-external-undisplayer vnew)
            (unwind-protect
                (mm-display-external part method)
              (set-buffer-modified-p nil)))
        (fset 'mm-handle-set-external-undisplayer old)))

Where the `gmm-flet' macro, that uses cl-letf, is now available only in Ma Gnus. Why it is not in the Emacs trunk is that I've removed it following RMS's statement:

http://thread.gmane.org/gmane.emacs.diffs/118608/focus=155306

As for Gnus such a macro is not necessary for the present if it is used with the Emacs version that bundles it, however I have no idea for MH-E better than overriding. :-<

[Bill Wohler]

Here is Katsumi's reply to my response on 2013-04-05:

Hi,

Bill Wohler wrote:

Thanks, Katsumi. I was simply trying to overcome a new deprecated
warning. When I have some time, I'll try to understand this more.

What I wanted to say was that some mh-e functions that use mh-cl-flet for utilizing Gnus functions won't work as expected. For example,AFAIU, the function mh-display-with-external-viewer tries to substitute mm-handle-set-external-undisplayer with mh-handle-set-external-undisplayer while performing mm-display-external. Its mh-cl-flet form is expanded as folows:

(progn (pp (macroexpand-all (quote
         (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)
        ↓
(let ((--cl-mm-handle-set-external-undisplayer--
       #'(lambda (handle function)
           (mh-handle-set-external-undisplayer folder handle function))))
  (unwind-protect
      (mm-display-external part method)
    (set-buffer-modified-p nil)))

However, as you can see, mh-handle-set-external-undisplayer will never be used. This is the case where mh-cl-flet is an alias to cl-flet, that happens under Emacs 24.3 and up. If it is an alias to flet, the expanded form will be:

(let* ((vnew
        #'(lambda (handle function)
            (progn
              (mh-handle-set-external-undisplayer folder handle function))))
       (old
        (symbol-function 'mm-handle-set-external-undisplayer)))
  (unwind-protect
      (progn
        (fset 'mm-handle-set-external-undisplayer vnew)
        (unwind-protect
            (mm-display-external part method)
          (set-buffer-modified-p nil)))
    (fset 'mm-handle-set-external-undisplayer old)))

This is what it should be, isn't it? For that purpose, cl-flet is a mischoice, cl-letf should be used instead. Here is a macro that uses cl-letf to emulate flet:

(defmacro gmm-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...)"
  (require 'cl)
  (if (fboundp 'cl-letf)
      `(cl-letf ,(mapcar (lambda (binding)
                           `((symbol-function ',(car binding))
                             (lambda ,@(cdr binding))))
                         bindings)
         ,@body)
    `(flet ,bindings ,@body)))

With replacing mh-cl-flet with this, the form shown above will be expanded like the following:

(progn (pp (macroexpand-all (quote
         (gmm-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)
        ↓
(let* ((vnew
        #'(lambda (handle function)
            (mh-handle-set-external-undisplayer folder handle function)))
       (old
        (symbol-function 'mm-handle-set-external-undisplayer)))
  (unwind-protect
      (progn
        (fset 'mm-handle-set-external-undisplayer vnew)
        (unwind-protect
            (mm-display-external part method)
          (set-buffer-modified-p nil)))
    (fset 'mm-handle-set-external-undisplayer old)))

Note that, gmm-flet exists only in the Gnus Git master, not the Emacs trunk. Maybe some Emacs core developers don't like it. Related readings: https://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00096.html and the thread.

Anyway, the macro name mh-cl-flet had better be renamed into something like mh-flet, I think.

[Mike Kupfer]

It looks like this was fixed by

commit 0992ec3b0bfaf98edce1d08462e9ec8e11d6b6e6
Author: Bill Wohler wohler@newt.com
Date: Mon May 30 16:49:37 2016 -0700

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.

though checkdoc complains that the "bindings" argument is never mentioned in the docstring for mh-flet.

[Bill Wohler]

I'm going to have to agree with Mike. We'll put the flet bug to rest unless we hear otherwise. Resolving as fixed.