mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-22 10:26:20 +00:00
Autoload more carefully from Lisp. Follow aliases for function properties.
* lisp/subr.el (autoloadp): New function. (symbol-file): Use it. (function-get): New function. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and autoload-do-load. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function) (lisp-indent-function): * lisp/emacs-lisp/gv.el (gv-get): * lisp/emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form): * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): * lisp/emacs-lisp/autoload.el (make-autoload, autoload-print-form): Use function-get. * lisp/emacs-lisp/cl.el: Don't propagate function properties any more. * src/eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp, add argument, tune behavior, and adjust all callers. * lisp/speedbar.el (speedbar-add-localized-speedbar-support): * lisp/emacs-lisp/disass.el (disassemble-internal): * lisp/desktop.el (desktop-load-file): * lisp/help-fns.el (help-function-arglist, find-lisp-object-file-name) (describe-function-1): * lisp/emacs-lisp/find-func.el (find-function-noselect): * lisp/emacs-lisp/elp.el (elp-instrument-function): * lisp/emacs-lisp/advice.el (ad-has-proper-definition): * lisp/apropos.el (apropos-safe-documentation, apropos-macrop): * lisp/emacs-lisp/debug.el (debug-on-entry): * lisp/emacs-lisp/cl-macs.el (cl-compiler-macroexpand): * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): * lisp/calc/calc.el (name): Use autoloadp & autoload-do-load.
This commit is contained in:
Stefan Monnier
parent
b1364986cb
commit
7abaf5ccc9
4
etc/NEWS
4
etc/NEWS
@ -498,6 +498,10 @@ still be supported for Emacs 24.x.
|
||||
|
||||
* Lisp changes in Emacs 24.2
|
||||
|
||||
** New functions `autoloadp' and `autoload-do-load'.
|
||||
|
||||
** `function-get' fetches the property of a function, following aliases.
|
||||
|
||||
** `toggle-read-only' accepts a second argument specifying whether to
|
||||
print a message, if called from Lisp.
|
||||
|
||||
|
||||
@ -1,3 +1,37 @@
|
||||
2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Autoload from Lisp with more care. Follow aliases when looking for
|
||||
function properties.
|
||||
* subr.el (autoloadp): New function.
|
||||
(symbol-file): Use it.
|
||||
(function-get): New function.
|
||||
* emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and
|
||||
autoload-do-load.
|
||||
* emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function)
|
||||
(lisp-indent-function):
|
||||
* emacs-lisp/gv.el (gv-get):
|
||||
* emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec):
|
||||
* emacs-lisp/byte-opt.el (byte-optimize-form):
|
||||
* emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
|
||||
* emacs-lisp/autoload.el (make-autoload, autoload-print-form):
|
||||
Use function-get.
|
||||
* emacs-lisp/cl.el: Don't propagate function properties any more.
|
||||
|
||||
* speedbar.el (speedbar-add-localized-speedbar-support):
|
||||
* emacs-lisp/disass.el (disassemble-internal):
|
||||
* desktop.el (desktop-load-file):
|
||||
* help-fns.el (help-function-arglist, find-lisp-object-file-name)
|
||||
(describe-function-1):
|
||||
* emacs-lisp/find-func.el (find-function-noselect):
|
||||
* emacs-lisp/elp.el (elp-instrument-function):
|
||||
* emacs-lisp/advice.el (ad-has-proper-definition):
|
||||
* apropos.el (apropos-safe-documentation, apropos-macrop):
|
||||
* emacs-lisp/debug.el (debug-on-entry):
|
||||
* emacs-lisp/cl-macs.el (cl-compiler-macroexpand):
|
||||
* emacs-lisp/byte-opt.el (byte-compile-inline-expand):
|
||||
* calc/calc.el (name): Use autoloadp & autoload-do-load.
|
||||
|
||||
|
||||
2012-07-25 Alp Aker <alp.tekin.aker@gmail.com>
|
||||
|
||||
* international/mule-cmds.el (ucs-insert): Mark it as an obsolete
|
||||
|
||||
@ -980,7 +980,7 @@ Will return nil instead."
|
||||
(setq function (if (byte-code-function-p function)
|
||||
(if (> (length function) 4)
|
||||
(aref function 4))
|
||||
(if (eq (car-safe function) 'autoload)
|
||||
(if (autoloadp function)
|
||||
(nth 2 function)
|
||||
(if (eq (car-safe function) 'lambda)
|
||||
(if (stringp (nth 2 function))
|
||||
@ -1114,7 +1114,7 @@ If non-nil TEXT is a string that will be printed as a heading."
|
||||
(consp (setq symbol
|
||||
(symbol-function symbol)))
|
||||
(or (eq (car symbol) 'macro)
|
||||
(if (eq (car symbol) 'autoload)
|
||||
(if (autoloadp symbol)
|
||||
(memq (nth 4 symbol)
|
||||
'(macro t))))))
|
||||
|
||||
|
||||
@ -914,7 +914,7 @@ Used by `calc-user-invocation'.")
|
||||
|
||||
;; Set up the autoloading linkage.
|
||||
(let ((name (and (fboundp 'calc-dispatch)
|
||||
(eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
|
||||
(autoloadp (symbol-function 'calc-dispatch))
|
||||
(nth 1 (symbol-function 'calc-dispatch))))
|
||||
(p load-path))
|
||||
|
||||
|
||||
@ -1119,11 +1119,8 @@ directory DIRNAME."
|
||||
|
||||
(defun desktop-load-file (function)
|
||||
"Load the file where auto loaded FUNCTION is defined."
|
||||
(when function
|
||||
(let ((fcell (and (fboundp function) (symbol-function function))))
|
||||
(when (and (listp fcell)
|
||||
(eq 'autoload (car fcell)))
|
||||
(load (cadr fcell))))))
|
||||
(when (fboundp function)
|
||||
(autoload-do-load (symbol-function function) function)))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Create a buffer, load its file, set its mode, ...;
|
||||
|
||||
@ -2542,7 +2542,7 @@ definition (see the code for `documentation')."
|
||||
For that it has to be fbound with a non-autoload definition."
|
||||
(and (symbolp function)
|
||||
(fboundp function)
|
||||
(not (eq (car-safe (symbol-function function)) 'autoload))))
|
||||
(not (autoloadp (symbol-function function)))))
|
||||
|
||||
;; The following two are necessary for the sake of packages such as
|
||||
;; ange-ftp which redefine functions via fcell indirection:
|
||||
|
||||
@ -163,23 +163,23 @@ expression, in which case we want to handle forms differently."
|
||||
((or `define-generic-mode `define-derived-mode
|
||||
`define-compilation-mode) nil)
|
||||
(_ t)))
|
||||
(body (nthcdr (or (get car 'doc-string-elt) 3) form))
|
||||
(body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
|
||||
(doc (if (stringp (car body)) (pop body))))
|
||||
;; Add the usage form at the end where describe-function-1
|
||||
;; can recover it.
|
||||
(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
|
||||
;; `define-generic-mode' quotes the name, so take care of that
|
||||
(list 'autoload (if (listp name) name (list 'quote name))
|
||||
file doc
|
||||
(or (and (memq car '(define-skeleton define-derived-mode
|
||||
define-generic-mode
|
||||
easy-mmode-define-global-mode
|
||||
define-global-minor-mode
|
||||
define-globalized-minor-mode
|
||||
easy-mmode-define-minor-mode
|
||||
define-minor-mode)) t)
|
||||
(eq (car-safe (car body)) 'interactive))
|
||||
(if macrop (list 'quote 'macro) nil))))
|
||||
`(autoload ,(if (listp name) name (list 'quote name))
|
||||
,file ,doc
|
||||
,(or (and (memq car '(define-skeleton define-derived-mode
|
||||
define-generic-mode
|
||||
easy-mmode-define-global-mode
|
||||
define-global-minor-mode
|
||||
define-globalized-minor-mode
|
||||
easy-mmode-define-minor-mode
|
||||
define-minor-mode)) t)
|
||||
(eq (car-safe (car body)) 'interactive))
|
||||
,(if macrop ''macro nil))))
|
||||
|
||||
;; For defclass forms, use `eieio-defclass-autoload'.
|
||||
((eq car 'defclass)
|
||||
@ -277,7 +277,7 @@ put the output in."
|
||||
;; Symbols at the toplevel are meaningless.
|
||||
((symbolp form) nil)
|
||||
(t
|
||||
(let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
|
||||
(let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
|
||||
(outbuf autoload-print-form-outbuf))
|
||||
(if (and doc-string-elt (stringp (nth doc-string-elt form)))
|
||||
;; We need to hack the printing because the
|
||||
@ -356,7 +356,7 @@ not be relied upon."
|
||||
"Insert the section-header line,
|
||||
which lists the file name and which functions are in it, etc."
|
||||
(insert generate-autoload-section-header)
|
||||
(prin1 (list 'autoloads autoloads load-name file time)
|
||||
(prin1 `(autoloads ,autoloads ,load-name ,file ,time)
|
||||
outbuf)
|
||||
(terpri outbuf)
|
||||
;; Break that line at spaces, to avoid very long lines.
|
||||
|
||||
@ -249,8 +249,8 @@
|
||||
(let* ((name (car form))
|
||||
(localfn (cdr (assq name byte-compile-function-environment)))
|
||||
(fn (or localfn (and (fboundp name) (symbol-function name)))))
|
||||
(when (and (consp fn) (eq (car fn) 'autoload))
|
||||
(load (nth 1 fn))
|
||||
(when (autoloadp fn)
|
||||
(autoload-do-load fn)
|
||||
(setq fn (or (and (fboundp name) (symbol-function name))
|
||||
(cdr (assq name byte-compile-function-environment)))))
|
||||
(pcase fn
|
||||
@ -586,10 +586,11 @@
|
||||
(let (opt new)
|
||||
(if (and (consp form)
|
||||
(symbolp (car form))
|
||||
(or (and for-effect
|
||||
;; we don't have any of these yet, but we might.
|
||||
(setq opt (get (car form) 'byte-for-effect-optimizer)))
|
||||
(setq opt (get (car form) 'byte-optimizer)))
|
||||
(or ;; (and for-effect
|
||||
;; ;; We don't have any of these yet, but we might.
|
||||
;; (setq opt (get (car form)
|
||||
;; 'byte-for-effect-optimizer)))
|
||||
(setq opt (function-get (car form) 'byte-optimizer)))
|
||||
(not (eq form (setq new (funcall opt form)))))
|
||||
(progn
|
||||
;; (if (equal form new) (error "bogus optimizer -- %s" opt))
|
||||
|
||||
@ -1355,7 +1355,7 @@ extra args."
|
||||
nums sig min max)
|
||||
(when calls
|
||||
(when (and (symbolp name)
|
||||
(eq (get name 'byte-optimizer)
|
||||
(eq (function-get name 'byte-optimizer)
|
||||
'byte-compile-inline-expand))
|
||||
(byte-compile-warn "defsubst `%s' was used before it was defined"
|
||||
name))
|
||||
|
||||
@ -2420,8 +2420,8 @@ and then returning foo."
|
||||
(while (and (symbolp func)
|
||||
(not (setq handler (get func 'compiler-macro)))
|
||||
(fboundp func)
|
||||
(or (not (eq (car-safe (symbol-function func)) 'autoload))
|
||||
(load (nth 1 (symbol-function func)))))
|
||||
(or (not (autoloadp (symbol-function func)))
|
||||
(autoload-do-load (symbol-function func) func)))
|
||||
(setq func (symbol-function func)))
|
||||
(and handler
|
||||
(not (eq form (setq form (apply handler form (cdr form))))))))
|
||||
|
||||
@ -320,16 +320,7 @@
|
||||
))
|
||||
(let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
|
||||
(intern (format "cl-%s" fun)))))
|
||||
(defalias fun new)
|
||||
;; If `cl-foo' is declare inline, then make `foo' inline as well, and
|
||||
;; similarly. Same for edebug specifications, indent rules and
|
||||
;; doc-string position.
|
||||
;; FIXME: For most of them, we should instead follow aliases
|
||||
;; where applicable.
|
||||
(dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec
|
||||
lisp-indent-function))
|
||||
(if (get new prop)
|
||||
(put fun prop (get new prop))))))
|
||||
(defalias fun new)))
|
||||
|
||||
;;; Features provided a bit differently in Elisp.
|
||||
|
||||
|
||||
@ -805,9 +805,9 @@ Redefining FUNCTION also cancels it."
|
||||
,(interactive-form (symbol-function function))
|
||||
(apply ',(symbol-function function)
|
||||
debug-on-entry-args)))
|
||||
(when (eq (car-safe (symbol-function function)) 'autoload)
|
||||
(when (autoloadp (symbol-function function))
|
||||
;; The function is autoloaded. Load its real definition.
|
||||
(load (cadr (symbol-function function)) nil noninteractive nil t))
|
||||
(autoload-do-load (symbol-function function) function))
|
||||
(when (or (not (consp (symbol-function function)))
|
||||
(and (eq (car (symbol-function function)) 'macro)
|
||||
(not (consp (cdr (symbol-function function))))))
|
||||
|
||||
@ -80,14 +80,10 @@ redefine OBJECT if it is a symbol."
|
||||
obj (symbol-function obj)))
|
||||
(if (subrp obj)
|
||||
(error "Can't disassemble #<subr %s>" name))
|
||||
(when (and (listp obj) (eq (car obj) 'autoload))
|
||||
(load (nth 1 obj))
|
||||
(setq obj (symbol-function name)))
|
||||
(if (eq (car-safe obj) 'macro) ;handle macros
|
||||
(setq obj (autoload-do-load obj name))
|
||||
(if (eq (car-safe obj) 'macro) ;Handle macros.
|
||||
(setq macro t
|
||||
obj (cdr obj)))
|
||||
(when (and (listp obj) (eq (car obj) 'closure))
|
||||
(error "Don't know how to compile an interpreted closure"))
|
||||
(if (and (listp obj) (eq (car obj) 'byte-code))
|
||||
(setq obj (list 'lambda nil obj)))
|
||||
(if (and (listp obj) (not (eq (car obj) 'lambda)))
|
||||
|
||||
@ -242,10 +242,13 @@ If the result is non-nil, then break. Errors are ignored."
|
||||
|
||||
(defun get-edebug-spec (symbol)
|
||||
;; Get the spec of symbol resolving all indirection.
|
||||
(let ((edebug-form-spec (get symbol 'edebug-form-spec))
|
||||
indirect)
|
||||
(while (and (symbolp edebug-form-spec)
|
||||
(setq indirect (get edebug-form-spec 'edebug-form-spec)))
|
||||
(let ((edebug-form-spec nil)
|
||||
(indirect symbol))
|
||||
(while
|
||||
(progn
|
||||
(and (symbolp indirect)
|
||||
(setq indirect
|
||||
(function-get indirect 'edebug-form-spec 'autoload))))
|
||||
;; (edebug-trace "indirection: %s" edebug-form-spec)
|
||||
(setq edebug-form-spec indirect))
|
||||
edebug-form-spec
|
||||
@ -263,7 +266,7 @@ An extant spec symbol is a symbol that is not a function and has a
|
||||
(setq spec (cdr spec)))
|
||||
t))
|
||||
((symbolp spec)
|
||||
(unless (functionp spec) (get spec 'edebug-form-spec)))))
|
||||
(unless (functionp spec) (function-get spec 'edebug-form-spec)))))
|
||||
|
||||
;;; Utilities
|
||||
|
||||
|
||||
@ -258,7 +258,7 @@ FUNSYM must be a symbol of a defined function."
|
||||
;; the autoload here, since that could have side effects, and
|
||||
;; elp-instrument-function is similar (in my mind) to defun-ish
|
||||
;; type functionality (i.e. it shouldn't execute the function).
|
||||
(and (eq (car-safe funguts) 'autoload)
|
||||
(and (autoloadp funguts)
|
||||
(error "ELP cannot profile autoloaded function: %s" funsym))
|
||||
;; We cannot profile functions used internally during profiling.
|
||||
(unless (elp-profilable-p funsym)
|
||||
|
||||
@ -347,8 +347,7 @@ in `load-path'."
|
||||
(if aliases
|
||||
(message "%s" aliases))
|
||||
(let ((library
|
||||
(cond ((eq (car-safe def) 'autoload)
|
||||
(nth 1 def))
|
||||
(cond ((autoloadp def) (nth 1 def))
|
||||
((subrp def)
|
||||
(if lisp-only
|
||||
(error "%s is a built-in function" function))
|
||||
|
||||
@ -84,14 +84,7 @@ DO must return an Elisp expression."
|
||||
(if (symbolp place)
|
||||
(funcall do place (lambda (v) `(setq ,place ,v)))
|
||||
(let* ((head (car place))
|
||||
(gf (get head 'gv-expander)))
|
||||
;; Autoload the head, if applicable, since that might define
|
||||
;; `gv-expander'.
|
||||
(when (and (null gf) (fboundp head)
|
||||
(eq 'autoload (car-safe (symbol-function head))))
|
||||
(with-demoted-errors
|
||||
(load (nth 1 (symbol-function head)) 'noerror 'nomsg)
|
||||
(setq gf (get head 'gv-expander))))
|
||||
(gf (function-get head 'gv-expander 'autoload)))
|
||||
(if gf (apply gf do (cdr place))
|
||||
(let ((me (macroexpand place ;FIXME: expand one step at a time!
|
||||
;; (append macroexpand-all-environment
|
||||
|
||||
@ -158,7 +158,8 @@ It has `lisp-mode-abbrev-table' as its parent."
|
||||
(goto-char listbeg)
|
||||
(and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
|
||||
(match-string 1)))))
|
||||
(docelt (and firstsym (get (intern-soft firstsym)
|
||||
(docelt (and firstsym
|
||||
(function-get (intern-soft firstsym)
|
||||
lisp-doc-string-elt-property))))
|
||||
(if (and docelt
|
||||
;; It's a string in a form that can have a docstring.
|
||||
@ -1135,7 +1136,8 @@ Lisp function does not specify a special indentation."
|
||||
(let ((function (buffer-substring (point)
|
||||
(progn (forward-sexp 1) (point))))
|
||||
method)
|
||||
(setq method (or (get (intern-soft function) 'lisp-indent-function)
|
||||
(setq method (or (function-get (intern-soft function)
|
||||
'lisp-indent-function)
|
||||
(get (intern-soft function) 'lisp-indent-hook)))
|
||||
(cond ((or (eq method 'defun)
|
||||
(and (null method)
|
||||
|
||||
@ -185,12 +185,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
||||
;; Macro expand compiler macros. This cannot be delayed to
|
||||
;; byte-optimize-form because the output of the compiler-macro can
|
||||
;; use macros.
|
||||
(let ((handler nil))
|
||||
(while (and (symbolp func)
|
||||
(not (setq handler (get func 'compiler-macro)))
|
||||
(fboundp func))
|
||||
;; Follow the sequence of aliases.
|
||||
(setq func (symbol-function func)))
|
||||
(let ((handler (function-get func 'compiler-macro)))
|
||||
(if (null handler)
|
||||
;; No compiler macro. We just expand each argument (for
|
||||
;; setq/setq-default this works alright because the variable names
|
||||
@ -198,12 +193,9 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
||||
(macroexp--all-forms form 1)
|
||||
;; If the handler is not loaded yet, try (auto)loading the
|
||||
;; function itself, which may in turn load the handler.
|
||||
(when (and (not (functionp handler))
|
||||
(fboundp func) (eq (car-safe (symbol-function func))
|
||||
'autoload))
|
||||
(unless (functionp handler)
|
||||
(ignore-errors
|
||||
(load (nth 1 (symbol-function func))
|
||||
'noerror 'nomsg)))
|
||||
(autoload-do-load (indirect-function func) func)))
|
||||
(let ((newform (macroexp--compiler-macro handler form)))
|
||||
(if (eq form newform)
|
||||
;; The compiler macro did not find anything to do.
|
||||
|
||||
@ -114,7 +114,8 @@ QPatterns for vectors are not implemented yet.
|
||||
|
||||
PRED can take the form
|
||||
FUNCTION in which case it gets called with one argument.
|
||||
(FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
|
||||
(FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
|
||||
which is the value being matched.
|
||||
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
|
||||
PRED patterns can refer to variables bound earlier in the pattern.
|
||||
E.g. you can match pairs where the cdr is larger than the car with a pattern
|
||||
|
||||
@ -150,7 +150,7 @@ the same names as used in the original source code, when possible."
|
||||
arglist)))
|
||||
(unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
|
||||
(nreverse arglist))))
|
||||
((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
|
||||
((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
|
||||
"[Arg list not available until function definition is loaded.]")
|
||||
(t t)))
|
||||
|
||||
@ -288,7 +288,7 @@ defined. If several such files exist, preference is given to a file
|
||||
found via `load-path'. The return value can also be `C-source', which
|
||||
means that OBJECT is a function or variable defined in C. If no
|
||||
suitable file is found, return nil."
|
||||
(let* ((autoloaded (eq (car-safe type) 'autoload))
|
||||
(let* ((autoloaded (autoloadp type))
|
||||
(file-name (or (and autoloaded (nth 1 type))
|
||||
(symbol-file
|
||||
object (if (memq type (list 'defvar 'defface))
|
||||
@ -468,7 +468,7 @@ FILE is the file where FUNCTION was probably defined."
|
||||
(concat beg "Lisp macro"))
|
||||
((eq (car-safe def) 'closure)
|
||||
(concat beg "Lisp closure"))
|
||||
((eq (car-safe def) 'autoload)
|
||||
((autoloadp def)
|
||||
(format "%s autoloaded %s"
|
||||
(if (commandp def) "an interactive" "an")
|
||||
(if (eq (nth 4 def) 'keymap) "keymap"
|
||||
@ -563,7 +563,7 @@ FILE is the file where FUNCTION was probably defined."
|
||||
;; If the function is autoloaded, and its docstring has
|
||||
;; key substitution constructs, load the library.
|
||||
(doc (progn
|
||||
(and (eq (car-safe real-def) 'autoload)
|
||||
(and (autoloadp real-def)
|
||||
help-enable-auto-load
|
||||
(string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
|
||||
doc-raw)
|
||||
|
||||
@ -1864,9 +1864,7 @@ of the special mode functions."
|
||||
;; If it is autoloaded, we need to load it now so that
|
||||
;; we have access to the variable -speedbar-menu-items.
|
||||
;; Is this XEmacs safe?
|
||||
(let ((sf (symbol-function v)))
|
||||
(if (and (listp sf) (eq (car sf) 'autoload))
|
||||
(load-library (car (cdr sf)))))
|
||||
(autoload-do-load (symbol-function v) v)
|
||||
(setq speedbar-special-mode-expansion-list (list v))
|
||||
(setq v (intern-soft (concat ms "-speedbar-key-map")))
|
||||
(if (not v)
|
||||
|
||||
33
lisp/subr.el
33
lisp/subr.el
@ -1691,6 +1691,23 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
|
||||
|
||||
;;; Load history
|
||||
|
||||
(defsubst autoloadp (object)
|
||||
"Non-nil if OBJECT is an autoload."
|
||||
(eq 'autoload (car-safe object)))
|
||||
|
||||
;; (defun autoload-type (object)
|
||||
;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
|
||||
;; OBJECT should be an autoload object."
|
||||
;; (when (autoloadp object)
|
||||
;; (let ((type (nth 3 object)))
|
||||
;; (cond ((null type) (if (nth 2 object) 'command 'function))
|
||||
;; ((eq 'keymap t) 'macro)
|
||||
;; (type)))))
|
||||
|
||||
;; (defalias 'autoload-file #'cadr
|
||||
;; "Return the name of the file from which AUTOLOAD will be loaded.
|
||||
;; \n\(fn AUTOLOAD)")
|
||||
|
||||
(defun symbol-file (symbol &optional type)
|
||||
"Return the name of the file that defined SYMBOL.
|
||||
The value is normally an absolute file name. It can also be nil,
|
||||
@ -1703,7 +1720,7 @@ TYPE is `defun', `defvar', or `defface', that specifies function
|
||||
definition, variable definition, or face definition only."
|
||||
(if (and (or (null type) (eq type 'defun))
|
||||
(symbolp symbol) (fboundp symbol)
|
||||
(eq 'autoload (car-safe (symbol-function symbol))))
|
||||
(autoloadp (symbol-function symbol)))
|
||||
(nth 1 (symbol-function symbol))
|
||||
(let ((files load-history)
|
||||
file)
|
||||
@ -2752,6 +2769,20 @@ computing the hash. If BINARY is non-nil, return a string in binary
|
||||
form."
|
||||
(secure-hash 'sha1 object start end binary))
|
||||
|
||||
(defun function-get (f prop &optional autoload)
|
||||
"Return the value of property PROP of function F.
|
||||
If AUTOLOAD is non-nil and F is an autoloaded macro, try to autoload
|
||||
the macro in the hope that it will set PROP."
|
||||
(let ((val nil))
|
||||
(while (and (symbolp f)
|
||||
(null (setq val (get f prop)))
|
||||
(fboundp f))
|
||||
(let ((fundef (symbol-function f)))
|
||||
(if (and autoload (autoloadp fundef)
|
||||
(not (equal fundef (autoload-do-load fundef f 'macro))))
|
||||
nil ;Re-try `get' on the same `f'.
|
||||
(setq f fundef))))
|
||||
val))
|
||||
|
||||
;;;; Support for yanking and text properties.
|
||||
|
||||
|
||||
@ -1,3 +1,8 @@
|
||||
2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp,
|
||||
add argument, tune behavior, and adjust all callers.
|
||||
|
||||
2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
Use typedef for EMACS_INT, EMACS_UINT.
|
||||
|
||||
@ -761,7 +761,7 @@ Value, if non-nil, is a list \(interactive SPEC). */)
|
||||
{
|
||||
struct gcpro gcpro1;
|
||||
GCPRO1 (cmd);
|
||||
do_autoload (fun, cmd);
|
||||
Fautoload_do_load (fun, cmd, Qnil);
|
||||
UNGCPRO;
|
||||
return Finteractive_form (cmd);
|
||||
}
|
||||
@ -2059,7 +2059,7 @@ function chain of symbols. */)
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
/* Extract and set vector and string elements */
|
||||
/* Extract and set vector and string elements. */
|
||||
|
||||
DEFUN ("aref", Faref, Saref, 2, 2, 0,
|
||||
doc: /* Return the element of ARRAY at index IDX.
|
||||
|
||||
78
src/eval.c
78
src/eval.c
@ -988,26 +988,14 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
|
||||
{
|
||||
/* SYM is not mentioned in ENVIRONMENT.
|
||||
Look at its function definition. */
|
||||
struct gcpro gcpro1;
|
||||
GCPRO1 (form);
|
||||
def = Fautoload_do_load (def, sym, Qmacro);
|
||||
UNGCPRO;
|
||||
if (EQ (def, Qunbound) || !CONSP (def))
|
||||
/* Not defined or definition not suitable. */
|
||||
break;
|
||||
if (EQ (XCAR (def), Qautoload))
|
||||
{
|
||||
/* Autoloading function: will it be a macro when loaded? */
|
||||
tem = Fnth (make_number (4), def);
|
||||
if (EQ (tem, Qt) || EQ (tem, Qmacro))
|
||||
/* Yes, load it and try again. */
|
||||
{
|
||||
struct gcpro gcpro1;
|
||||
GCPRO1 (form);
|
||||
do_autoload (def, sym);
|
||||
UNGCPRO;
|
||||
continue;
|
||||
}
|
||||
else
|
||||
break;
|
||||
}
|
||||
else if (!EQ (XCAR (def), Qmacro))
|
||||
if (!EQ (XCAR (def), Qmacro))
|
||||
break;
|
||||
else expander = XCDR (def);
|
||||
}
|
||||
@ -1952,22 +1940,35 @@ un_autoload (Lisp_Object oldqueue)
|
||||
FUNNAME is the symbol which is the function's name.
|
||||
FUNDEF is the autoload definition (a list). */
|
||||
|
||||
void
|
||||
do_autoload (Lisp_Object fundef, Lisp_Object funname)
|
||||
DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
|
||||
doc: /* Load FUNDEF which should be an autoload.
|
||||
If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
|
||||
in which case the function returns the new autoloaded function value.
|
||||
If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
|
||||
it is defines a macro. */)
|
||||
(Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
|
||||
{
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
Lisp_Object fun;
|
||||
struct gcpro gcpro1, gcpro2, gcpro3;
|
||||
|
||||
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
|
||||
return fundef;
|
||||
|
||||
if (EQ (macro_only, Qmacro))
|
||||
{
|
||||
Lisp_Object kind = Fnth (make_number (4), fundef);
|
||||
if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
|
||||
return fundef;
|
||||
}
|
||||
|
||||
/* This is to make sure that loadup.el gives a clear picture
|
||||
of what files are preloaded and when. */
|
||||
if (! NILP (Vpurify_flag))
|
||||
error ("Attempt to autoload %s while preparing to dump",
|
||||
SDATA (SYMBOL_NAME (funname)));
|
||||
|
||||
fun = funname;
|
||||
CHECK_SYMBOL (funname);
|
||||
GCPRO3 (fun, funname, fundef);
|
||||
GCPRO3 (funname, fundef, macro_only);
|
||||
|
||||
/* Preserve the match data. */
|
||||
record_unwind_save_match_data ();
|
||||
@ -1982,18 +1983,28 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname)
|
||||
The value saved here is to be restored into Vautoload_queue. */
|
||||
record_unwind_protect (un_autoload, Vautoload_queue);
|
||||
Vautoload_queue = Qt;
|
||||
Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
|
||||
/* If `macro_only', assume this autoload to be a "best-effort",
|
||||
so don't signal an error if autoloading fails. */
|
||||
Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
|
||||
|
||||
/* Once loading finishes, don't undo it. */
|
||||
Vautoload_queue = Qt;
|
||||
unbind_to (count, Qnil);
|
||||
|
||||
fun = Findirect_function (fun, Qnil);
|
||||
|
||||
if (!NILP (Fequal (fun, fundef)))
|
||||
error ("Autoloading failed to define function %s",
|
||||
SDATA (SYMBOL_NAME (funname)));
|
||||
UNGCPRO;
|
||||
|
||||
if (NILP (funname))
|
||||
return Qnil;
|
||||
else
|
||||
{
|
||||
Lisp_Object fun = Findirect_function (funname, Qnil);
|
||||
|
||||
if (!NILP (Fequal (fun, fundef)))
|
||||
error ("Autoloading failed to define function %s",
|
||||
SDATA (SYMBOL_NAME (funname)));
|
||||
else
|
||||
return fun;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -2200,7 +2211,7 @@ eval_sub (Lisp_Object form)
|
||||
xsignal1 (Qinvalid_function, original_fun);
|
||||
if (EQ (funcar, Qautoload))
|
||||
{
|
||||
do_autoload (fun, original_fun);
|
||||
Fautoload_do_load (fun, original_fun, Qnil);
|
||||
goto retry;
|
||||
}
|
||||
if (EQ (funcar, Qmacro))
|
||||
@ -2729,7 +2740,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
|
||||
ptrdiff_t i;
|
||||
|
||||
QUIT;
|
||||
maybe_gc ();
|
||||
|
||||
if (++lisp_eval_depth > max_lisp_eval_depth)
|
||||
{
|
||||
@ -2742,10 +2752,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
|
||||
backtrace.next = backtrace_list;
|
||||
backtrace_list = &backtrace;
|
||||
backtrace.function = &args[0];
|
||||
backtrace.args = &args[1];
|
||||
backtrace.args = &args[1]; /* This also GCPROs them. */
|
||||
backtrace.nargs = nargs - 1;
|
||||
backtrace.debug_on_exit = 0;
|
||||
|
||||
/* Call GC after setting up the backtrace, so the latter GCPROs the args. */
|
||||
maybe_gc ();
|
||||
|
||||
if (debug_on_next_call)
|
||||
do_debug_on_call (Qlambda);
|
||||
|
||||
@ -2857,7 +2870,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
|
||||
val = funcall_lambda (fun, numargs, args + 1);
|
||||
else if (EQ (funcar, Qautoload))
|
||||
{
|
||||
do_autoload (fun, original_fun);
|
||||
Fautoload_do_load (fun, original_fun, Qnil);
|
||||
CHECK_CONS_LIST ();
|
||||
goto retry;
|
||||
}
|
||||
@ -3582,6 +3595,7 @@ alist of active lexical bindings. */);
|
||||
defsubr (&Scalled_interactively_p);
|
||||
defsubr (&Scommandp);
|
||||
defsubr (&Sautoload);
|
||||
defsubr (&Sautoload_do_load);
|
||||
defsubr (&Seval);
|
||||
defsubr (&Sapply);
|
||||
defsubr (&Sfuncall);
|
||||
|
||||
@ -8827,18 +8827,12 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
|
||||
|
||||
next = access_keymap (map, key, 1, 0, 1);
|
||||
|
||||
/* Handle symbol with autoload definition. */
|
||||
if (SYMBOLP (next) && !NILP (Ffboundp (next))
|
||||
&& CONSP (XSYMBOL (next)->function)
|
||||
&& EQ (XCAR (XSYMBOL (next)->function), Qautoload))
|
||||
do_autoload (XSYMBOL (next)->function, next);
|
||||
|
||||
/* Handle a symbol whose function definition is a keymap
|
||||
or an array. */
|
||||
if (SYMBOLP (next) && !NILP (Ffboundp (next))
|
||||
&& (ARRAYP (XSYMBOL (next)->function)
|
||||
|| KEYMAPP (XSYMBOL (next)->function)))
|
||||
next = XSYMBOL (next)->function;
|
||||
next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
|
||||
|
||||
/* If the keymap gives a function, not an
|
||||
array, then call the function with one arg and use
|
||||
@ -10282,7 +10276,7 @@ a special event, so ignore the prefix argument and don't clear it. */)
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
|
||||
GCPRO2 (cmd, prefixarg);
|
||||
do_autoload (final, cmd);
|
||||
Fautoload_do_load (final, cmd, Qnil);
|
||||
UNGCPRO;
|
||||
}
|
||||
else
|
||||
|
||||
@ -225,7 +225,7 @@ when reading a key-sequence to be looked-up in this keymap. */)
|
||||
Fdefine_key should cause keymaps to be autoloaded.
|
||||
|
||||
This function can GC when AUTOLOAD is non-zero, because it calls
|
||||
do_autoload which can GC. */
|
||||
Fautoload_do_load which can GC. */
|
||||
|
||||
Lisp_Object
|
||||
get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
|
||||
@ -259,7 +259,7 @@ get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
|
||||
GCPRO2 (tem, object);
|
||||
do_autoload (tem, object);
|
||||
Fautoload_do_load (tem, object, Qnil);
|
||||
UNGCPRO;
|
||||
|
||||
goto autoload_retry;
|
||||
|
||||
@ -2822,7 +2822,6 @@ extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
|
||||
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
|
||||
extern _Noreturn void verror (const char *, va_list)
|
||||
ATTRIBUTE_FORMAT_PRINTF (1, 0);
|
||||
extern void do_autoload (Lisp_Object, Lisp_Object);
|
||||
extern Lisp_Object un_autoload (Lisp_Object);
|
||||
extern void init_eval_once (void);
|
||||
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object *);
|
||||
@ -2834,7 +2833,7 @@ extern void mark_backtrace (void);
|
||||
#endif
|
||||
extern void syms_of_eval (void);
|
||||
|
||||
/* Defined in editfns.c */
|
||||
/* Defined in editfns.c. */
|
||||
extern Lisp_Object Qfield;
|
||||
extern void insert1 (Lisp_Object);
|
||||
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
|
||||
@ -2851,7 +2850,7 @@ const char *get_system_name (void);
|
||||
extern void syms_of_editfns (void);
|
||||
extern void set_time_zone_rule (const char *);
|
||||
|
||||
/* Defined in buffer.c */
|
||||
/* Defined in buffer.c. */
|
||||
extern int mouse_face_overlay_overlaps (Lisp_Object);
|
||||
extern _Noreturn void nsberror (Lisp_Object);
|
||||
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
|
||||
@ -2870,7 +2869,7 @@ extern void init_buffer (void);
|
||||
extern void syms_of_buffer (void);
|
||||
extern void keys_of_buffer (void);
|
||||
|
||||
/* Defined in marker.c */
|
||||
/* Defined in marker.c. */
|
||||
|
||||
extern ptrdiff_t marker_position (Lisp_Object);
|
||||
extern ptrdiff_t marker_byte_position (Lisp_Object);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user