Merge branch 'master' into feature/tree-sitter
This commit is contained in:
Yuan Fu
commit
7ebbd4efc3
644 changed files with 28791 additions and 13315 deletions
|
|
@ -209,7 +209,6 @@ frames where the source code location is known.")
|
|||
"v" #'backtrace-toggle-locals
|
||||
"#" #'backtrace-toggle-print-circle
|
||||
":" #'backtrace-toggle-print-gensym
|
||||
"s" #'backtrace-goto-source
|
||||
"RET" #'backtrace-help-follow-symbol
|
||||
"+" #'backtrace-multi-line
|
||||
"-" #'backtrace-single-line
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ number of repetitions actually used."
|
|||
|
||||
(defun benchmark--adaptive (func time)
|
||||
"Measure the run time of FUNC, calling it enough times to last TIME seconds.
|
||||
Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'."
|
||||
Result is (REPETITIONS . DATA) where DATA is as returned by `benchmark-call'."
|
||||
(named-let loop ((repetitions 1)
|
||||
(data (let ((x (list 0))) (setcdr x x) x)))
|
||||
;; (message "Running %d iteration" repetitions)
|
||||
|
|
|
|||
|
|
@ -737,7 +737,7 @@ for speeding up processing.")
|
|||
reverse nreverse sort))
|
||||
(setq form (nth 1 form))
|
||||
t)
|
||||
((memq head '(mapc setq setcar setcdr puthash))
|
||||
((memq head '(mapc setq setcar setcdr puthash set))
|
||||
(setq form (nth 2 form))
|
||||
t)
|
||||
((memq head '(aset put function-put))
|
||||
|
|
@ -793,6 +793,7 @@ for speeding up processing.")
|
|||
sxhash sxhash-equal sxhash-eq sxhash-eql
|
||||
sxhash-equal-including-properties
|
||||
make-marker copy-marker point-marker mark-marker
|
||||
set-marker
|
||||
kbd key-description
|
||||
always))
|
||||
t)
|
||||
|
|
@ -811,7 +812,7 @@ for speeding up processing.")
|
|||
(defun byte-compile-nilconstp (form)
|
||||
"Return non-nil if FORM always evaluates to a nil value."
|
||||
(setq form (byte-opt--bool-value-form form))
|
||||
(or (not form) ; assume (quote nil) always being normalised to nil
|
||||
(or (not form) ; assume (quote nil) always being normalized to nil
|
||||
(and (consp form)
|
||||
(let ((head (car form)))
|
||||
;; FIXME: There are many other expressions that are statically nil.
|
||||
|
|
@ -1183,7 +1184,7 @@ See Info node `(elisp) Integer Basics'."
|
|||
(if (equal new-args (cdr form))
|
||||
;; Input is unchanged: keep original form, and don't represent
|
||||
;; a nil result explicitly because that would lead to infinite
|
||||
;; growth when the optimiser is iterated.
|
||||
;; growth when the optimizer is iterated.
|
||||
(setq nil-result nil)
|
||||
(setq form (cons (car form) new-args)))
|
||||
|
||||
|
|
@ -1531,15 +1532,16 @@ See Info node `(elisp) Integer Basics'."
|
|||
|
||||
(put 'set 'byte-optimizer #'byte-optimize-set)
|
||||
(defun byte-optimize-set (form)
|
||||
(let ((var (car-safe (cdr-safe form))))
|
||||
(cond
|
||||
((and (eq (car-safe var) 'quote) (consp (cdr var)))
|
||||
`(setq ,(cadr var) ,@(cddr form)))
|
||||
((and (eq (car-safe var) 'make-local-variable)
|
||||
(eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
|
||||
(consp (cdr var)))
|
||||
`(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
|
||||
(t form))))
|
||||
(pcase (cdr form)
|
||||
;; Make sure we only turn `set' into `setq' for dynamic variables.
|
||||
(`((quote ,(and var (guard (and (symbolp var)
|
||||
(not (macroexp--const-symbol-p var))
|
||||
(not (assq var byte-optimize--lexvars))))))
|
||||
,newval)
|
||||
`(setq ,var ,newval))
|
||||
(`(,(and ml `(make-local-variable ,(and v `(quote ,_)))) ,newval)
|
||||
`(progn ,ml (,(car form) ,v ,newval)))
|
||||
(_ form)))
|
||||
|
||||
;; enumerating those functions which need not be called if the returned
|
||||
;; value is not used. That is, something like
|
||||
|
|
@ -1999,20 +2001,20 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
|
|||
(setq keep-going t)
|
||||
(setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
|
||||
(setq rest (cdr rest))
|
||||
(cond ((= tmp 1)
|
||||
(cond ((eql tmp 1)
|
||||
(byte-compile-log-lap
|
||||
" %s discard\t-->\t<deleted>" lap0)
|
||||
(setq lap (delq lap0 (delq lap1 lap))))
|
||||
((= tmp 0)
|
||||
((eql tmp 0)
|
||||
(byte-compile-log-lap
|
||||
" %s discard\t-->\t<deleted> discard" lap0)
|
||||
(setq lap (delq lap0 lap)))
|
||||
((= tmp -1)
|
||||
((eql tmp -1)
|
||||
(byte-compile-log-lap
|
||||
" %s discard\t-->\tdiscard discard" lap0)
|
||||
(setcar lap0 'byte-discard)
|
||||
(setcdr lap0 0))
|
||||
((error "Optimizer error: too much on the stack"))))
|
||||
(t (error "Optimizer error: too much on the stack"))))
|
||||
;;
|
||||
;; goto*-X X: --> X:
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -112,44 +112,6 @@ So far, FUNCTION can only be a symbol, not a lambda expression."
|
|||
(function-put 'defmacro 'doc-string-elt 3)
|
||||
(function-put 'defmacro 'lisp-indent-function 2)
|
||||
|
||||
;; `macro-declaration-function' are both obsolete (as marked at the end of this
|
||||
;; file) but used in many .elc files.
|
||||
|
||||
;; We don't use #' here, because it's an obsolete function, and we
|
||||
;; can't use `with-suppressed-warnings' here due to how this file is
|
||||
;; used in the bootstrapping process.
|
||||
(defvar macro-declaration-function 'macro-declaration-function
|
||||
"Function to process declarations in a macro definition.
|
||||
The function will be called with two args MACRO and DECL.
|
||||
MACRO is the name of the macro being defined.
|
||||
DECL is a list `(declare ...)' containing the declarations.
|
||||
The value the function returns is not used.")
|
||||
|
||||
(defalias 'macro-declaration-function
|
||||
#'(lambda (macro decl)
|
||||
"Process a declaration found in a macro definition.
|
||||
This is set as the value of the variable `macro-declaration-function'.
|
||||
MACRO is the name of the macro being defined.
|
||||
DECL is a list `(declare ...)' containing the declarations.
|
||||
The return value of this function is not used."
|
||||
;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
|
||||
(let (d)
|
||||
;; Ignore the first element of `decl' (it's always `declare').
|
||||
(while (setq decl (cdr decl))
|
||||
(setq d (car decl))
|
||||
(if (and (consp d)
|
||||
(listp (cdr d))
|
||||
(null (cdr (cdr d))))
|
||||
(cond ((eq (car d) 'indent)
|
||||
(put macro 'lisp-indent-function (car (cdr d))))
|
||||
((eq (car d) 'debug)
|
||||
(put macro 'edebug-form-spec (car (cdr d))))
|
||||
((eq (car d) 'doc-string)
|
||||
(put macro 'doc-string-elt (car (cdr d))))
|
||||
(t
|
||||
(message "Unknown declaration %s" d)))
|
||||
(message "Invalid declaration %s" d))))))
|
||||
|
||||
;; We define macro-declaration-alist here because it is needed to
|
||||
;; handle declarations in macro definitions and this is the first file
|
||||
;; loaded by loadup.el that uses declarations in macros. We specify
|
||||
|
|
@ -771,9 +733,4 @@ type is. This defaults to \"INFO\"."
|
|||
;; (file-format emacs19))"
|
||||
;; nil)
|
||||
|
||||
(make-obsolete-variable 'macro-declaration-function
|
||||
'macro-declarations-alist "24.3")
|
||||
(make-obsolete 'macro-declaration-function
|
||||
'macro-declarations-alist "24.3")
|
||||
|
||||
;;; byte-run.el ends here
|
||||
|
|
|
|||
|
|
@ -1705,12 +1705,12 @@ URLs."
|
|||
(+ " " (or
|
||||
;; Arguments.
|
||||
(+ (or (syntax symbol)
|
||||
(any word "-/:[]&=().?^\\#'")))
|
||||
(any word "-/:[]&=()<>.,?^\\#*'\"")))
|
||||
;; Argument that is a list.
|
||||
(seq "(" (* (not ")")) ")")))
|
||||
")")))
|
||||
""
|
||||
;; Heuristic: We can't reliably do `subsititute-command-keys'
|
||||
;; Heuristic: We can't reliably do `substitute-command-keys'
|
||||
;; substitutions, since the value of a keymap in general can't be
|
||||
;; known at compile time. So instead, we assume that these
|
||||
;; substitutions are of some length N.
|
||||
|
|
@ -3104,8 +3104,8 @@ lambda-expression."
|
|||
;; Check that the bit after the `interactive' spec is
|
||||
;; just a list of symbols (i.e., modes).
|
||||
(unless (seq-every-p #'symbolp (cdr (cdr int)))
|
||||
(byte-compile-warn-x int "malformed interactive specc: %s"
|
||||
int))
|
||||
(byte-compile-warn-x
|
||||
int "malformed `interactive' specification: %s" int))
|
||||
(setq command-modes (cdr (cdr int)))
|
||||
;; If the interactive spec is a call to `list', don't
|
||||
;; compile it, because `call-interactively' looks at the
|
||||
|
|
|
|||
|
|
@ -137,6 +137,11 @@ is less than this number.")
|
|||
;; Alist associating to each function body the list of its free variables.
|
||||
)
|
||||
|
||||
(defvar cconv--interactive-form-funs
|
||||
;; Table used to hold the functions we create internally for
|
||||
;; interactive forms.
|
||||
(make-hash-table :test #'eq :weakness 'key))
|
||||
|
||||
;;;###autoload
|
||||
(defun cconv-closure-convert (form)
|
||||
"Main entry point for closure conversion.
|
||||
|
|
@ -503,9 +508,23 @@ places where they originally did not directly appear."
|
|||
cond-forms)))
|
||||
|
||||
(`(function (lambda ,args . ,body) . ,_)
|
||||
(let ((docstring (if (eq :documentation (car-safe (car body)))
|
||||
(cconv-convert (cadr (pop body)) env extend))))
|
||||
(cconv--convert-function args body env form docstring)))
|
||||
(let* ((docstring (if (eq :documentation (car-safe (car body)))
|
||||
(cconv-convert (cadr (pop body)) env extend)))
|
||||
(bf (if (stringp (car body)) (cdr body) body))
|
||||
(if (when (eq 'interactive (car-safe (car bf)))
|
||||
(gethash form cconv--interactive-form-funs)))
|
||||
(cif (when if (cconv-convert if env extend)))
|
||||
(_ (pcase cif
|
||||
(`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
|
||||
('nil nil)
|
||||
;; The interactive form needs special treatment, so the form
|
||||
;; inside the `interactive' won't be used any further.
|
||||
(_ (setf (cadr (car bf)) nil))))
|
||||
(cf (cconv--convert-function args body env form docstring)))
|
||||
(if (not cif)
|
||||
;; Normal case, the interactive form needs no special treatment.
|
||||
cf
|
||||
`(cconv--interactive-helper ,cf ,cif))))
|
||||
|
||||
(`(internal-make-closure . ,_)
|
||||
(byte-compile-report-error
|
||||
|
|
@ -589,12 +608,12 @@ places where they originally did not directly appear."
|
|||
(cconv-convert arg env extend))
|
||||
(cons fun args)))))))
|
||||
|
||||
(`(interactive . ,forms)
|
||||
`(,(car form) . ,(mapcar (lambda (form)
|
||||
(cconv-convert form nil nil))
|
||||
forms)))
|
||||
;; The form (if any) is converted beforehand as part of the `lambda' case.
|
||||
(`(interactive . ,_) form)
|
||||
|
||||
(`(declare . ,_) form) ;The args don't contain code.
|
||||
;; `declare' should now be macro-expanded away (and if they're not, we're
|
||||
;; in trouble because they *can* contain code nowadays).
|
||||
;; (`(declare . ,_) form) ;The args don't contain code.
|
||||
|
||||
(`(oclosure--fix-type (ignore . ,vars) ,exp)
|
||||
(dolist (var vars)
|
||||
|
|
@ -739,6 +758,13 @@ This function does not return anything but instead fills the
|
|||
(`(function (lambda ,vrs . ,body-forms))
|
||||
(when (eq :documentation (car-safe (car body-forms)))
|
||||
(cconv-analyze-form (cadr (pop body-forms)) env))
|
||||
(let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms)))
|
||||
(when (eq 'interactive (car-safe (car bf)))
|
||||
(let ((if (cadr (car bf))))
|
||||
(unless (macroexp-const-p if) ;Optimize this common case.
|
||||
(let ((f `#'(lambda () ,if)))
|
||||
(setf (gethash form cconv--interactive-form-funs) f)
|
||||
(cconv-analyze-form f env))))))
|
||||
(cconv--analyze-function vrs body-forms env form))
|
||||
|
||||
(`(setq ,var ,expr)
|
||||
|
|
@ -803,13 +829,8 @@ This function does not return anything but instead fills the
|
|||
(cconv-analyze-form fun env)))
|
||||
(dolist (form args) (cconv-analyze-form form env)))
|
||||
|
||||
(`(interactive . ,forms)
|
||||
;; These appear within the function body but they don't have access
|
||||
;; to the function's arguments.
|
||||
;; We could extend this to allow interactive specs to refer to
|
||||
;; variables in the function's enclosing environment, but it doesn't
|
||||
;; seem worth the trouble.
|
||||
(dolist (form forms) (cconv-analyze-form form nil)))
|
||||
;; The form (if any) is converted beforehand as part of the `lambda' case.
|
||||
(`(interactive . ,_) nil)
|
||||
|
||||
;; `declare' should now be macro-expanded away (and if they're not, we're
|
||||
;; in trouble because they *can* contain code nowadays).
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ with these words enabled."
|
|||
(defvar checkdoc-ispell-lisp-words
|
||||
'("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp")
|
||||
"List of words that are correct when spell-checking Lisp documentation.")
|
||||
;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'checkdoc-list-of-strings-p)
|
||||
;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'list-of-strings-p)
|
||||
|
||||
(defcustom checkdoc-max-keyref-before-warn nil
|
||||
"If non-nil, number of \\\\=[command-to-keystroke] tokens allowed in a doc string.
|
||||
|
|
@ -281,8 +281,6 @@ Currently, all recognized keywords must be on `finder-known-keywords'."
|
|||
:version "25.1"
|
||||
:type 'boolean)
|
||||
|
||||
(define-obsolete-variable-alias 'checkdoc-style-hooks
|
||||
'checkdoc-style-functions "24.3")
|
||||
(defvar checkdoc-style-functions nil
|
||||
"Hook run after the standard style check is completed.
|
||||
All functions must return nil or a string representing the error found.
|
||||
|
|
@ -292,8 +290,6 @@ Each hook is called with two parameters, (DEFUNINFO ENDPOINT).
|
|||
DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the
|
||||
location of end of the documentation string.")
|
||||
|
||||
(define-obsolete-variable-alias 'checkdoc-comment-style-hooks
|
||||
'checkdoc-comment-style-functions "24.3")
|
||||
(defvar checkdoc-comment-style-functions nil
|
||||
"Hook run after the standard comment style check is completed.
|
||||
Must return nil if no errors are found, or a string describing the
|
||||
|
|
@ -324,7 +320,7 @@ These words are ignored when unquoted symbols are searched for.
|
|||
This should be set in an Emacs Lisp file's local variables."
|
||||
:type '(repeat (string :tag "Word"))
|
||||
:version "28.1")
|
||||
;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p)
|
||||
;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'list-of-strings-p)
|
||||
|
||||
(defcustom checkdoc-column-zero-backslash-before-paren t
|
||||
"Non-nil means to warn if there is no \"\\\" before \"(\" in column zero.
|
||||
|
|
@ -364,9 +360,9 @@ large number of libraries means it is impractical to fix all
|
|||
of these warnings masse. In almost any other case, setting
|
||||
this to anything but t is likely to be counter-productive.")
|
||||
|
||||
;;;###autoload
|
||||
(defun checkdoc-list-of-strings-p (obj)
|
||||
"Return t when OBJ is a list of strings."
|
||||
(declare (obsolete list-of-strings-p "29.1"))
|
||||
;; this is a function so it might be shared by checkdoc-proper-noun-list
|
||||
;; and/or checkdoc-ispell-lisp-words in the future
|
||||
(and (listp obj)
|
||||
|
|
|
|||
|
|
@ -772,7 +772,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(help-insert-xref-button
|
||||
(help-fns-short-filename location)
|
||||
'cl-type-definition type location 'define-type)
|
||||
(insert (substitute-command-keys "'")))
|
||||
(insert (substitute-quotes "'")))
|
||||
(insert ".\n")
|
||||
|
||||
;; Parents.
|
||||
|
|
@ -782,7 +782,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(insert " Inherits from ")
|
||||
(while (setq cur (pop pl))
|
||||
(setq cur (cl--class-name cur))
|
||||
(insert (substitute-command-keys "`"))
|
||||
(insert (substitute-quotes "`"))
|
||||
(help-insert-xref-button (symbol-name cur)
|
||||
'cl-help-type cur)
|
||||
(insert (substitute-command-keys (if pl "', " "'"))))
|
||||
|
|
@ -796,7 +796,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(when ch
|
||||
(insert " Children ")
|
||||
(while (setq cur (pop ch))
|
||||
(insert (substitute-command-keys "`"))
|
||||
(insert (substitute-quotes "`"))
|
||||
(help-insert-xref-button (symbol-name cur)
|
||||
'cl-help-type cur)
|
||||
(insert (substitute-command-keys (if ch "', " "'"))))
|
||||
|
|
@ -815,10 +815,10 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(when generics
|
||||
(insert (propertize "Specialized Methods:\n\n" 'face 'bold))
|
||||
(dolist (generic generics)
|
||||
(insert (substitute-command-keys "`"))
|
||||
(insert (substitute-quotes "`"))
|
||||
(help-insert-xref-button (symbol-name generic)
|
||||
'help-function generic)
|
||||
(insert (substitute-command-keys "'"))
|
||||
(insert (substitute-quotes "'"))
|
||||
(pcase-dolist (`(,qualifiers ,args ,doc)
|
||||
(cl--generic-method-documentation generic type))
|
||||
(insert (format " %s%S\n" qualifiers args)
|
||||
|
|
|
|||
|
|
@ -94,11 +94,6 @@
|
|||
;; This second one is closely related to what we do here (and that's
|
||||
;; the name "generalizer" comes from).
|
||||
|
||||
;; The autoloads.el mechanism which adds package--builtin-versions
|
||||
;; maintenance to loaddefs.el doesn't work for preloaded packages (such
|
||||
;; as this one), so we have to do it by hand!
|
||||
(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
|
||||
|
||||
;; Note: For generic functions that dispatch on several arguments (i.e. those
|
||||
;; which use the multiple-dispatch feature), we always use the same "tagcodes"
|
||||
;; and the same set of arguments on which to dispatch. This works, but is
|
||||
|
|
@ -425,11 +420,13 @@ the specializer used will be the one returned by BODY."
|
|||
;; only called with explicit arguments.
|
||||
(uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))
|
||||
(λ-lift (mapcar #'car uses-cnm)))
|
||||
(if (not uses-cnm)
|
||||
(cons nil
|
||||
`#'(lambda (,@args)
|
||||
,@(car parsed-body)
|
||||
,nbody))
|
||||
(cond
|
||||
((not uses-cnm)
|
||||
(cons nil
|
||||
`#'(lambda (,@args)
|
||||
,@(car parsed-body)
|
||||
,nbody)))
|
||||
(lexical-binding
|
||||
(cons 'curried
|
||||
`#'(lambda (,nm) ;Called when constructing the effective method.
|
||||
(let ((,nmp (if (cl--generic-isnot-nnm-p ,nm)
|
||||
|
|
@ -465,7 +462,20 @@ the specializer used will be the one returned by BODY."
|
|||
;; A destructuring-bind would do the trick
|
||||
;; as well when/if it's more efficient.
|
||||
(apply (lambda (,@λ-lift ,@args) ,nbody)
|
||||
,@λ-lift ,arglist)))))))))
|
||||
,@λ-lift ,arglist)))))))
|
||||
(t
|
||||
(cons t
|
||||
`#'(lambda (,cnm ,@args)
|
||||
,@(car parsed-body)
|
||||
,(macroexp-warn-and-return
|
||||
"cl-defmethod used without lexical-binding"
|
||||
(if (not (assq nmp uses-cnm))
|
||||
nbody
|
||||
`(let ((,nmp (lambda ()
|
||||
(cl--generic-isnot-nnm-p ,cnm))))
|
||||
,nbody))
|
||||
'lexical t)))))
|
||||
))
|
||||
(f (error "Unexpected macroexpansion result: %S" f))))))
|
||||
|
||||
(put 'cl-defmethod 'function-documentation
|
||||
|
|
|
|||
|
|
@ -89,12 +89,6 @@
|
|||
(defvar cl--optimize-speed 1)
|
||||
(defvar cl--optimize-safety 1)
|
||||
|
||||
;;;###autoload
|
||||
(define-obsolete-variable-alias
|
||||
;; This alias is needed for compatibility with .elc files that use defstruct
|
||||
;; and were compiled with Emacs<24.3.
|
||||
'custom-print-functions 'cl-custom-print-functions "24.3")
|
||||
|
||||
;;;###autoload
|
||||
(defvar cl-custom-print-functions nil
|
||||
"This is a list of functions that format user objects for printing.
|
||||
|
|
|
|||
|
|
@ -775,14 +775,34 @@ compared by `eql'.
|
|||
\(fn EXPR (KEYLIST BODY...)...)"
|
||||
(declare (indent 1) (debug (form &rest (sexp body))))
|
||||
(macroexp-let2 macroexp-copyable-p temp expr
|
||||
(let* ((head-list nil))
|
||||
(let* ((head-list nil)
|
||||
(has-otherwise nil))
|
||||
`(cond
|
||||
,@(mapcar
|
||||
(lambda (c)
|
||||
(cons (cond ((memq (car c) '(t otherwise)) t)
|
||||
(cons (cond (has-otherwise
|
||||
(error "Misplaced t or `otherwise' clause"))
|
||||
((memq (car c) '(t otherwise))
|
||||
(setq has-otherwise t)
|
||||
t)
|
||||
((eq (car c) 'cl--ecase-error-flag)
|
||||
`(error "cl-ecase failed: %s, %s"
|
||||
,temp ',(reverse head-list)))
|
||||
((null (car c))
|
||||
(macroexp-warn-and-return
|
||||
"Case nil will never match"
|
||||
nil 'suspicious))
|
||||
((and (consp (car c)) (cdar c) (not (cddar c))
|
||||
(memq (caar c) '(quote function)))
|
||||
(macroexp-warn-and-return
|
||||
(format-message
|
||||
(concat "Case %s will match `%s'. If "
|
||||
"that's intended, write %s "
|
||||
"instead. Otherwise, don't "
|
||||
"quote `%s'.")
|
||||
(car c) (caar c) (list (cadar c) (caar c))
|
||||
(cadar c))
|
||||
`(cl-member ,temp ',(car c)) 'suspicious))
|
||||
((listp (car c))
|
||||
(setq head-list (append (car c) head-list))
|
||||
`(cl-member ,temp ',(car c)))
|
||||
|
|
@ -2261,139 +2281,131 @@ This is like `cl-flet', but for macros instead of functions.
|
|||
(eval `(function (lambda ,@res)) t))
|
||||
macroexpand-all-environment))))))
|
||||
|
||||
(defun cl--sm-macroexpand (orig-fun exp &optional env)
|
||||
(defun cl--sm-macroexpand (exp &optional env)
|
||||
"Special macro expander used inside `cl-symbol-macrolet'."
|
||||
;; FIXME: Arguably, this should be the official definition of `macroexpand'.
|
||||
(while (not (eq exp (setq exp (macroexpand-1 exp env)))))
|
||||
exp)
|
||||
|
||||
(defun cl--sm-macroexpand-1 (orig-fun exp &optional env)
|
||||
"Special macro expander advice used inside `cl-symbol-macrolet'.
|
||||
This function extends `macroexpand' during macro expansion
|
||||
This function extends `macroexpand-1' during macro expansion
|
||||
of `cl-symbol-macrolet' to additionally expand symbol macros."
|
||||
(let ((macroexpand-all-environment env)
|
||||
(let ((exp (funcall orig-fun exp env))
|
||||
(venv (alist-get :cl-symbol-macros env)))
|
||||
(while
|
||||
(progn
|
||||
(setq exp (funcall orig-fun exp env))
|
||||
(pcase exp
|
||||
((pred symbolp)
|
||||
;; Perform symbol-macro expansion.
|
||||
(let ((symval (assq exp venv)))
|
||||
(when symval
|
||||
(setq exp (cadr symval)))))
|
||||
(`(setq . ,args)
|
||||
;; Convert setq to setf if required by symbol-macro expansion.
|
||||
(let ((convert nil)
|
||||
(rargs nil))
|
||||
(while args
|
||||
(let ((place (pop args)))
|
||||
;; Here, we know `place' should be a symbol.
|
||||
(while
|
||||
(let ((symval (assq place venv)))
|
||||
(when symval
|
||||
(setq place (cadr symval))
|
||||
(if (symbolp place)
|
||||
t ;Repeat.
|
||||
(setq convert t)
|
||||
nil))))
|
||||
(push place rargs)
|
||||
(push (pop args) rargs)))
|
||||
(setq exp (cons (if convert 'setf 'setq)
|
||||
(nreverse rargs)))
|
||||
convert))
|
||||
;; CL's symbol-macrolet used to treat re-bindings as candidates for
|
||||
;; expansion (turning the let into a letf if needed), contrary to
|
||||
;; Common-Lisp where such re-bindings hide the symbol-macro.
|
||||
;; Not sure if there actually is code out there which depends
|
||||
;; on this behavior (haven't found any yet).
|
||||
;; Such code should explicitly use `cl-letf' instead, I think.
|
||||
;;
|
||||
;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare))
|
||||
;; (let ((letf nil) (found nil) (nbs ()))
|
||||
;; (dolist (binding bindings)
|
||||
;; (let* ((var (if (symbolp binding) binding (car binding)))
|
||||
;; (sm (assq var venv)))
|
||||
;; (push (if (not (cdr sm))
|
||||
;; binding
|
||||
;; (let ((nexp (cadr sm)))
|
||||
;; (setq found t)
|
||||
;; (unless (symbolp nexp) (setq letf t))
|
||||
;; (cons nexp (cdr-safe binding))))
|
||||
;; nbs)))
|
||||
;; (when found
|
||||
;; (setq exp `(,(if letf
|
||||
;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
|
||||
;; (car exp))
|
||||
;; ,(nreverse nbs)
|
||||
;; ,@body)))))
|
||||
;;
|
||||
;; We implement the Common-Lisp behavior, instead (see bug#26073):
|
||||
;; The behavior of CL made sense in a dynamically scoped
|
||||
;; language, but nowadays, lexical scoping semantics is more often
|
||||
;; expected.
|
||||
(`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare))
|
||||
(let ((nbs ()) (found nil))
|
||||
(dolist (binding bindings)
|
||||
(let* ((var (if (symbolp binding) binding (car binding)))
|
||||
(val (and found (consp binding) (eq 'let* (car exp))
|
||||
(list (macroexpand-all (cadr binding)
|
||||
env)))))
|
||||
(push (if (assq var venv)
|
||||
;; This binding should hide "its" surrounding
|
||||
;; symbol-macro, but given the way macroexpand-all
|
||||
;; works (i.e. the `env' we receive as input will
|
||||
;; be (re)applied to the code we return), we can't
|
||||
;; prevent application of `env' to the
|
||||
;; sub-expressions, so we need to α-rename this
|
||||
;; variable instead.
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(setq found t)
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
(cons nvar (or val (cdr-safe binding))))
|
||||
(if val (cons var val) binding))
|
||||
nbs)))
|
||||
(when found
|
||||
(setq exp `(,(car exp)
|
||||
,(nreverse nbs)
|
||||
,@(macroexp-unprogn
|
||||
(macroexpand-all (macroexp-progn body)
|
||||
env)))))
|
||||
nil))
|
||||
;; Do the same as for `let' but for variables introduced
|
||||
;; via other means, such as `lambda' and `condition-case'.
|
||||
(`(function (lambda ,args . ,body))
|
||||
(let ((nargs ()) (found nil))
|
||||
(dolist (var args)
|
||||
(push (cond
|
||||
((memq var '(&optional &rest)) var)
|
||||
((assq var venv)
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(setq found t)
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
nvar))
|
||||
(t var))
|
||||
nargs))
|
||||
(when found
|
||||
(setq exp `(function
|
||||
(lambda ,(nreverse nargs)
|
||||
. ,(mapcar (lambda (exp)
|
||||
(macroexpand-all exp env))
|
||||
body)))))
|
||||
nil))
|
||||
((and `(condition-case ,var ,exp . ,clauses)
|
||||
(guard (assq var venv)))
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
(setq exp
|
||||
`(condition-case ,nvar ,(macroexpand-all exp env)
|
||||
. ,(mapcar
|
||||
(lambda (clause)
|
||||
`(,(car clause)
|
||||
. ,(mapcar (lambda (exp)
|
||||
(macroexpand-all exp env))
|
||||
(cdr clause))))
|
||||
clauses)))
|
||||
nil))
|
||||
)))
|
||||
exp))
|
||||
(pcase exp
|
||||
((pred symbolp)
|
||||
;; Try symbol-macro expansion.
|
||||
(let ((symval (assq exp venv)))
|
||||
(if symval (cadr symval) exp)))
|
||||
(`(setq . ,args)
|
||||
;; Convert setq to setf if required by symbol-macro expansion.
|
||||
(let ((convert nil))
|
||||
(while args
|
||||
(let* ((place (pop args))
|
||||
;; Here, we know `place' should be a symbol.
|
||||
(symval (assq place venv)))
|
||||
(pop args)
|
||||
(when symval
|
||||
(setq convert t))))
|
||||
(if convert
|
||||
(cons 'setf (cdr exp))
|
||||
exp)))
|
||||
;; CL's symbol-macrolet used to treat re-bindings as candidates for
|
||||
;; expansion (turning the let into a letf if needed), contrary to
|
||||
;; Common-Lisp where such re-bindings hide the symbol-macro.
|
||||
;; Not sure if there actually is code out there which depends
|
||||
;; on this behavior (haven't found any yet).
|
||||
;; Such code should explicitly use `cl-letf' instead, I think.
|
||||
;;
|
||||
;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare))
|
||||
;; (let ((letf nil) (found nil) (nbs ()))
|
||||
;; (dolist (binding bindings)
|
||||
;; (let* ((var (if (symbolp binding) binding (car binding)))
|
||||
;; (sm (assq var venv)))
|
||||
;; (push (if (not (cdr sm))
|
||||
;; binding
|
||||
;; (let ((nexp (cadr sm)))
|
||||
;; (setq found t)
|
||||
;; (unless (symbolp nexp) (setq letf t))
|
||||
;; (cons nexp (cdr-safe binding))))
|
||||
;; nbs)))
|
||||
;; (when found
|
||||
;; (setq exp `(,(if letf
|
||||
;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
|
||||
;; (car exp))
|
||||
;; ,(nreverse nbs)
|
||||
;; ,@body)))))
|
||||
;;
|
||||
;; We implement the Common-Lisp behavior, instead (see bug#26073):
|
||||
;; The behavior of CL made sense in a dynamically scoped
|
||||
;; language, but nowadays, lexical scoping semantics is more often
|
||||
;; expected.
|
||||
(`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare))
|
||||
(let ((nbs ()) (found nil))
|
||||
(dolist (binding bindings)
|
||||
(let* ((var (if (symbolp binding) binding (car binding)))
|
||||
(val (and found (consp binding) (eq 'let* (car exp))
|
||||
(list (macroexpand-all (cadr binding)
|
||||
env)))))
|
||||
(push (if (assq var venv)
|
||||
;; This binding should hide "its" surrounding
|
||||
;; symbol-macro, but given the way macroexpand-all
|
||||
;; works (i.e. the `env' we receive as input will
|
||||
;; be (re)applied to the code we return), we can't
|
||||
;; prevent application of `env' to the
|
||||
;; sub-expressions, so we need to α-rename this
|
||||
;; variable instead.
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(setq found t)
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
(cons nvar (or val (cdr-safe binding))))
|
||||
(if val (cons var val) binding))
|
||||
nbs)))
|
||||
(if found
|
||||
`(,(car exp)
|
||||
,(nreverse nbs)
|
||||
,@(macroexp-unprogn
|
||||
(macroexpand-all (macroexp-progn body)
|
||||
env)))
|
||||
exp)))
|
||||
;; Do the same as for `let' but for variables introduced
|
||||
;; via other means, such as `lambda' and `condition-case'.
|
||||
(`(function (lambda ,args . ,body))
|
||||
(let ((nargs ()) (found nil))
|
||||
(dolist (var args)
|
||||
(push (cond
|
||||
((memq var '(&optional &rest)) var)
|
||||
((assq var venv)
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(setq found t)
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
nvar))
|
||||
(t var))
|
||||
nargs))
|
||||
(if found
|
||||
`(function
|
||||
(lambda ,(nreverse nargs)
|
||||
. ,(mapcar (lambda (exp)
|
||||
(macroexpand-all exp env))
|
||||
body)))
|
||||
exp)))
|
||||
((and `(condition-case ,var ,exp . ,clauses)
|
||||
(guard (assq var venv)))
|
||||
(let ((nvar (make-symbol (symbol-name var))))
|
||||
(push (list var nvar) venv)
|
||||
(push (cons :cl-symbol-macros venv) env)
|
||||
`(condition-case ,nvar ,(macroexpand-all exp env)
|
||||
. ,(mapcar
|
||||
(lambda (clause)
|
||||
`(,(car clause)
|
||||
. ,(mapcar (lambda (exp)
|
||||
(macroexpand-all exp env))
|
||||
(cdr clause))))
|
||||
clauses))))
|
||||
(_ exp))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-symbol-macrolet (bindings &rest body)
|
||||
|
|
@ -2412,7 +2424,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
|
|||
(unwind-protect
|
||||
(progn
|
||||
(unless advised
|
||||
(advice-add 'macroexpand :around #'cl--sm-macroexpand))
|
||||
(advice-add 'macroexpand :override #'cl--sm-macroexpand)
|
||||
(advice-add 'macroexpand-1 :around #'cl--sm-macroexpand-1))
|
||||
(let* ((venv (cdr (assq :cl-symbol-macros
|
||||
macroexpand-all-environment)))
|
||||
(expansion
|
||||
|
|
@ -2428,7 +2441,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
|
|||
expansion nil nil rev-malformed-bindings))
|
||||
expansion)))
|
||||
(unless advised
|
||||
(advice-remove 'macroexpand #'cl--sm-macroexpand)))))
|
||||
(advice-remove 'macroexpand #'cl--sm-macroexpand)
|
||||
(advice-remove 'macroexpand-1 #'cl--sm-macroexpand-1)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-with-gensyms (names &rest body)
|
||||
|
|
@ -2762,11 +2776,17 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
|
|||
(funcall setter vold)))
|
||||
binds))))
|
||||
(let* ((binding (car bindings))
|
||||
(place (macroexpand (car binding) macroexpand-all-environment)))
|
||||
(place (car binding)))
|
||||
(gv-letplace (getter setter) place
|
||||
(macroexp-let2 nil vnew (cadr binding)
|
||||
(if (symbolp place)
|
||||
(if (and (symbolp place)
|
||||
;; `place' could be some symbol-macro.
|
||||
(eq place getter))
|
||||
;; Special-case for simple variables.
|
||||
;; FIXME: We currently only use this special case when `place'
|
||||
;; is a simple var. Should we also use it when the
|
||||
;; macroexpansion of `place' is a simple var (i.e. when
|
||||
;; getter+setter is the same as that of a simple var)?
|
||||
(cl--letf (cdr bindings)
|
||||
(cons `(,getter ,(if (cdr binding) vnew getter))
|
||||
simplebinds)
|
||||
|
|
@ -3105,7 +3125,7 @@ To see the documentation for a defined struct type, use
|
|||
`(and ,pred-form t)))
|
||||
forms)
|
||||
(push `(eval-and-compile
|
||||
(put ',name 'cl-deftype-satisfies ',predicate))
|
||||
(define-symbol-prop ',name 'cl-deftype-satisfies ',predicate))
|
||||
forms))
|
||||
(let ((pos 0) (descp descs))
|
||||
(while descp
|
||||
|
|
@ -3570,7 +3590,7 @@ and then returning foo."
|
|||
(cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
|
||||
(cons '_cl-whole-arg args))
|
||||
,@body)
|
||||
(put ',func 'compiler-macro #',fname))))
|
||||
(define-symbol-prop ',func 'compiler-macro #',fname))))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-compiler-macroexpand (form)
|
||||
|
|
@ -3679,8 +3699,8 @@ macro that returns its `&whole' argument."
|
|||
The type name can then be used in `cl-typecase', `cl-check-type', etc."
|
||||
(declare (debug cl-defmacro) (doc-string 3) (indent 2))
|
||||
`(cl-eval-when (compile load eval)
|
||||
(put ',name 'cl-deftype-handler
|
||||
(cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
|
||||
(define-symbol-prop ',name 'cl-deftype-handler
|
||||
(cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
|
||||
|
||||
(cl-deftype extended-char () '(and character (not base-char)))
|
||||
;; Define fixnum so `cl-typep' recognize it and the type check emitted
|
||||
|
|
|
|||
|
|
@ -178,14 +178,15 @@ and above."
|
|||
:type '(repeat string)
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-driver-options nil
|
||||
(defcustom native-comp-driver-options (when (eq system-type 'darwin)
|
||||
'("-Wl,-w"))
|
||||
"Options passed verbatim to the native compiler's back-end driver.
|
||||
Note that not all options are meaningful; typically only the options
|
||||
affecting the assembler and linker are likely to be useful.
|
||||
|
||||
Passing these options is only available in libgccjit version 9
|
||||
and above."
|
||||
:type '(repeat string) ; FIXME is this right?
|
||||
:type '(repeat string)
|
||||
:version "28.1")
|
||||
|
||||
(defcustom comp-libgccjit-reproducer nil
|
||||
|
|
@ -462,7 +463,7 @@ Useful to hook into pass checkers.")
|
|||
(marker-buffer (function (marker) (or buffer null)))
|
||||
(markerp (function (t) boolean))
|
||||
(max (function ((or number marker) &rest (or number marker)) number))
|
||||
(max-char (function () fixnum))
|
||||
(max-char (function (&optional t) fixnum))
|
||||
(member (function (t list) list))
|
||||
(memory-limit (function () integer))
|
||||
(memq (function (t list) list))
|
||||
|
|
@ -3800,22 +3801,25 @@ Return the trampoline if found or nil otherwise."
|
|||
(lexical-binding t))
|
||||
(comp--native-compile
|
||||
form nil
|
||||
(cl-loop
|
||||
for dir in (if native-compile-target-directory
|
||||
(list (expand-file-name comp-native-version-dir
|
||||
native-compile-target-directory))
|
||||
(comp-eln-load-path-eff))
|
||||
for f = (expand-file-name
|
||||
(comp-trampoline-filename subr-name)
|
||||
dir)
|
||||
unless (file-exists-p dir)
|
||||
do (ignore-errors
|
||||
(make-directory dir t)
|
||||
(cl-return f))
|
||||
when (file-writable-p f)
|
||||
do (cl-return f)
|
||||
finally (error "Cannot find suitable directory for output in \
|
||||
`native-comp-eln-load-path'")))))
|
||||
;; If we've disabled nativecomp, don't write the trampolines to
|
||||
;; the eln cache (but create them).
|
||||
(and (not inhibit-automatic-native-compilation)
|
||||
(cl-loop
|
||||
for dir in (if native-compile-target-directory
|
||||
(list (expand-file-name comp-native-version-dir
|
||||
native-compile-target-directory))
|
||||
(comp-eln-load-path-eff))
|
||||
for f = (expand-file-name
|
||||
(comp-trampoline-filename subr-name)
|
||||
dir)
|
||||
unless (file-exists-p dir)
|
||||
do (ignore-errors
|
||||
(make-directory dir t)
|
||||
(cl-return f))
|
||||
when (file-writable-p f)
|
||||
do (cl-return f)
|
||||
finally (error "Cannot find suitable directory for output in \
|
||||
`native-comp-eln-load-path'"))))))
|
||||
|
||||
|
||||
;; Some entry point support code.
|
||||
|
|
@ -3935,8 +3939,11 @@ display a message."
|
|||
when (or native-comp-always-compile
|
||||
load ; Always compile when the compilation is
|
||||
; commanded for late load.
|
||||
(file-newer-than-file-p
|
||||
source-file (comp-el-to-eln-filename source-file)))
|
||||
;; Skip compilation if `comp-el-to-eln-filename' fails
|
||||
;; to find a writable directory.
|
||||
(with-demoted-errors "Async compilation :%S"
|
||||
(file-newer-than-file-p
|
||||
source-file (comp-el-to-eln-filename source-file))))
|
||||
do (let* ((expr `((require 'comp)
|
||||
(setq comp-async-compilation t)
|
||||
(setq warning-fill-column most-positive-fixnum)
|
||||
|
|
@ -4041,7 +4048,6 @@ the deferred compilation mechanism."
|
|||
(list "Not a function symbol or file" function-or-file)))
|
||||
(catch 'no-native-compile
|
||||
(let* ((print-symbols-bare t)
|
||||
(max-specpdl-size (max max-specpdl-size 5000))
|
||||
(data function-or-file)
|
||||
(comp-native-compiling t)
|
||||
(byte-native-qualities nil)
|
||||
|
|
@ -4104,6 +4110,7 @@ the deferred compilation mechanism."
|
|||
comp-ctxt
|
||||
(comp-ctxt-output comp-ctxt)
|
||||
(file-exists-p (comp-ctxt-output comp-ctxt)))
|
||||
(message "Deleting %s" (comp-ctxt-output comp-ctxt))
|
||||
(delete-file (comp-ctxt-output comp-ctxt)))))))
|
||||
|
||||
(defun native-compile-async-skip-p (file load selector)
|
||||
|
|
|
|||
|
|
@ -110,10 +110,6 @@ The value used here is passed to `quit-restore-window'."
|
|||
(defvar debugger-previous-window-height nil
|
||||
"The last recorded height of `debugger-previous-window'.")
|
||||
|
||||
(defvar debugger-previous-backtrace nil
|
||||
"The contents of the previous backtrace (including text properties).
|
||||
This is to optimize `debugger-make-xrefs'.")
|
||||
|
||||
(defvar debugger-outer-match-data)
|
||||
(defvar debugger-will-be-back nil
|
||||
"Non-nil if we expect to get back in the debugger soon.")
|
||||
|
|
@ -836,6 +832,10 @@ To specify a nil argument interactively, exit with an empty minibuffer."
|
|||
;;;###autoload
|
||||
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
|
||||
|
||||
(make-obsolete-variable 'debugger-previous-backtrace
|
||||
"no longer used." "29.1")
|
||||
(defvar debugger-previous-backtrace nil)
|
||||
|
||||
(provide 'debug)
|
||||
|
||||
;;; debug.el ends here
|
||||
|
|
|
|||
|
|
@ -417,7 +417,12 @@ No problems result if this variable is not bound.
|
|||
`(defvar ,keymap-sym
|
||||
(let ((m ,keymap))
|
||||
(cond ((keymapp m) m)
|
||||
((listp m) (easy-mmode-define-keymap m))
|
||||
;; FIXME: `easy-mmode-define-keymap' is obsolete,
|
||||
;; so this form should also be obsolete somehow.
|
||||
((listp m)
|
||||
(with-suppressed-warnings ((obsolete
|
||||
easy-mmode-define-keymap))
|
||||
(easy-mmode-define-keymap m)))
|
||||
(t (error "Invalid keymap %S" m))))
|
||||
,(format "Keymap for `%s'." mode-name)))
|
||||
|
||||
|
|
@ -679,6 +684,7 @@ Valid keywords and arguments are:
|
|||
:group Ignored.
|
||||
:suppress Non-nil to call `suppress-keymap' on keymap,
|
||||
`nodigits' to suppress digits as prefix arguments."
|
||||
(declare (obsolete define-keymap "29.1"))
|
||||
(let (inherit dense suppress)
|
||||
(while args
|
||||
(let ((key (pop args))
|
||||
|
|
@ -719,9 +725,7 @@ The M, BS, and ARGS arguments are as per that function. DOC is
|
|||
the constant's documentation.
|
||||
|
||||
This macro is deprecated; use `defvar-keymap' instead."
|
||||
;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still
|
||||
;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first.
|
||||
(declare (doc-string 3) (indent 1))
|
||||
(declare (doc-string 3) (indent 1) (obsolete defvar-keymap "29.1"))
|
||||
`(defconst ,m
|
||||
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
|
||||
,doc))
|
||||
|
|
|
|||
|
|
@ -129,7 +129,7 @@ contains an infinite loop. When Edebug is instrumenting code
|
|||
containing very large quoted lists, it may reach this limit and give
|
||||
the error message \"Too deep - perhaps infinite loop in spec?\".
|
||||
Make this limit larger to countermand that, but you may also need to
|
||||
increase `max-lisp-eval-depth' and `max-specpdl-size'."
|
||||
increase `max-lisp-eval-depth'."
|
||||
:type 'integer
|
||||
:version "26.1")
|
||||
|
||||
|
|
@ -1107,8 +1107,7 @@ purpose by adding an entry to this alist, and setting
|
|||
edebug-best-error
|
||||
edebug-error-point
|
||||
;; Do this once here instead of several times.
|
||||
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
|
||||
(max-specpdl-size (+ 2000 max-specpdl-size)))
|
||||
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth)))
|
||||
(let ((no-match
|
||||
(catch 'no-match
|
||||
(setq result (edebug-read-and-maybe-wrap-form1))
|
||||
|
|
@ -2317,7 +2316,6 @@ and run its entry function, and set up `edebug-before' and
|
|||
;; but not inside an unwind-protect.
|
||||
;; Doing it here also keeps it from growing too large.
|
||||
(max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
|
||||
(max-specpdl-size (+ 200 max-specpdl-size))
|
||||
|
||||
(debugger edebug-debugger) ; only while edebug is active.
|
||||
(edebug-outside-debug-on-error debug-on-error)
|
||||
|
|
@ -3791,9 +3789,6 @@ limited by `edebug-print-length' or `edebug-print-level'."
|
|||
|
||||
;;; Edebug Minor Mode
|
||||
|
||||
(define-obsolete-variable-alias 'gud-inhibit-global-bindings
|
||||
'edebug-inhibit-emacs-lisp-mode-bindings "24.3")
|
||||
|
||||
(defvar edebug-inhibit-emacs-lisp-mode-bindings nil
|
||||
"If non-nil, inhibit Edebug bindings on the C-x C-a key.
|
||||
By default, loading the `edebug' library causes these bindings to
|
||||
|
|
@ -4182,6 +4177,7 @@ from Edebug instrumentation found in the backtrace."
|
|||
(backtrace-mode)
|
||||
(add-hook 'backtrace-goto-source-functions
|
||||
#'edebug--backtrace-goto-source nil t))
|
||||
(edebug-backtrace-mode)
|
||||
(setq edebug-instrumented-backtrace-frames
|
||||
(backtrace-get-frames 'edebug-debugger
|
||||
:constructor #'edebug--make-frame)
|
||||
|
|
@ -4258,6 +4254,14 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
|
|||
(setf (edebug--frame-before-index frame) before-index)
|
||||
(setf (edebug--frame-after-index frame) after-index))
|
||||
|
||||
(defvar-keymap edebug-backtrace-mode-map
|
||||
"s" #'backtrace-goto-source)
|
||||
|
||||
(define-minor-mode edebug-backtrace-mode
|
||||
"Minor mode for showing backtraces from edebug."
|
||||
:lighter nil
|
||||
:interactive nil)
|
||||
|
||||
(defun edebug--backtrace-goto-source ()
|
||||
(let* ((index (backtrace-get-index))
|
||||
(frame (nth index backtrace-frames)))
|
||||
|
|
@ -4567,6 +4571,12 @@ With prefix argument, make it a temporary breakpoint."
|
|||
(was-macro `(macro . ,unwrapped))
|
||||
(t unwrapped))))))
|
||||
|
||||
(defun edebug--strip-plist (symbol)
|
||||
"Remove edebug related properties from plist for SYMBOL."
|
||||
(dolist (prop '( edebug edebug-behavior edebug-coverage
|
||||
edebug-freq-count ghost-edebug))
|
||||
(cl-remprop symbol prop)))
|
||||
|
||||
(defun edebug-remove-instrumentation (functions)
|
||||
"Remove Edebug instrumentation from FUNCTIONS.
|
||||
Interactively, the user is prompted for the function to remove
|
||||
|
|
@ -4598,6 +4608,7 @@ instrumentation for, defaulting to all functions."
|
|||
(dolist (symbol functions)
|
||||
(when-let ((unwrapped
|
||||
(edebug--unwrap*-symbol-function symbol)))
|
||||
(edebug--strip-plist symbol)
|
||||
(defalias symbol unwrapped)))
|
||||
(message "Removed edebug instrumentation from %s"
|
||||
(mapconcat #'symbol-name functions ", ")))
|
||||
|
|
|
|||
|
|
@ -249,16 +249,22 @@ use '%s or turn off `eieio-backward-compatibility' instead" cname)
|
|||
(defun eieio-make-class-predicate (class)
|
||||
(lambda (obj)
|
||||
(:documentation
|
||||
(format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)"
|
||||
class))
|
||||
(concat
|
||||
(internal--format-docstring-line
|
||||
"Return non-nil if OBJ is an object of type `%S'."
|
||||
class)
|
||||
"\n\n(fn OBJ)"))
|
||||
(and (eieio-object-p obj)
|
||||
(same-class-p obj class))))
|
||||
|
||||
(defun eieio-make-child-predicate (class)
|
||||
(lambda (obj)
|
||||
(:documentation
|
||||
(format "Return non-nil if OBJ is an object of type `%S' or a subclass.
|
||||
\n(fn OBJ)" class))
|
||||
(concat
|
||||
(internal--format-docstring-line
|
||||
"Return non-nil if OBJ is an object of type `%S' or a subclass."
|
||||
class)
|
||||
"\n\n(fn OBJ)"))
|
||||
(and (eieio-object-p obj)
|
||||
(object-of-class-p obj class))))
|
||||
|
||||
|
|
@ -353,8 +359,8 @@ See `defclass' for more information."
|
|||
(defalias csym
|
||||
(lambda (obj)
|
||||
(:documentation
|
||||
(format
|
||||
"Test OBJ to see if it a list of objects which are a child of type %s"
|
||||
(internal--format-docstring-line
|
||||
"Test OBJ to see if it a list of objects which are a child of type `%s'."
|
||||
cname))
|
||||
(when (listp obj)
|
||||
(let ((ans t)) ;; nil is valid
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@ are not abstract."
|
|||
(help-insert-xref-button
|
||||
(help-fns-short-filename location)
|
||||
'cl-type-definition ctr location 'define-type)
|
||||
(insert (substitute-command-keys "'")))
|
||||
(insert (substitute-quotes "'")))
|
||||
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
|
||||
(goto-char (point-max))
|
||||
(if (autoloadp def)
|
||||
|
|
|
|||
|
|
@ -136,6 +136,7 @@ and reference them using the function `class-option'."
|
|||
(accessors ()))
|
||||
|
||||
;; Collect the accessors we need to define.
|
||||
(setq slots (mapcar (lambda (x) (if (consp x) x (list x))) slots))
|
||||
(pcase-dolist (`(,sname . ,soptions) slots)
|
||||
(let* ((acces (plist-get soptions :accessor))
|
||||
(initarg (plist-get soptions :initarg))
|
||||
|
|
@ -217,10 +218,11 @@ and reference them using the function `class-option'."
|
|||
(when (and eieio-backward-compatibility (eq alloc :class))
|
||||
;; FIXME: How could I declare this *method* as obsolete.
|
||||
(push `(cl-defmethod ,acces ((this (subclass ,name)))
|
||||
,(format
|
||||
"Retrieve the class slot `%S' from a class `%S'.
|
||||
This method is obsolete."
|
||||
sname name)
|
||||
,(concat
|
||||
(internal--format-docstring-line
|
||||
"Retrieve the class slot `%S' from a class `%S'."
|
||||
sname name)
|
||||
"\nThis method is obsolete.")
|
||||
(if (slot-boundp this ',sname)
|
||||
(eieio-oref-default this ',sname)))
|
||||
accessors)))
|
||||
|
|
@ -229,16 +231,18 @@ This method is obsolete."
|
|||
;; name whose purpose is to set the value of the slot.
|
||||
(if writer
|
||||
(push `(cl-defmethod ,writer ((this ,name) value)
|
||||
,(format "Set the slot `%S' of an object of class `%S'."
|
||||
sname name)
|
||||
,(internal--format-docstring-line
|
||||
"Set the slot `%S' of an object of class `%S'."
|
||||
sname name)
|
||||
(setf (slot-value this ',sname) value))
|
||||
accessors))
|
||||
;; If a reader is defined, then create a generic method
|
||||
;; of that name whose purpose is to access this slot value.
|
||||
(if reader
|
||||
(push `(cl-defmethod ,reader ((this ,name))
|
||||
,(format "Access the slot `%S' from object of class `%S'."
|
||||
sname name)
|
||||
,(internal--format-docstring-line
|
||||
"Access the slot `%S' from object of class `%S'."
|
||||
sname name)
|
||||
(slot-value this ',sname))
|
||||
accessors))
|
||||
))
|
||||
|
|
|
|||
|
|
@ -102,6 +102,43 @@ the name of the test and the result of NAME-FORM."
|
|||
(indent 1))
|
||||
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
|
||||
|
||||
(cl-defmacro ert-with-test-buffer-selected ((&key name)
|
||||
&body body)
|
||||
"Create a test buffer, switch to it, and run BODY.
|
||||
|
||||
This extends `ert-with-test-buffer' by displaying the test
|
||||
buffer (whose name is derived from NAME) in a temporary window.
|
||||
The temporary window becomes the `selected-window' before BODY is
|
||||
evaluated. The modification hooks `before-change-functions' and
|
||||
`after-change-functions' are not inhibited during the evaluation
|
||||
of BODY, which makes it easier to use `execute-kbd-macro' to
|
||||
simulate user interaction. The window configuration is restored
|
||||
before returning, even if BODY exits nonlocally. The return
|
||||
value is the last form in BODY."
|
||||
(declare (debug ((":name" form) def-body))
|
||||
(indent 1))
|
||||
(let ((ret (make-symbol "ert--with-test-buffer-selected-ret")))
|
||||
`(save-window-excursion
|
||||
(let (,ret)
|
||||
(ert-with-test-buffer (:name ,name)
|
||||
(with-current-buffer-window (current-buffer)
|
||||
`(display-buffer-below-selected
|
||||
(body-function
|
||||
. ,(lambda (window)
|
||||
(select-window window t)
|
||||
;; body-function is intended to initialize the
|
||||
;; contents of a temporary read-only buffer, so
|
||||
;; it is executed with some convenience
|
||||
;; changes. Undo those changes so that the
|
||||
;; test buffer behaves more like an ordinary
|
||||
;; buffer while the body executes.
|
||||
(let ((inhibit-modification-hooks nil)
|
||||
(inhibit-read-only nil)
|
||||
(buffer-read-only nil))
|
||||
(setq ,ret (progn ,@body))))))
|
||||
nil))
|
||||
,ret))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ert-kill-all-test-buffers ()
|
||||
"Kill all test buffers that are still live."
|
||||
|
|
@ -422,6 +459,10 @@ The following keyword arguments are supported:
|
|||
:text STRING If non-nil, pass STRING to `make-temp-file' as
|
||||
the TEXT argument.
|
||||
|
||||
:buffer SYMBOL Open the temporary file using `find-file-noselect'
|
||||
and bind SYMBOL to the buffer. Kill the buffer
|
||||
after BODY exits normally or non-locally.
|
||||
|
||||
:coding CODING If non-nil, bind `coding-system-for-write' to CODING
|
||||
when executing BODY. This is handy when STRING includes
|
||||
non-ASCII characters or the temporary file must have a
|
||||
|
|
@ -430,14 +471,17 @@ The following keyword arguments are supported:
|
|||
See also `ert-with-temp-directory'."
|
||||
(declare (indent 1) (debug (symbolp body)))
|
||||
(cl-check-type name symbol)
|
||||
(let (keyw prefix suffix directory text extra-keywords coding)
|
||||
(let (keyw prefix suffix directory text extra-keywords buffer coding)
|
||||
(while (keywordp (setq keyw (car body)))
|
||||
(setq body (cdr body))
|
||||
(pcase keyw
|
||||
(:prefix (setq prefix (pop body)))
|
||||
(:suffix (setq suffix (pop body)))
|
||||
;; This is only for internal use by `ert-with-temp-directory'
|
||||
;; and is therefore not documented.
|
||||
(:directory (setq directory (pop body)))
|
||||
(:text (setq text (pop body)))
|
||||
(:buffer (setq buffer (pop body)))
|
||||
(:coding (setq coding (pop body)))
|
||||
(_ (push keyw extra-keywords) (pop body))))
|
||||
(when extra-keywords
|
||||
|
|
@ -452,9 +496,16 @@ See also `ert-with-temp-directory'."
|
|||
(make-temp-file ,prefix ,directory ,suffix ,text)))
|
||||
(,name ,(if directory
|
||||
`(file-name-as-directory ,temp-file)
|
||||
temp-file)))
|
||||
temp-file))
|
||||
,@(when buffer
|
||||
(list `(,buffer (find-file-literally ,temp-file)))))
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(ignore-errors
|
||||
,@(when buffer
|
||||
(list `(with-current-buffer buf
|
||||
(set-buffer-modified-p nil))
|
||||
`(kill-buffer ,buffer))))
|
||||
(ignore-errors
|
||||
,(if directory
|
||||
`(delete-directory ,temp-file :recursive)
|
||||
|
|
@ -517,7 +568,7 @@ The same keyword arguments are supported as in
|
|||
`("\\`mock\\'" nil ,(system-name)))
|
||||
;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
|
||||
;; in batch mode only, therefore.
|
||||
(unless (and (null noninteractive) (file-directory-p "~/"))
|
||||
(when (and noninteractive (not (file-directory-p "~/")))
|
||||
(setenv "HOME" temporary-file-directory))
|
||||
(format "/mock::%s" temporary-file-directory))))
|
||||
"Temporary directory for remote file tests.")
|
||||
|
|
|
|||
|
|
@ -63,12 +63,12 @@ inserted."
|
|||
|
||||
(cl-defun generate-lisp-file-trailer (file &key version inhibit-provide
|
||||
(coding 'utf-8-emacs-unix) autoloads
|
||||
compile provide)
|
||||
compile provide inhibit-native-compile)
|
||||
"Insert a standard trailer for FILE.
|
||||
By default, this trailer inhibits version control, byte
|
||||
compilation, updating autoloads, and uses a `utf-8-emacs-unix'
|
||||
coding system. These can be inhibited by providing non-nil
|
||||
values to the VERSION, NO-PROVIDE, AUTOLOADS and COMPILE
|
||||
values to the VERSION, AUTOLOADS, COMPILE and NATIVE-COMPILE
|
||||
keyword arguments.
|
||||
|
||||
CODING defaults to `utf-8-emacs-unix'. Use a nil value to
|
||||
|
|
@ -79,7 +79,11 @@ If PROVIDE is non-nil, use that in the `provide' statement
|
|||
instead of using FILE as the basis.
|
||||
|
||||
If `standard-output' is bound to a buffer, insert in that buffer.
|
||||
If no, insert at point in the current buffer."
|
||||
If no, insert at point in the current buffer.
|
||||
|
||||
If INHITBIT-NATIVE-COMPILE is non-nil, add a cookie to inhibit
|
||||
native compilation. (By default, a file will be native-compiled
|
||||
if it's also byte-compiled)."
|
||||
(with-current-buffer (if (bufferp standard-output)
|
||||
standard-output
|
||||
(current-buffer))
|
||||
|
|
@ -96,9 +100,11 @@ If no, insert at point in the current buffer."
|
|||
(unless version
|
||||
(insert ";; version-control: never\n"))
|
||||
(unless compile
|
||||
(insert ";; no-byte-" "compile: t\n")) ;; #$ is byte-compiled into nil.
|
||||
(insert ";; no-byte-" "compile: t\n"))
|
||||
(unless autoloads
|
||||
(insert ";; no-update-autoloads: t\n"))
|
||||
(when inhibit-native-compile
|
||||
(insert ";; no-native-" "compile: t\n"))
|
||||
(when coding
|
||||
(insert (format ";; coding: %s\n"
|
||||
(if (eq coding t)
|
||||
|
|
|
|||
|
|
@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that returns the value to
|
|||
set it to.
|
||||
DO must return an Elisp expression."
|
||||
(cond
|
||||
((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
|
||||
((symbolp place)
|
||||
(let ((me (macroexpand-1 place macroexpand-all-environment)))
|
||||
(if (eq me place)
|
||||
(funcall do place (lambda (v) `(setq ,place ,v)))
|
||||
(gv-get me do))))
|
||||
((not (consp place)) (signal 'gv-invalid-place (list place)))
|
||||
(t
|
||||
(let* ((head (car place))
|
||||
|
|
@ -532,13 +536,15 @@ The return value is the last VAL in the list.
|
|||
(funcall do `(error . ,args)
|
||||
(lambda (v) `(progn ,v (error . ,args))))))
|
||||
|
||||
(defmacro gv-synthetic-place (getter setter)
|
||||
(defun gv-synthetic-place (getter setter)
|
||||
"Special place described by its setter and getter.
|
||||
GETTER and SETTER (typically obtained via `gv-letplace') get and
|
||||
set that place. I.e. This macro allows you to do the \"reverse\" of what
|
||||
`gv-letplace' does.
|
||||
This macro only makes sense when used in a place."
|
||||
(declare (gv-expander funcall))
|
||||
set that place. I.e. this function allows you to do the
|
||||
\"reverse\" of what `gv-letplace' does.
|
||||
|
||||
This function is only useful when used in conjunction with
|
||||
generalized variables in place forms."
|
||||
(declare (gv-expander funcall) (compiler-macro (lambda (_) getter)))
|
||||
(ignore setter)
|
||||
getter)
|
||||
|
||||
|
|
@ -806,6 +812,7 @@ REF must have been previously obtained with `gv-ref'."
|
|||
`(cond
|
||||
(,v ,(funcall setter val))
|
||||
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
|
||||
(make-obsolete-generalized-variable 'eq nil "29.1")
|
||||
|
||||
(gv-define-expander substring
|
||||
(lambda (do place from &optional to)
|
||||
|
|
|
|||
|
|
@ -202,7 +202,11 @@ present if the icon is represented by an image."
|
|||
:height (if (eq height 'line)
|
||||
(window-default-line-height)
|
||||
height)
|
||||
:scale 1)
|
||||
:scale 1
|
||||
:rotation (or (plist-get keywords :rotation) 0)
|
||||
:ascent (if (plist-member keywords :ascent)
|
||||
(plist-get keywords :ascent)
|
||||
'center))
|
||||
(create-image file))))))
|
||||
|
||||
(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
|
||||
|
|
|
|||
|
|
@ -325,6 +325,20 @@ This will generate compile-time constants from BINDINGS."
|
|||
(throw 'matched t)))
|
||||
(throw 'matched nil)))))
|
||||
|
||||
(defun lisp-mode--search-key (char bound)
|
||||
(catch 'found
|
||||
(while (re-search-forward
|
||||
(concat "\\_<" char (rx lisp-mode-symbol) "\\_>")
|
||||
bound t)
|
||||
(when (or (< (match-beginning 0) (+ (point-min) 2))
|
||||
;; A quoted white space before the &/: means that this
|
||||
;; is not the start of a :keyword or an &option.
|
||||
(not (eql (char-after (- (match-beginning 0) 2))
|
||||
?\\))
|
||||
(not (memq (char-after (- (match-beginning 0) 1))
|
||||
'(?\s ?\n ?\t))))
|
||||
(throw 'found t)))))
|
||||
|
||||
(let-when-compile
|
||||
((lisp-fdefs '("defmacro" "defun"))
|
||||
(lisp-vdefs '("defvar"))
|
||||
|
|
@ -496,11 +510,11 @@ This will generate compile-time constants from BINDINGS."
|
|||
(,(rx "\\\\=")
|
||||
(0 font-lock-builtin-face prepend))
|
||||
;; Constant values.
|
||||
(,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
|
||||
(,(lambda (bound) (lisp-mode--search-key ":" bound))
|
||||
(0 font-lock-builtin-face))
|
||||
;; ELisp and CLisp `&' keywords as types.
|
||||
(,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
|
||||
. font-lock-type-face)
|
||||
(,(lambda (bound) (lisp-mode--search-key "&" bound))
|
||||
(0 font-lock-builtin-face))
|
||||
;; ELisp regexp grouping constructs
|
||||
(,(lambda (bound)
|
||||
(catch 'found
|
||||
|
|
@ -549,11 +563,12 @@ This will generate compile-time constants from BINDINGS."
|
|||
;; must come before keywords below to have effect
|
||||
(,(concat "#:" (rx lisp-mode-symbol) "") 0 font-lock-builtin-face)
|
||||
;; Constant values.
|
||||
(,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
|
||||
(,(lambda (bound) (lisp-mode--search-key ":" bound))
|
||||
(0 font-lock-builtin-face))
|
||||
;; ELisp and CLisp `&' keywords as types.
|
||||
(,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
|
||||
. font-lock-type-face)
|
||||
(,(lambda (bound) (lisp-mode--search-key "&" bound))
|
||||
(0 font-lock-builtin-face))
|
||||
;; ELisp regexp grouping constructs
|
||||
;; This is too general -- rms.
|
||||
;; A user complained that he has functions whose names start with `do'
|
||||
;; and that they get the wrong color.
|
||||
|
|
|
|||
|
|
@ -287,10 +287,14 @@ expression, in which case we want to handle forms differently."
|
|||
;; In Emacs this is normally handled separately by cus-dep.el, but for
|
||||
;; third party packages, it can be convenient to explicitly autoload
|
||||
;; a group.
|
||||
(let ((groupname (nth 1 form)))
|
||||
(let ((groupname (nth 1 form))
|
||||
(parent (eval (plist-get form :group) t)))
|
||||
`(let ((loads (get ',groupname 'custom-loads)))
|
||||
(if (member ',file loads) nil
|
||||
(put ',groupname 'custom-loads (cons ',file loads))))))
|
||||
(put ',groupname 'custom-loads (cons ',file loads))
|
||||
,@(when parent
|
||||
`((put ',parent 'custom-loads
|
||||
(cons ',groupname (get ',parent 'custom-loads)))))))))
|
||||
|
||||
;; When processing a macro expansion, any expression
|
||||
;; before a :autoload-end should be included. These are typically (put
|
||||
|
|
@ -504,6 +508,7 @@ If COMPILE, don't include a \"don't compile\" cookie."
|
|||
(generate-lisp-file-trailer
|
||||
file :provide (and (stringp feature) feature)
|
||||
:compile compile
|
||||
:inhibit-native-compile t
|
||||
:inhibit-provide (not feature))
|
||||
(buffer-string))))
|
||||
|
||||
|
|
@ -511,7 +516,7 @@ If COMPILE, don't include a \"don't compile\" cookie."
|
|||
(defun loaddefs-generate (dir output-file &optional excluded-files
|
||||
extra-data include-package-version
|
||||
generate-full)
|
||||
"Generate loaddefs files for Lisp files in the directories DIRS.
|
||||
"Generate loaddefs files for Lisp files in one or more directories given by DIR.
|
||||
DIR can be either a single directory or a list of directories.
|
||||
|
||||
The autoloads will be written to OUTPUT-FILE. If any Lisp file
|
||||
|
|
@ -519,7 +524,7 @@ binds `generated-autoload-file' as a file-local variable, write
|
|||
its autoloads into the specified file instead.
|
||||
|
||||
The function does NOT recursively descend into subdirectories of the
|
||||
directory or directories specified by DIRS.
|
||||
directories specified by DIR.
|
||||
|
||||
Optional argument EXCLUDED-FILES, if non-nil, should be a list of
|
||||
files, such as preloaded files, whose autoloads should not be written
|
||||
|
|
@ -627,7 +632,7 @@ instead of just updating them with the new/changed autoloads."
|
|||
;; It's a new file; put the data at the end.
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(search-backward "\f\n"))
|
||||
(search-backward "\f\n" nil t))
|
||||
;; Delete the old version of the section.
|
||||
(delete-region (match-beginning 0)
|
||||
(and (search-forward "\n\f\n;;;")
|
||||
|
|
|
|||
|
|
@ -110,7 +110,8 @@ each clause."
|
|||
(let ((symbols-with-pos-enabled t))
|
||||
(apply handler form (cdr form)))
|
||||
(error
|
||||
(message "Compiler-macro error for %S: Handler: %S\n%S" (car form) handler err)
|
||||
(message "Warning: Optimization failure for %S: Handler: %S\n%S"
|
||||
(car form) handler err)
|
||||
form)))
|
||||
|
||||
(defun macroexp--funcall-if-compiled (_form)
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;; Keywords: extensions, lisp, tools
|
||||
;; Version: 1.0
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -37,11 +38,6 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;; The autoloads.el mechanism which adds package--builtin-versions
|
||||
;; maintenance to loaddefs.el doesn't work for preloaded packages (such
|
||||
;; as this one), so we have to do it by hand!
|
||||
(push (purecopy '(nadvice 1 0)) package--builtin-versions)
|
||||
|
||||
(oclosure-define (advice
|
||||
(:predicate advice--p)
|
||||
(:copier advice--cons (cdr))
|
||||
|
|
@ -108,19 +104,26 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
|
|||
(format "%s\n%s" name doc)
|
||||
(format "%s" name))
|
||||
(or doc "No documentation")))))
|
||||
"\n")))
|
||||
"\n"
|
||||
(and
|
||||
(eq how :override)
|
||||
(concat
|
||||
(format-message
|
||||
"\nThis is an :override advice, which means that `%s' isn't\n" function)
|
||||
"run at all, and the documentation below may be irrelevant.\n")))))
|
||||
|
||||
(defun advice--make-docstring (function)
|
||||
"Build the raw docstring for FUNCTION, presumably advised."
|
||||
(let* ((flist (indirect-function function))
|
||||
(docfun nil)
|
||||
(macrop (eq 'macro (car-safe flist)))
|
||||
(docstring nil))
|
||||
(before nil)
|
||||
(after nil))
|
||||
(when macrop
|
||||
(setq flist (cdr flist)))
|
||||
(if (and (autoloadp flist)
|
||||
(get function 'advice--pending))
|
||||
(setq docstring
|
||||
(setq after
|
||||
(advice--make-single-doc (get function 'advice--pending)
|
||||
function macrop))
|
||||
(while (advice--p flist)
|
||||
|
|
@ -130,9 +133,13 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
|
|||
;; object instead! So here we try to undo the damage.
|
||||
(when (integerp (aref flist 4))
|
||||
(setq docfun flist))
|
||||
(setq docstring (concat docstring (advice--make-single-doc
|
||||
flist function macrop))
|
||||
flist (advice--cdr flist))))
|
||||
(let ((doc-bit (advice--make-single-doc flist function macrop)))
|
||||
;; We want :overrides to go to the front, because they mean
|
||||
;; that the doc string may be irrelevant.
|
||||
(if (eq (advice--how flist) :override)
|
||||
(setq before (concat before doc-bit))
|
||||
(setq after (concat after doc-bit))))
|
||||
(setq flist (advice--cdr flist))))
|
||||
(unless docfun
|
||||
(setq docfun flist))
|
||||
(let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops.
|
||||
|
|
@ -145,12 +152,18 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
|
|||
(if (stringp arglist) t
|
||||
(help--make-usage-docstring function arglist)))
|
||||
(setq origdoc (cdr usage)) (car usage)))
|
||||
(help-add-fundoc-usage (concat origdoc
|
||||
(if (string-suffix-p "\n" origdoc)
|
||||
"\n"
|
||||
"\n\n")
|
||||
docstring)
|
||||
usage))))
|
||||
(help-add-fundoc-usage
|
||||
(with-temp-buffer
|
||||
(when before
|
||||
(insert before)
|
||||
(ensure-empty-lines 1))
|
||||
(when origdoc
|
||||
(insert origdoc))
|
||||
(when after
|
||||
(ensure-empty-lines 1)
|
||||
(insert after))
|
||||
(buffer-string))
|
||||
usage))))
|
||||
|
||||
(defun advice-eval-interactive-spec (spec)
|
||||
"Evaluate the interactive spec SPEC."
|
||||
|
|
|
|||
|
|
@ -557,6 +557,21 @@ This has 2 uses:
|
|||
(oclosure-define (save-some-buffers-function
|
||||
(:predicate save-some-buffers-function--p)))
|
||||
|
||||
;; This OClosure type is used internally by `cconv.el' to handle
|
||||
;; the case where we need to build a closure whose `interactive' spec
|
||||
;; captures variables from the context.
|
||||
;; It arguably belongs with `cconv.el' but is needed at runtime,
|
||||
;; so we placed it here.
|
||||
(oclosure-define (cconv--interactive-helper) fun if)
|
||||
(defun cconv--interactive-helper (fun if)
|
||||
"Add interactive \"form\" IF to FUN.
|
||||
Returns a new command that otherwise behaves like FUN.
|
||||
IF should actually not be a form but a function of no arguments."
|
||||
(oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
|
||||
(&rest args)
|
||||
(apply (if (called-interactively-p 'any)
|
||||
#'funcall-interactively #'funcall)
|
||||
fun args)))
|
||||
|
||||
(provide 'oclosure)
|
||||
;;; oclosure.el ends here
|
||||
|
|
|
|||
|
|
@ -2189,8 +2189,8 @@ to install it but still mark it as selected."
|
|||
(assq (car elt) package-archive-contents)))
|
||||
(and available
|
||||
(version-list-<
|
||||
(package-desc-priority-version (cadr elt))
|
||||
(package-desc-priority-version (cadr available))))))
|
||||
(package-desc-version (cadr elt))
|
||||
(package-desc-version (cadr available))))))
|
||||
package-alist)))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -2648,7 +2648,7 @@ Helper function for `describe-package'."
|
|||
"',\n shadowing a ")
|
||||
(propertize "built-in package"
|
||||
'font-lock-face 'package-status-built-in))
|
||||
(insert (substitute-command-keys "'")))
|
||||
(insert (substitute-quotes "'")))
|
||||
(if signed
|
||||
(insert ".")
|
||||
(insert " (unsigned)."))
|
||||
|
|
@ -3700,30 +3700,34 @@ objects removed."
|
|||
`((delete . ,del) (install . ,ins) (upgrade . ,upg))))
|
||||
|
||||
(defun package-menu--perform-transaction (install-list delete-list)
|
||||
"Install packages in INSTALL-LIST and delete DELETE-LIST."
|
||||
(if install-list
|
||||
(let ((status-format (format ":Installing %%d/%d"
|
||||
(length install-list)))
|
||||
(i 0)
|
||||
(package-menu--transaction-status))
|
||||
(dolist (pkg install-list)
|
||||
(setq package-menu--transaction-status
|
||||
(format status-format (cl-incf i)))
|
||||
(force-mode-line-update)
|
||||
(redisplay 'force)
|
||||
;; Don't mark as selected, `package-menu-execute' already
|
||||
;; does that.
|
||||
(package-install pkg 'dont-select))))
|
||||
(let ((package-menu--transaction-status ":Deleting"))
|
||||
(force-mode-line-update)
|
||||
(redisplay 'force)
|
||||
(dolist (elt (package--sort-by-dependence delete-list))
|
||||
(condition-case-unless-debug err
|
||||
(let ((inhibit-message (or inhibit-message package-menu-async)))
|
||||
(package-delete elt nil 'nosave))
|
||||
(error (message "Error trying to delete `%s': %S"
|
||||
(package-desc-full-name elt)
|
||||
err))))))
|
||||
"Install packages in INSTALL-LIST and delete DELETE-LIST.
|
||||
Return nil if there were no errors; non-nil otherwise."
|
||||
(let ((errors nil))
|
||||
(if install-list
|
||||
(let ((status-format (format ":Installing %%d/%d"
|
||||
(length install-list)))
|
||||
(i 0)
|
||||
(package-menu--transaction-status))
|
||||
(dolist (pkg install-list)
|
||||
(setq package-menu--transaction-status
|
||||
(format status-format (cl-incf i)))
|
||||
(force-mode-line-update)
|
||||
(redisplay 'force)
|
||||
;; Don't mark as selected, `package-menu-execute' already
|
||||
;; does that.
|
||||
(package-install pkg 'dont-select))))
|
||||
(let ((package-menu--transaction-status ":Deleting"))
|
||||
(force-mode-line-update)
|
||||
(redisplay 'force)
|
||||
(dolist (elt (package--sort-by-dependence delete-list))
|
||||
(condition-case-unless-debug err
|
||||
(let ((inhibit-message (or inhibit-message package-menu-async)))
|
||||
(package-delete elt nil 'nosave))
|
||||
(error
|
||||
(push (package-desc-full-name elt) errors)
|
||||
(message "Error trying to delete `%s': %S"
|
||||
(package-desc-full-name elt) err)))))
|
||||
errors))
|
||||
|
||||
(defun package--update-selected-packages (add remove)
|
||||
"Update the `package-selected-packages' list according to ADD and REMOVE.
|
||||
|
|
@ -3796,8 +3800,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
|
|||
(message "Operation %s started" message-template)
|
||||
;; Packages being upgraded are not marked as selected.
|
||||
(package--update-selected-packages .install .delete)
|
||||
(package-menu--perform-transaction install-list delete-list)
|
||||
(when package-selected-packages
|
||||
(unless (package-menu--perform-transaction install-list delete-list)
|
||||
;; If there weren't errors, output data.
|
||||
(if-let* ((removable (package--removable-packages)))
|
||||
(message "Operation finished. Packages that are no longer needed: %d. Type `%s' to remove them"
|
||||
(length removable)
|
||||
|
|
|
|||
|
|
@ -369,7 +369,8 @@ provided in the Commentary section of this library."
|
|||
(get-buffer-create reb-buffer)
|
||||
`((display-buffer-in-direction)
|
||||
(direction . ,dir)
|
||||
(dedicated . t))))))
|
||||
(dedicated . t)
|
||||
(window-height . fit-window-to-buffer))))))
|
||||
(font-lock-mode 1)
|
||||
(reb-initialize-buffer)))
|
||||
|
||||
|
|
|
|||
|
|
@ -133,7 +133,6 @@ usually more efficient than that of a simplified version:
|
|||
(save-match-data
|
||||
;; Recurse on the sorted list.
|
||||
(let* ((max-lisp-eval-depth 10000)
|
||||
(max-specpdl-size 10000)
|
||||
(completion-ignore-case nil)
|
||||
(completion-regexp-list nil)
|
||||
(open (cond ((stringp paren) paren) (paren "\\(")))
|
||||
|
|
|
|||
|
|
@ -346,6 +346,20 @@ list."
|
|||
(seq-filter (lambda (elt) (not (funcall pred elt)))
|
||||
sequence))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defgeneric seq-remove-at-position (sequence n)
|
||||
"Return a copy of SEQUENCE where the element at N got removed.
|
||||
|
||||
N is the (zero-based) index of the element that should not be in
|
||||
the result.
|
||||
|
||||
The result is a sequence of the same type as SEQUENCE."
|
||||
(seq-concatenate
|
||||
(let ((type (type-of sequence)))
|
||||
(if (eq type 'cons) 'list type))
|
||||
(seq-subseq sequence 0 n)
|
||||
(seq-subseq sequence (1+ n))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defgeneric seq-reduce (function sequence initial-value)
|
||||
"Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
|
||||
|
|
@ -409,7 +423,7 @@ found or not."
|
|||
|
||||
(cl-defgeneric seq-contains (sequence elt &optional testfn)
|
||||
"Return the first element in SEQUENCE that is equal to ELT.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(declare (obsolete seq-contains-p "27.1"))
|
||||
(seq-some (lambda (e)
|
||||
(when (funcall (or testfn #'equal) elt e)
|
||||
|
|
@ -418,7 +432,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
|||
|
||||
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
|
||||
"Return non-nil if SEQUENCE contains an element equal to ELT.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(catch 'seq--break
|
||||
(seq-doseq (e sequence)
|
||||
(let ((r (funcall (or testfn #'equal) e elt)))
|
||||
|
|
@ -429,14 +443,14 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
|||
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
|
||||
"Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
|
||||
This does not depend on the order of the elements.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1)
|
||||
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defgeneric seq-position (sequence elt &optional testfn)
|
||||
"Return the index of the first element in SEQUENCE that is equal to ELT.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
"Return the (zero-based) index of the first element in SEQUENCE equal to ELT.
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(let ((index 0))
|
||||
(catch 'seq--break
|
||||
(seq-doseq (e sequence)
|
||||
|
|
@ -445,6 +459,23 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
|||
(setq index (1+ index)))
|
||||
nil)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defgeneric seq-positions (sequence elt &optional testfn)
|
||||
"Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil.
|
||||
|
||||
TESTFN is a two-argument function which is passed each element of
|
||||
SEQUENCE as first argument and ELT as second. TESTFN defaults to
|
||||
`equal'.
|
||||
|
||||
The result is a list of (zero-based) indices."
|
||||
(let ((result '()))
|
||||
(seq-do-indexed
|
||||
(lambda (e index)
|
||||
(when (funcall (or testfn #'equal) e elt)
|
||||
(push index result)))
|
||||
sequence)
|
||||
(nreverse result)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defgeneric seq-uniq (sequence &optional testfn)
|
||||
"Return a list of the elements of SEQUENCE with duplicates removed.
|
||||
|
|
@ -502,7 +533,7 @@ negative integer or 0, nil is returned."
|
|||
;;;###autoload
|
||||
(cl-defgeneric seq-union (sequence1 sequence2 &optional testfn)
|
||||
"Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(let* ((accum (lambda (acc elt)
|
||||
(if (seq-contains-p acc elt testfn)
|
||||
acc
|
||||
|
|
@ -514,7 +545,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
|||
;;;###autoload
|
||||
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
|
||||
"Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(seq-reduce (lambda (acc elt)
|
||||
(if (seq-contains-p sequence2 elt testfn)
|
||||
(cons elt acc)
|
||||
|
|
@ -524,7 +555,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
|||
|
||||
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
|
||||
"Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil."
|
||||
Equality is defined by the function TESTFN, which defaults to `equal'."
|
||||
(seq-reduce (lambda (acc elt)
|
||||
(if (seq-contains-p sequence2 elt testfn)
|
||||
acc
|
||||
|
|
@ -618,13 +649,7 @@ Signal an error if SEQUENCE is empty."
|
|||
|
||||
(cl-defmethod seq-take ((list list) n)
|
||||
"Optimized implementation of `seq-take' for lists."
|
||||
(if (eval-when-compile (fboundp 'take))
|
||||
(take n list)
|
||||
(let ((result '()))
|
||||
(while (and list (> n 0))
|
||||
(setq n (1- n))
|
||||
(push (pop list) result))
|
||||
(nreverse result))))
|
||||
(take n list))
|
||||
|
||||
(cl-defmethod seq-drop-while (pred (list list))
|
||||
"Optimized implementation of `seq-drop-while' for lists."
|
||||
|
|
@ -655,16 +680,6 @@ Signal an error if SEQUENCE is empty."
|
|||
sequence
|
||||
(concat sequence)))
|
||||
|
||||
(defun seq--activate-font-lock-keywords ()
|
||||
"Activate font-lock keywords for some symbols defined in seq."
|
||||
(font-lock-add-keywords 'emacs-lisp-mode
|
||||
'("\\<seq-doseq\\>" "\\<seq-let\\>")))
|
||||
|
||||
(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
|
||||
;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
|
||||
;; we automatically highlight macros.
|
||||
(add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
|
||||
|
||||
(defun seq-split (sequence length)
|
||||
"Split SEQUENCE into a list of sub-sequences of at most LENGTH.
|
||||
All the sub-sequences will be of LENGTH, except the last one,
|
||||
|
|
@ -680,5 +695,9 @@ which may be shorter."
|
|||
result))
|
||||
(nreverse result)))
|
||||
|
||||
(defun seq-keep (function sequence)
|
||||
"Apply FUNCTION to SEQUENCE and return all non-nil results."
|
||||
(delq nil (seq-map function sequence)))
|
||||
|
||||
(provide 'seq)
|
||||
;;; seq.el ends here
|
||||
|
|
|
|||
|
|
@ -22,6 +22,15 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package lists functions based on various groupings.
|
||||
;;
|
||||
;; For instance, `string-trim' and `mapconcat' are `string' functions,
|
||||
;; so `M-x shortdoc RET string RET' will give an overview of functions
|
||||
;; that operate on strings.
|
||||
;;
|
||||
;; The documentation groups are created with the
|
||||
;; `define-short-documentation-group' macro.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'seq)
|
||||
|
|
@ -355,13 +364,11 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
(abbreviate-file-name
|
||||
:no-eval (abbreviate-file-name "/home/some-user")
|
||||
:eg-result "~some-user")
|
||||
(file-parent-directory
|
||||
:eval (file-parent-directory "/foo/bar")
|
||||
:eval (file-parent-directory "~")
|
||||
:eval (file-parent-directory "/tmp/")
|
||||
:eval (file-parent-directory "foo/bar")
|
||||
:eval (file-parent-directory "foo")
|
||||
:eval (file-parent-directory "/"))
|
||||
(file-name-parent-directory
|
||||
:eval (file-name-parent-directory "/foo/bar")
|
||||
:eval (file-name-parent-directory "/foo/")
|
||||
:eval (file-name-parent-directory "foo/bar")
|
||||
:eval (file-name-parent-directory "foo"))
|
||||
"Quoted File Names"
|
||||
(file-name-quote
|
||||
:args (name)
|
||||
|
|
@ -846,6 +853,10 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
:eval (seq-find #'numberp '(a b 3 4 f 6)))
|
||||
(seq-position
|
||||
:eval (seq-position '(a b c) 'c))
|
||||
(seq-positions
|
||||
:eval (seq-positions '(a b c a d) 'a)
|
||||
:eval (seq-positions '(a b c a d) 'z)
|
||||
:eval (seq-positions '(11 5 7 12 9 15) 10 #'>=))
|
||||
(seq-length
|
||||
:eval (seq-length "abcde"))
|
||||
(seq-max
|
||||
|
|
@ -888,6 +899,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
:eval (seq-filter #'numberp '(a b 3 4 f 6)))
|
||||
(seq-remove
|
||||
:eval (seq-remove #'numberp '(1 2 c d 5)))
|
||||
(seq-remove-at-position
|
||||
:eval (seq-remove-at-position '(a b c d e) 3)
|
||||
:eval (seq-remove-at-position [a b c d e] 0))
|
||||
(seq-group-by
|
||||
:eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6)))
|
||||
(seq-union
|
||||
|
|
@ -1507,8 +1521,11 @@ Example:
|
|||
:doc "Keymap for `shortdoc-mode'."
|
||||
"n" #'shortdoc-next
|
||||
"p" #'shortdoc-previous
|
||||
"N" #'shortdoc-next-section
|
||||
"P" #'shortdoc-previous-section
|
||||
"C-c C-n" #'shortdoc-next-section
|
||||
"C-c C-p" #'shortdoc-previous-section)
|
||||
"C-c C-p" #'shortdoc-previous-section
|
||||
"w" #'shortdoc-copy-function-as-kill)
|
||||
|
||||
(define-derived-mode shortdoc-mode special-mode "shortdoc"
|
||||
"Mode for shortdoc."
|
||||
|
|
@ -1521,35 +1538,49 @@ Example:
|
|||
(funcall
|
||||
(if reverse 'text-property-search-backward
|
||||
'text-property-search-forward)
|
||||
sym nil t t)
|
||||
sym nil t)
|
||||
(setq arg (1- arg))))
|
||||
|
||||
(defun shortdoc-next (&optional arg)
|
||||
"Move cursor to the next function.
|
||||
With ARG, do it that many times."
|
||||
"Move point to the next function.
|
||||
With prefix numeric argument ARG, do it that many times."
|
||||
(interactive "p" shortdoc-mode)
|
||||
(shortdoc--goto-section arg 'shortdoc-function))
|
||||
|
||||
(defun shortdoc-previous (&optional arg)
|
||||
"Move cursor to the previous function.
|
||||
With ARG, do it that many times."
|
||||
"Move point to the previous function.
|
||||
With prefix numeric argument ARG, do it that many times."
|
||||
(interactive "p" shortdoc-mode)
|
||||
(shortdoc--goto-section arg 'shortdoc-function t)
|
||||
(backward-char 1))
|
||||
|
||||
(defun shortdoc-next-section (&optional arg)
|
||||
"Move cursor to the next section.
|
||||
With ARG, do it that many times."
|
||||
"Move point to the next section.
|
||||
With prefix numeric argument ARG, do it that many times."
|
||||
(interactive "p" shortdoc-mode)
|
||||
(shortdoc--goto-section arg 'shortdoc-section))
|
||||
|
||||
(defun shortdoc-previous-section (&optional arg)
|
||||
"Move cursor to the previous section.
|
||||
With ARG, do it that many times."
|
||||
"Move point to the previous section.
|
||||
With prefix numeric argument ARG, do it that many times."
|
||||
(interactive "p" shortdoc-mode)
|
||||
(shortdoc--goto-section arg 'shortdoc-section t)
|
||||
(forward-line -2))
|
||||
|
||||
(defun shortdoc-copy-function-as-kill ()
|
||||
"Copy name of the function near point into the kill ring."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (pos-bol))
|
||||
(when-let* ((re (rx bol "(" (group (+ (not (in " "))))))
|
||||
(string
|
||||
(and (or (looking-at re)
|
||||
(re-search-backward re nil t))
|
||||
(match-string 1))))
|
||||
(set-text-properties 0 (length string) nil string)
|
||||
(kill-new string)
|
||||
(message string))))
|
||||
|
||||
(provide 'shortdoc)
|
||||
|
||||
;;; shortdoc.el ends here
|
||||
|
|
|
|||
|
|
@ -97,6 +97,7 @@ threading."
|
|||
(maphash (lambda (_ v) (push v values)) hash-table)
|
||||
values))
|
||||
|
||||
;;;###autoload
|
||||
(defsubst string-join (strings &optional separator)
|
||||
"Join all STRINGS using SEPARATOR.
|
||||
Optional argument SEPARATOR must be a string, a vector, or a list of
|
||||
|
|
|
|||
|
|
@ -637,8 +637,7 @@ argument is maybe, return maybe. Return 1value only if both arguments
|
|||
are 1value."
|
||||
(cl-case val
|
||||
(testcover-1value result)
|
||||
(maybe (and result 'maybe))
|
||||
(nil nil)))
|
||||
(maybe (and result 'maybe))))
|
||||
|
||||
(defun testcover-analyze-coverage-compose (forms func)
|
||||
"Analyze a list of FORMS for code coverage using FUNC.
|
||||
|
|
|
|||
|
|
@ -770,7 +770,8 @@ If NEXT, do the next column."
|
|||
((string-match "\\([0-9.]+\\)px" spec)
|
||||
(string-to-number (match-string 1 spec)))
|
||||
((string-match "\\([0-9.]+\\)%" spec)
|
||||
(* (string-to-number (match-string 1 spec)) (window-width nil t)))
|
||||
(/ (* (string-to-number (match-string 1 spec)) (window-width nil t))
|
||||
100))
|
||||
(t
|
||||
(error "Invalid spec: %s" spec))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue