bug#22317: 25.0.50; mh-e: wrong usage of cl-flet

[Glenn Morris <rgm@gnu.org>]

mh-e-devel, FYI:

http://debbugs.gnu.org/22317

Katsumi Yamaoka wrote:

> 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):
>
> --8<---------------cut here---------------start------------->8---
> (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))
> --8<---------------cut here---------------end--------------->8---
>
> I'm not the right person to install it since I'm not a mh-e user,
> sorry.
>
> Regards,