Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
442 views
in Technique[技术] by (71.8m points)

emacs - flet works, but with obsolete message; cl-flet does not work

I'm trying to temporarily turn off the yes-or-no-p within a function that is defined elsewhere and then restore things to the way they were. Using flet works, but creates a *compile-log* buffer telling me that it is obsolete and to use cl-flet instead. However, cl-flet doesn't seem to work with this attempt at defadvice -- i.e., nothing happens and the yes-or-no-p remains active. Any ideas on how to avoid the error message and make this work also?

(defun function-without-confirmation ()

(defadvice elmo-dop-queue-flush (around stfu activate)
      (flet ((yes-or-no-p (&rest args) t)
             (y-or-n-p (&rest args) t))
        ad-do-it))

. . . .


(ad-unadvise 'elmo-dop-queue-flush)

)

I cannot take credit for the answer, because that was solved by wvxvw, so I'll put the relevant fix underneath the original question. The new macro is called lawlist-flet instad of flet, and the obsolete line has been commented out:

(defmacro lawlist-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.
If you want the Common-Lisp style of `flet', you should use `cl-flet'.
The FORMs are evaluated with the specified function definitions in place,
then the definitions are undone (the FUNCs go back to their previous
definitions, or lack thereof).

(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
  (declare (indent 1) (debug cl-flet)
;;           (obsolete "use either `cl-flet' or `cl-letf'."  "24.3")
                )
  `(letf ,(mapcar
           (lambda (x)
             (if (or (and (fboundp (car x))
                          (eq (car-safe (symbol-function (car x))) 'macro))
                     (cdr (assq (car x) macroexpand-all-environment)))
                 (error "Use `labels', not `flet', to rebind macro names"))
             (let ((func `(cl-function
                           (lambda ,(cadr x)
                             (cl-block ,(car x) ,@(cddr x))))))
               (when (cl--compiling-file)
                 ;; Bug#411.  It would be nice to fix this.
                 (and (get (car x) 'byte-compile)
                      (error "Byte-compiling a redefinition of `%s' 
will not work - use `labels' instead" (symbol-name (car x))))
                 ;; FIXME This affects the rest of the file, when it
                 ;; should be restricted to the flet body.
                 (and (boundp 'byte-compile-function-environment)
                      (push (cons (car x) (eval func))
                            byte-compile-function-environment)))
               (list `(symbol-function ',(car x)) func)))
           bindings)
     ,@body))

And, here is the modified function that eliminates the error message relating to flet being obsolete.

(defun function-without-confirmation ()

(defadvice elmo-dop-queue-flush (around stfu activate)
      (lawlist-flet ((yes-or-no-p (&rest args) t)
             (y-or-n-p (&rest args) t))
        ad-do-it))

. . . .


(ad-unadvise 'elmo-dop-queue-flush)
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Here's how I'd recommend you do it:

(defvar stfu-inhibit-yonp nil)
(defadvice yes-or-no-p (around stfu activate)
  (if stfu-inhibit-yonp (setq ad-return t) ad-do-it))
(defadvice y-or-n-p (around stfu activate)
  (if stfu-inhibit-yonp (setq ad-return t) ad-do-it))

(defadvice elmo-dop-queue-flush (around stfu activate)
  (let ((stfu-inhibit-yonp t))
    ad-do-it))

Contrary to CL's flet this will make it clear (e.g. in C-h f yes-or-no-p) that something's going on with yes-or-no-p.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...