edebug-spec; it aborts the instrumentation, displaying the message in
the minibuffer.
-@item &lookup
-Selects a specification based on the code being instrumented.
-It takes the form @code{&lookup @var{spec} @var{fun} @var{args...}}
+@item &interpose
+Lets a function control the parsing of the remaining code.
+It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}}
and means that Edebug will first match @var{spec} against the code and
-then match the rest against the specification returned by calling
-@var{fun} with the concatenation of @var{args...} and the code that
-matched @code{spec}. For example @code{(&lookup symbolp
-pcase--get-edebug-spec)} matches sexps whose first element is
-a symbol and whose subsequent elements must obey the spec associated
-with that head symbol according to @code{pcase--get-edebug-spec}.
+then call @var{fun} with the code that matched @code{spec}, a parsing
+function var{pf}, and finally @var{args...}. The parsing
+function expects a single argument indicating the specification list
+to use to parse the remaining code. It should be called exactly once
+and returns the instrumented code that @var{fun} is expected to return.
+For example @code{(&interpose symbolp pcase--match-pat-args)} matches
+sexps whose first element is a symbol and then lets
+@code{pcase--match-pat-args} lookup the specs associated
+with that head symbol according to @code{pcase--match-pat-args} and
+pass them to the var{pf} it received as argument.
@item @var{other-symbol}
@cindex indirect specifications
*** Edebug specification lists can use some new keywords:
+++
-**** '&lookup SPEC FUN ARGS...' lets FUN compute the specs to use
+**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
+More specifically, FUN is called with 'HEAD PF ARGS..' where
+PF is a parsing function that expects a single argument (the specs to
+use) and HEAD is the code that matched SPEC.
+++
**** '&error MSG' unconditionally aborts the current edebug instrumentation.
(setf (cl--generic name) (setq generic (cl--generic-make name))))
generic))
+(defvar cl--generic-edebug-name nil)
+
+(defun cl--generic-edebug-remember-name (name pf &rest specs)
+ ;; Remember the name in `cl-defgeneric' so we can use it when building
+ ;; the names of its `:methods'.
+ (let ((cl--generic-edebug-name (car name)))
+ (funcall pf specs)))
+
+(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args)
+ ;; The name to use in Edebug for a method: use the generic
+ ;; function's name plus all its qualifiers and finish with
+ ;; its specializers.
+ (pcase-let*
+ ((basename (if in:method cl--generic-edebug-name (pop quals-and-args)))
+ (args (car (last quals-and-args)))
+ (`(,spec-args . ,_) (cl--generic-split-args args))
+ (specializers (mapcar (lambda (spec-arg)
+ (if (eq '&context (car-safe (car spec-arg)))
+ spec-arg (cdr spec-arg)))
+ spec-args)))
+ (format "%s %s"
+ (mapconcat (lambda (sexp) (format "%s" sexp))
+ (cons basename (butlast quals-and-args))
+ " ")
+ specializers)))
+
;;;###autoload
(defmacro cl-defgeneric (name args &rest options-and-methods)
"Create a generic function NAME.
\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
(declare (indent 2) (doc-string 3)
(debug
- (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
- listp lambda-doc
- [&rest [&or
- ("declare" &rest sexp)
- (":argument-precedence-order" &rest sexp)
- (&define ":method"
- ;; FIXME: The `gensym'
- ;; construct works around
- ;; Bug#42672. We'd rather want
- ;; names like those generated by
- ;; `cl-defmethod', but that
- ;; requires larger changes to
- ;; Edebug.
- [&name "cl-generic-:method@" []]
- [&name [] gensym] ;Make it unique!
- [&name
- [[&rest cl-generic--method-qualifier-p]
- ;; FIXME: We don't actually want the
- ;; argument's names to be considered
- ;; part of the name of the defined
- ;; function.
- listp]] ;Formal args
- lambda-doc
- def-body)]]
- def-body)))
+ (&define
+ &interpose
+ [&name sexp] ;Allow (setf ...) additionally to symbols.
+ cl--generic-edebug-remember-name
+ listp lambda-doc
+ [&rest [&or
+ ("declare" &rest sexp)
+ (":argument-precedence-order" &rest sexp)
+ (&define ":method"
+ [&name
+ [[&rest cl-generic--method-qualifier-p]
+ listp] ;Formal args
+ cl--generic-edebug-make-name in:method]
+ lambda-doc
+ def-body)]]
+ def-body)))
(let* ((doc (if (stringp (car-safe options-and-methods))
(pop options-and-methods)))
(declarations nil)
(debug
(&define ; this means we are defining something
[&name [sexp ;Allow (setf ...) additionally to symbols.
- ;; Multiple qualifiers are allowed.
- [&rest cl-generic--method-qualifier-p]
- ;; FIXME: We don't actually want the argument's names
- ;; to be considered part of the name of the
- ;; defined function.
- listp]] ; arguments
+ [&rest cl-generic--method-qualifier-p] ;qualifiers
+ listp] ; arguments
+ cl--generic-edebug-make-name nil]
lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil))
'(&rest ("cl-declare" &rest sexp)))
(def-edebug-elem-spec 'cl-declarations-or-string
- '(&or lambda-doc cl-declarations))
+ '(lambda-doc &or ("declare" def-declarations) cl-declarations))
(def-edebug-elem-spec 'cl-lambda-list
'(([&rest cl-lambda-arg]
(macroexp-progn body)
newenv)))))
+(defvar edebug-lexical-macro-ctx)
+
+(defun cl--edebug-macrolet-interposer (bindings pf &rest specs)
+ ;; (cl-assert (null (cdr bindings)))
+ (setq bindings (car bindings))
+ (let ((edebug-lexical-macro-ctx
+ (nconc (mapcar (lambda (binding)
+ (cons (car binding)
+ (when (eq 'declare (car-safe (nth 2 binding)))
+ (nth 1 (assq 'debug (cdr (nth 2 binding)))))))
+ bindings)
+ edebug-lexical-macro-ctx)))
+ (funcall pf specs)))
+
;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug (cl-macrolet-expr)))
+ (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"]
+ [&name [] gensym] ;Make it unique!
+ cl-macro-list
+ cl-declarations-or-string
+ def-body))
+ cl--edebug-macrolet-interposer
+ cl-declarations body)))
(if (cdr bindings)
`(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (macroexp-progn body)
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(let ((result
(cond
+ ;; IIUC, `&define' is treated specially here so as to avoid
+ ;; entering Edebug during the actual function's definition:
+ ;; we only want to enter Edebug later when the thing is called.
(defining-form-p
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
(defvar edebug-inside-func) ;; whether code is inside function context.
;; Currently def-form sets this to nil; def-body sets it to t.
-(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
+
+(defvar edebug-lexical-macro-ctx nil
+ "Alist mapping lexically scoped macro names to their debug spec.")
(defun edebug-make-enter-wrapper (forms)
;; Generate the enter wrapper for some forms of a definition.
(defsubst edebug-list-form-args (head cursor)
;; Process the arguments of a list form given that head of form is a symbol.
;; Helper for edebug-list-form
- (let ((spec (edebug-get-spec head)))
+ (let* ((lex-spec (assq head edebug-lexical-macro-ctx))
+ (spec (if lex-spec (cdr lex-spec)
+ (edebug-get-spec head))))
(cond
- ;; Treat cl-macrolet bindings like macros with no spec.
- ((member head edebug--cl-macrolet-defs)
- (if edebug-eval-macro-args
- (edebug-forms cursor)
- (edebug-sexps cursor)))
(spec
(cond
((consp spec)
; but leave it in for compatibility.
))
;; No edebug-form-spec provided.
- ((macrop head)
+ ((or lex-spec (macrop head))
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
(first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
(match (cond
((eq ?& first-char);; "&" symbols take all following specs.
- (edebug--handle-&-spec-op spec cursor (cdr specs)))
+ (edebug--match-&-spec-op spec cursor (cdr specs)))
((eq ?: first-char);; ":" symbols take one following spec.
(setq rest (cdr (cdr specs)))
(edebug--handle-:-spec-op spec cursor (car (cdr specs))))
(def-form . edebug-match-def-form)
;; Less frequently used:
;; (function . edebug-match-function)
- (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
- (cl-macrolet-name . edebug-match-cl-macrolet-name)
- (cl-macrolet-body . edebug-match-cl-macrolet-body)
(place . edebug-match-place)
(gate . edebug-match-gate)
;; (nil . edebug-match-nil) not this one - special case it.
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
;; Reuse the &optional handler with this as the remainder handler.
(edebug-&optional-wrapper cursor specs remainder-handler))
-(cl-defgeneric edebug--handle-&-spec-op (op cursor specs)
+(cl-defgeneric edebug--match-&-spec-op (op cursor specs)
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
;; Repeatedly use specs until failure.
(let ((edebug-&rest specs) ;; remember these
edebug-best-error
(edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs)
- "Compute the specs for `&lookup SPEC FUN ARGS...'.
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+ "Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
-and then matches the rest against the output of (FUN ARGS... HEAD)."
+and then matches the rest by calling (FUN HEAD PF ARGS...)
+where PF is the parsing function which FUN can call exactly once,
+passing it the specs that it needs to match.
+Note that HEAD will always be a list, since specs are defined to match
+a sequence of elements."
(pcase-let*
((`(,spec ,fun . ,args) specs)
(exps (edebug-cursor-expressions cursor))
(instrumented-head (edebug-match-one-spec cursor spec))
(consumed (- (length exps)
(length (edebug-cursor-expressions cursor))))
- (newspecs (apply fun (append args (seq-subseq exps 0 consumed)))))
+ (head (seq-subseq exps 0 consumed)))
(cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
- ;; FIXME: What'd be the difference if we used `edebug-match-sublist',
- ;; which is what `edebug-list-form-args' uses for the similar purpose
- ;; when matching "normal" forms?
- (append instrumented-head (edebug-match cursor newspecs))))
-
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs)
+ (apply fun `(,head
+ ,(lambda (newspecs)
+ ;; FIXME: What'd be the difference if we used
+ ;; `edebug-match-sublist', which is what
+ ;; `edebug-list-form-args' uses for the similar purpose
+ ;; when matching "normal" forms?
+ (append instrumented-head (edebug-match cursor newspecs)))
+ ,@args))))
+
+(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
(save-excursion
- (edebug--handle-&-spec-op '&or cursor specs)))
+ (edebug--match-&-spec-op '&or cursor specs)))
nil))
;; This means something matched, so it is a no match.
(edebug-no-match cursor "Unexpected"))
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
- (edebug--handle-&-spec-op
+ (edebug--match-&-spec-op
'&rest
cursor
(cons '&or
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
offsets)
specs))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
suffix)))
nil)
-(defvar edebug--cl-macrolet-defs nil
- "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
-(defvar edebug--current-cl-macrolet-defs nil
- "List of symbols found within the bindings of the current `cl-macrolet' form.")
-
-(defun edebug-match-cl-macrolet-expr (cursor)
- "Match a `cl-macrolet' form at CURSOR."
- (let (edebug--current-cl-macrolet-defs)
- (edebug-match cursor
- '((&rest (&define cl-macrolet-name cl-macro-list
- cl-declarations-or-string
- def-body))
- cl-declarations cl-macrolet-body))))
-
-(defun edebug-match-cl-macrolet-name (cursor)
- "Match the name in a `cl-macrolet' binding at CURSOR.
-Collect the names in `edebug--cl-macrolet-defs' where they
-will be checked by `edebug-list-form-args' and treated as
-macros without a spec."
- (let ((name (edebug-top-element-required cursor "Expected name")))
- (when (not (symbolp name))
- (edebug-no-match cursor "Bad name:" name))
- ;; Change edebug-def-name to avoid conflicts with
- ;; names at global scope.
- (setq edebug-def-name (gensym "edebug-anon"))
- (edebug-move-cursor cursor)
- (push name edebug--current-cl-macrolet-defs)
- (list name)))
-
-(defun edebug-match-cl-macrolet-body (cursor)
- "Match the body of a `cl-macrolet' expression at CURSOR.
-Put the definitions collected in `edebug--current-cl-macrolet-defs'
-into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
- (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
- edebug--cl-macrolet-defs)))
- (edebug-match-body cursor)))
-
(defun edebug-match-arg (cursor)
;; set the def-args bound in edebug-defining-form
(let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
))
(put name 'edebug-form-spec spec))
-(defun edebug--get-declare-spec (head)
- (get head 'edebug-declaration-spec))
+(defun edebug--match-declare-arg (head pf)
+ (funcall pf (get (car head) 'edebug-declaration-spec)))
(def-edebug-elem-spec 'def-declarations
- '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp))
+ '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp))
(def-edebug-elem-spec 'lambda-list
'(([&rest arg]
(defvar pcase--dontwarn-upats '(pcase--dontcare))
(def-edebug-elem-spec 'pcase-PAT
- '(&or (&lookup symbolp pcase--get-edebug-spec) sexp))
+ '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp))
(def-edebug-elem-spec 'pcase-FUN
'(&or lambda-expr
;; Only called from edebug.
(declare-function edebug-get-spec "edebug" (symbol))
-(defun pcase--get-edebug-spec (head)
+(defun pcase--edebug-match-pat-args (head pf)
+ ;; (cl-assert (null (cdr head)))
+ (setq head (car head))
(or (alist-get head '((quote sexp)
(or &rest pcase-PAT)
(and &rest pcase-PAT)
(pred &or ("not" pcase-FUN) pcase-FUN)
(app pcase-FUN pcase-PAT)))
(let ((me (pcase--get-macroexpander head)))
- (and me (symbolp me) (edebug-get-spec me)))))
+ (funcall pf (and me (symbolp me) (edebug-get-spec me))))))
(defun pcase--get-macroexpander (s)
"Return the macroexpander for pcase pattern head S, or nil"
\f
;;;; Basic Lisp macros.
-(defalias 'not 'null)
-(defalias 'sxhash 'sxhash-equal)
+(defalias 'not #'null)
+(defalias 'sxhash #'sxhash-equal)
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
(defun def-edebug-elem-spec (name spec)
"Define a new Edebug spec element NAME as shorthand for SPEC.
-The SPEC has to be a list or a symbol.
-The elements of the list describe the argument types; see
-Info node `(elisp)Specification List' for details.
-If SPEC is a symbol it should name another pre-existing Edebug element."
+The SPEC has to be a list."
(declare (indent 1))
(when (string-match "\\`[&:]" (symbol-name name))
;; & and : have special meaning in spec element names.
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
- (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key)
(setq found t value (if (consp elt) (cdr elt) default))))
(setq tail (cdr tail)))
value))
"Make MAP override all normally self-inserting keys to be undefined.
Normally, as an exception, digits and minus-sign are set to make prefix args,
but optional second arg NODIGITS non-nil treats them like other chars."
- (define-key map [remap self-insert-command] 'undefined)
+ (define-key map [remap self-insert-command] #'undefined)
(or nodigits
(let (loop)
- (define-key map "-" 'negative-argument)
+ (define-key map "-" #'negative-argument)
;; Make plain numbers do numeric args.
(setq loop ?0)
(while (<= loop ?9)
- (define-key map (char-to-string loop) 'digit-argument)
+ (define-key map (char-to-string loop) #'digit-argument)
(setq loop (1+ loop))))))
(defun make-composed-keymap (maps &optional parent)
(setq key
(if (<= (length key) 1) (aref key 0)
(setq keymap (lookup-key keymap
- (apply 'vector
- (butlast (mapcar 'identity key)))))
+ (apply #'vector
+ (butlast (mapcar #'identity key)))))
(aref key (1- (length key)))))
(let ((tail keymap) done inserted)
(while (and (not done) tail)
(push (cons key item) bindings)))
map)))
;; Create the new map.
- (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
+ (setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt))
(dolist (binding ranges)
;; Treat char-ranges specially. FIXME: need to merge as well.
(define-key map (vector (car binding)) (cdr binding)))
\f
;;;; Alternate names for functions - these are not being phased out.
-(defalias 'send-string 'process-send-string)
-(defalias 'send-region 'process-send-region)
-(defalias 'string= 'string-equal)
-(defalias 'string< 'string-lessp)
-(defalias 'string> 'string-greaterp)
-(defalias 'move-marker 'set-marker)
-(defalias 'rplaca 'setcar)
-(defalias 'rplacd 'setcdr)
-(defalias 'beep 'ding) ;preserve lingual purity
-(defalias 'indent-to-column 'indent-to)
-(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'send-string #'process-send-string)
+(defalias 'send-region #'process-send-region)
+(defalias 'string= #'string-equal)
+(defalias 'string< #'string-lessp)
+(defalias 'string> #'string-greaterp)
+(defalias 'move-marker #'set-marker)
+(defalias 'rplaca #'setcar)
+(defalias 'rplacd #'setcdr)
+(defalias 'beep #'ding) ;preserve lingual purity
+(defalias 'indent-to-column #'indent-to)
+(defalias 'backward-delete-char #'delete-backward-char)
(defalias 'search-forward-regexp (symbol-function 're-search-forward))
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
-(defalias 'int-to-string 'number-to-string)
-(defalias 'store-match-data 'set-match-data)
-(defalias 'chmod 'set-file-modes)
-(defalias 'mkdir 'make-directory)
+(defalias 'int-to-string #'number-to-string)
+(defalias 'store-match-data #'set-match-data)
+(defalias 'chmod #'set-file-modes)
+(defalias 'mkdir #'make-directory)
;; These are the XEmacs names:
-(defalias 'point-at-eol 'line-end-position)
-(defalias 'point-at-bol 'line-beginning-position)
+(defalias 'point-at-eol #'line-end-position)
+(defalias 'point-at-bol #'line-beginning-position)
(define-obsolete-function-alias 'user-original-login-name
- 'user-login-name "28.1")
+ #'user-login-name "28.1")
\f
;;;; Hook manipulation functions.
(if local "Buffer-local" "Global"))
fn-alist
nil t)
- fn-alist nil nil 'string=)))
+ fn-alist nil nil #'string=)))
(list hook function local)))
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
(if (cond
((null compare-fn)
(member element (symbol-value list-var)))
- ((eq compare-fn 'eq)
+ ((eq compare-fn #'eq)
(memq element (symbol-value list-var)))
- ((eq compare-fn 'eql)
+ ((eq compare-fn #'eql)
(memql element (symbol-value list-var)))
(t
(let ((lst (symbol-value list-var)))
NIL, an error is signalled if the program returns with a non-zero
exit status."
(with-temp-buffer
- (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (let ((status (apply #'call-process program nil (current-buffer) nil args)))
(if status-handler
(funcall status-handler status)
(unless (eq status 0)
(format "Buffer %S has a running process; kill it? "
(buffer-name (current-buffer)))))))
-(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function)
+(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function)
;; process plist management
(use-local-map read-passwd-map)
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
- (add-hook 'post-command-hook 'read-password--hide-password nil t))
+ (add-hook 'post-command-hook #'read-password--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
(read-hide-char (or read-hide-char ?*)))
;; Not sure why but it seems that there might be cases where the
;; minibuffer is not always properly reset later on, so undo
;; whatever we've done here (bug#11392).
- (remove-hook 'after-change-functions 'read-password--hide-password
- 'local)
+ (remove-hook 'after-change-functions
+ #'read-password--hide-password 'local)
(kill-local-variable 'post-self-insert-hook)
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
prompt nil nil nil (or hist 'read-number-history)
(when default
(if (consp default)
- (mapcar 'number-to-string (delq nil default))
+ (mapcar #'number-to-string (delq nil default))
(number-to-string default))))))
(condition-case nil
(setq n (cond
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map [remap self-insert-command] 'read-char-from-minibuffer-insert-char)
+ (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
- (define-key map [remap recenter-top-bottom] 'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down-command] 'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
map)
"Keymap for the `read-char-from-minibuffer' function.")
(help-form-show)))))
(dolist (char chars)
(define-key map (vector char)
- 'read-char-from-minibuffer-insert-char))
+ #'read-char-from-minibuffer-insert-char))
(define-key map [remap self-insert-command]
- 'read-char-from-minibuffer-insert-other)
+ #'read-char-from-minibuffer-insert-other)
(puthash (list help-form (cons help-char chars))
map read-char-from-minibuffer-map-hash)
map))
(set-keymap-parent map minibuffer-local-map)
(dolist (symbol '(act act-and-show act-and-exit automatic))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y))
- (define-key map [remap skip] 'y-or-n-p-insert-n)
+ (define-key map [remap skip] #'y-or-n-p-insert-n)
(dolist (symbol '(backup undo undo-all edit edit-replacement
delete-and-edit ignore self-insert-command))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other))
- (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down] 'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter] #'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down] #'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
- (define-key map [escape] 'abort-recursive-edit)
+ (define-key map [escape] #'abort-recursive-edit)
(dolist (symbol '(quit exit exit-prefix))
- (define-key map (vector 'remap symbol) 'abort-recursive-edit))
+ (define-key map (vector 'remap symbol) #'abort-recursive-edit))
;; FIXME: try catch-all instead of explicit bindings:
- ;; (define-key map [remap t] 'y-or-n-p-insert-other)
+ ;; (define-key map [remap t] #'y-or-n-p-insert-other)
map)
"Keymap that defines additional bindings for `y-or-n-p' answers.")
;; For compatibility.
(define-obsolete-function-alias 'redraw-modeline
- 'force-mode-line-update "24.3")
+ #'force-mode-line-update "24.3")
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
symbol at point exactly."
(let ((tag (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default))))
+ #'find-tag-default))))
(if tag (regexp-quote tag))))
(defun find-tag-default-as-symbol-regexp ()
(if (and tag-regexp
(eq (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default)
- 'find-tag-default))
+ #'find-tag-default)
+ #'find-tag-default))
(format "\\_<%s\\_>" tag-regexp)
tag-regexp)))
(call-process shell-file-name
infile buffer display
shell-command-switch
- (mapconcat 'identity (cons command args) " ")))
+ (mapconcat #'identity (cons command args) " ")))
(defun process-file-shell-command (command &optional infile buffer display
&rest args)
(with-connection-local-variables
(process-file
shell-file-name infile buffer display shell-command-switch
- (mapconcat 'identity (cons command args) " "))))
+ (mapconcat #'identity (cons command args) " "))))
(defun call-shell-region (start end command &optional delete buffer)
"Send text from START to END as input to an inferior shell running COMMAND.
""
;; Note: regexp-opt can't be used here, since we need to call
;; this before Emacs has been fully started. 2006-05-21
- (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
- "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
+ (concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|") "\\)?"))
+ "\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|")
"\\)?\\'"))
(defun load-history-filename-element (file-regexp)
load-elt (and loads (car loads)))))
load-elt))
-(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
"Arrange that if FILE is loaded, FORM will be run immediately afterwards.
If FILE is already loaded, evaluate FORM right now.
This function makes or adds to an entry on `after-load-alist'.
See also `with-eval-after-load'."
- (declare (compiler-macro
+ (declare (indent 1)
+ (compiler-macro
(lambda (whole)
(if (eq 'quote (car-safe form))
;; Quote with lambda so the compiler can look inside.
"Display delayed warnings from `delayed-warnings-list'.
Used from `delayed-warnings-hook' (which see)."
(dolist (warning (nreverse delayed-warnings-list))
- (apply 'display-warning warning))
+ (apply #'display-warning warning))
(setq delayed-warnings-list nil))
(defun collapse-delayed-warnings ()
`abortfunc', and `hookvar'."
(put symbol 'composefunc composefunc)
(put symbol 'sendfunc sendfunc)
- (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'abortfunc (or abortfunc #'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
\f
(set symbol tail)))))
(define-obsolete-function-alias
- 'set-temporary-overlay-map 'set-transient-map "24.4")
+ 'set-temporary-overlay-map #'set-transient-map "24.4")
(defun set-transient-map (map &optional keep-pred on-exit)
"Set MAP as a temporary keymap taking precedence over other keymaps.
;; Technically, `flatten-list' is a misnomer, but we provide it here
;; for discoverability:
-(defalias 'flatten-list 'flatten-tree)
+(defalias 'flatten-list #'flatten-tree)
;; The initial anchoring is for better performance in searching matches.
(defconst regexp-unmatchable "\\`a\\`"
(when (memq name instrumented-names)
(error "Duplicate definition of `%s'" name))
(push name instrumented-names)
- (edebug-new-definition name)))
- ;; Make generated symbols reproducible.
- (gensym-counter 10000))
+ (edebug-new-definition name))))
(eval-buffer)
(should (equal
(reverse instrumented-names)
;; FIXME: We'd rather have names such as
;; `cl-defgeneric/edebug/method/1 ((_ number))', but
;; that requires further changes to Edebug.
- (list (intern "cl-generic-:method@10000 ((_ number))")
- (intern "cl-generic-:method@10001 ((_ string))")
- (intern "cl-generic-:method@10002 :around ((_ number))")
+ (list (intern "cl-defgeneric/edebug/method/1 (number)")
+ (intern "cl-defgeneric/edebug/method/1 (string)")
+ (intern "cl-defgeneric/edebug/method/1 :around (number)")
'cl-defgeneric/edebug/method/1
- (intern "cl-generic-:method@10003 ((_ number))")
+ (intern "cl-defgeneric/edebug/method/2 (number)")
'cl-defgeneric/edebug/method/2))))))
(provide 'cl-generic-tests)
(defun edebug-test-code-format-vector-node (node)
!start!(concat "["
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"]"))
(defun edebug-test-code-format-list-node (node)
!start!(concat "{"
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"}"))
(defun edebug-test-code-format-node (node)
(should
(equal
defined-symbols
- (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
- (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+ (list (intern "edebug-cl-defmethod-qualifier :around (number)")
+ (intern "edebug-cl-defmethod-qualifier (number)")))))))
(ert-deftest edebug-tests--conflicting-internal-names ()
"Check conflicts between form's head symbols and Edebug spec elements."
;; Make generated symbols reproducible.
(gensym-counter 10000))
(eval-buffer)
- (should (equal (reverse instrumented-names)
+ ;; Use `format' so as to throw away differences due to
+ ;; interned/uninterned symbols.
+ (should (equal (format "%s" (reverse instrumented-names))
;; The outer definitions come after the inner
;; ones because their body ends later.
- ;; FIXME: There are twice as many inner
- ;; definitions as expected due to Bug#41988.
- ;; Once that bug is fixed, remove the duplicates.
;; FIXME: We'd rather have names such as
;; `edebug-tests-cl-flet-1@inner@cl-flet@10000',
;; but that requires further changes to Edebug.
- '(inner@cl-flet@10000
- inner@cl-flet@10001
- inner@cl-flet@10002
- inner@cl-flet@10003
- edebug-tests-cl-flet-1
- inner@cl-flet@10004
- inner@cl-flet@10005
- edebug-tests-cl-flet-2))))))
+ (format "%s" '(inner@cl-flet@10000
+ inner@cl-flet@10001
+ edebug-tests-cl-flet-1
+ inner@cl-flet@10002
+ edebug-tests-cl-flet-2)))))))
(ert-deftest edebug-tests-duplicate-symbol-backtrack ()
"Check that Edebug doesn't create duplicate symbols when
projects / emacs.git / commitdiff