]> git.eshelyaron.com Git - emacs.git/commitdiff
Autoload more carefully from Lisp. Follow aliases for function properties.
authorStefan Monnier <monnier@iro.umontreal.ca>
Thu, 26 Jul 2012 01:27:33 +0000 (21:27 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Thu, 26 Jul 2012 01:27:33 +0000 (21:27 -0400)
* 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.

29 files changed:
etc/NEWS
lisp/ChangeLog
lisp/apropos.el
lisp/calc/calc.el
lisp/desktop.el
lisp/emacs-lisp/advice.el
lisp/emacs-lisp/autoload.el
lisp/emacs-lisp/byte-opt.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/cl-macs.el
lisp/emacs-lisp/cl.el
lisp/emacs-lisp/debug.el
lisp/emacs-lisp/disass.el
lisp/emacs-lisp/edebug.el
lisp/emacs-lisp/elp.el
lisp/emacs-lisp/find-func.el
lisp/emacs-lisp/gv.el
lisp/emacs-lisp/lisp-mode.el
lisp/emacs-lisp/macroexp.el
lisp/emacs-lisp/pcase.el
lisp/help-fns.el
lisp/speedbar.el
lisp/subr.el
src/ChangeLog
src/data.c
src/eval.c
src/keyboard.c
src/keymap.c
src/lisp.h

index 0f903c790c2663875c4d98b86529f0215da4c9f1..ce44a530e26a7fd0cba2086407ad88ee48c4be76 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -498,6 +498,10 @@ still be supported for Emacs 24.x.
 \f
 * 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.
 
index 1d4baa8b054d4177a97bccbd763efdea6282cac5..40cded6f9cc20fad3ee9fe04d9e008f00826422f 100644 (file)
@@ -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
index e1c3e06752dbde87ccca4eb1db1d0d1cf48aaa75..6c6e3b325e808541c70b9efb20cb720192c6baaa 100644 (file)
@@ -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))))))
 
index 4d64209dd3607ec19c55b000dfc9e9d885f74b49..7fb9148535a3a171377d9487453deb5334f4b729 100644 (file)
@@ -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))
 
index 2c2106e18b7ffbbe11f50b97fb724d56f8de1731..a873a6b63bf52fea87219812895043c1815fb43f 100644 (file)
@@ -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, ...;
index 09dde2c1c17585a0c16d08fbe0652560ff13c739..cac76d2bce1aa0b999d5338d9ab82636f1f909e6 100644 (file)
@@ -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:
index 1bdd6d8fc4be1e51d1ee806bbdceeef8d01387ae..3fc185dda25b76dfbaea426bda590f99477da197 100644 (file)
@@ -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.
index 5a3fd7dddb1236ed39d0eb873176ddd94ab0c81b..a4c3e8aac4e2d5ea629146606a243aa2cd0f1148 100644 (file)
   (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
   (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))
index 97d7ab924edb25a6aa854bb049fc9fdb9d850b62..e5df8dd112c2990f5fd3ad4488a5c33736ccac16 100644 (file)
@@ -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))
index 70d907a14c1354c9a50f213f587472630ac4d43d..00ba6b9e0d00fd4d2830f9288109fff0c48bb3f4 100644 (file)
@@ -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))))))))
index 32cf1670744578e04f9c4bf96f507cbc0bae3769..8174de786c7789c52f6d105b331f736deeab136d 100644 (file)
                ))
   (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.
 
index b0813aebef688c59f921a629af413bb013394d65..7bc93a19d1aa0048f57192664684156722b75c31 100644 (file)
@@ -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))))))
index ba720b42868972da37ada9b9e3d32b5fe92fdd09..206166bc77a52bf1f3590aaf0f01c8650c52ba1e 100644 (file)
@@ -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)))
index c1c65b6f66188aacb2d454b725f5fef78507fc75..bbf0757c3bc209bd43b85fe8ea8e79c11e4710ac 100644 (file)
@@ -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
 
index 08390327414f8bf603e39dd90770f7aa6cc4aa74..b94817cdb02c631e0174e63a6e060daf94034c34 100644 (file)
@@ -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)
index d64281d0e81aa2b55651572d63810567de67287c..e1e153d9117cb5809502da70a72aed9638a59dea 100644 (file)
@@ -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))
index eb0e64e22b8762cae75ce60d759a367e40b1db08..d1f997c99c4064c1e992e958513f16634980d6fd 100644 (file)
@@ -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
index 350b0bd949d5adba7082dbecb2bea376fd7cbc92..e29407f5a8b862b59bad51ebabfb005540d0f904 100644 (file)
@@ -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)
index 65a72aa5312aa1c1144941acd90c03b856108c51..70eab14983738e8356d08007b66d0d398c43f412 100644 (file)
@@ -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.
index 3f4ce605cb0a0760dc0e4a53d323dac215fd5978..4aeed7e4d0ec08a6c24f4927a54ce6e960b86322 100644 (file)
@@ -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
index 2e56da0bcaa67223ada809e815e580bd36675ae7..f585bff871f19f28dd33d94fa9a52c71db72aabe 100644 (file)
@@ -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)
index d8c8c4a56bec7f111302adb6f65a610d9ebbdd03..16993ce1891df641480ee4db6315a9f80bdd6d1d 100644 (file)
@@ -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)
index 882ad3cd23d3d4edc0e93ef634cd5c43e9680717..76fec5dd5ac522b20b12f9d5bb4399113293c636 100644 (file)
@@ -1691,6 +1691,23 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
 \f
 ;;; 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))
 \f
 ;;;; Support for yanking and text properties.
 
index 88c90dd84d8e54ce3c42004f50d596c40f1ddb7d..eb74f4589424c8b91f2dcc41a7351868f2f57140 100644 (file)
@@ -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.
index 110e8ae41ab8f8d80952a6e4149f2d340ba8a0ac..b23bcbe15b379950a02073888299a0369ab3efc5 100644 (file)
@@ -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;
 }
 \f
-/* 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.
index a0143c372dea0b0077f174d176ebafbfd164dcd8..a0a05ebf0dc0cbd733ca0cc76f4ce932cd6fd847 100644 (file)
@@ -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;
+    }
 }
 
 \f
@@ -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);
index 0c03a2143d824a7708a55dd639a6aaa18846dfb3..1f6c47eaf7930204cfe761ccb2aa33b35274e26c 100644 (file)
@@ -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
index 510c5ea7f3e2b378dbbd0dce324d3fcf493051c5..feaf0cfd9619d128ebd9fe3c437cb33b46d87b09 100644 (file)
@@ -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;
index e4eb8ce5084393e8197331ebd52da0c9cba63389..d93055557787dd845d2c76a01c218a374ef0ce7b 100644 (file)
@@ -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);