-;; autoload.el --- maintain autoloads in loaddefs.el
+;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2012 Free Software Foundation, Inc.
(defvar autoload-modified-buffers) ;Dynamically scoped var.
-(defun make-autoload (form file)
+(defun make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
-or macro definition or a defcustom)."
+or macro definition or a defcustom).
+If EXPANSION is non-nil, we're processing the macro expansion of an
+expression, in which case we want to handle forms differently."
(let ((car (car-safe form)) expand)
(cond
+ ((and expansion (eq car 'defalias))
+ (pcase-let*
+ ((`(,_ ,_ ,arg . ,rest) form)
+ ;; `type' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
+ (and (let fun arg) (let type nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
+ ;; `args' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,args . ,body)
+ (and (let args t) (let body t)))
+ lam)
+ ;; Get the `doc' from `body' or `rest'.
+ (doc (cond ((stringp (car-safe body)) (car body))
+ ((stringp (car-safe rest)) (car rest))))
+ ;; Look for an interactive spec.
+ (interactive (pcase body
+ ((or `((interactive . ,_) . ,_)
+ `(,_ (interactive . ,_) . ,_)) t))))
+ ;; 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)))
+ ;; (message "autoload of %S" (nth 1 form))
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+
+ ((and expansion (memq car '(progn prog1)))
+ (let ((end (memq :autoload-end form)))
+ (when end ;Cut-off anything after the :autoload-end marker.
+ (setq form (copy-sequence form))
+ (setcdr (memq :autoload-end form) nil))
+ (let ((exps (delq nil (mapcar (lambda (form)
+ (make-autoload form file expansion))
+ (cdr form)))))
+ (when exps (cons 'progn exps)))))
+
;; For complex cases, try again on the macro-expansion.
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
- define-globalized-minor-mode
+ define-globalized-minor-mode defun defmacro
+ ;; FIXME: we'd want `defmacro*' here as well, so as
+ ;; to handle its `declare', but when autoload is run
+ ;; CL is not loaded so macroexpand doesn't know how
+ ;; to expand it!
easy-mmode-define-minor-mode define-minor-mode))
(setq expand (let ((load-file-name file)) (macroexpand form)))
- (eq (car expand) 'progn)
- (memq :autoload-end expand))
- (let ((end (memq :autoload-end expand)))
- ;; Cut-off anything after the :autoload-end marker.
- (setcdr end nil)
- (cons 'progn
- (mapcar (lambda (form) (make-autoload form file))
- (cdr expand)))))
+ (memq (car expand) '(progn prog1 defalias)))
+ (make-autoload expand file 'expansion)) ;Recurse on the expansion.
;; For special function-like operators, use the `autoload' function.
- ((memq car '(defun define-skeleton defmacro define-derived-mode
+ ((memq car '(define-skeleton define-derived-mode
define-compilation-mode define-generic-mode
easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
(t)))
(body (nthcdr (get car 'doc-string-elt) form))
(doc (if (stringp (car body)) (pop body))))
- (when (listp args)
- ;; Add the usage form at the end where describe-function-1
- ;; can recover it.
- (setq doc (help-add-fundoc-usage doc args)))
- (let ((exp
- ;; `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))))
- (when macrop
- ;; Special case to autoload some of the macro's declarations.
- (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
- (exps '()))
- (when (eq (car-safe decls) 'declare)
- ;; FIXME: We'd like to reuse macro-declaration-function,
- ;; but we can't since it doesn't return anything.
- (dolist (decl decls)
- (case (car-safe decl)
- (indent
- (push `(put ',name 'lisp-indent-function ',(cadr decl))
- exps))
- (doc-string
- (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
- (when exps
- (setq exp `(progn ,exp ,@exps))))))
- exp)))
+ ;; 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))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file loads))))))
+ ;; When processing a macro expansion, any expression
+ ;; before a :autoload-end should be included. These are typically (put
+ ;; 'fun 'prop val) and things like that.
+ ((and expansion (consp form)) form)
+
;; nil here indicates that this is not a special autoload form.
(t nil))))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
- (condition-case err
+ (condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
write its autoloads into the specified file instead."
(interactive "DUpdate autoloads from directory: ")
(let* ((files-re (let ((tmp nil))
- (dolist (suf (get-load-suffixes)
- (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
- (unless (string-match "\\.elc" suf) (push suf tmp)))))
+ (dolist (suf (get-load-suffixes))
+ (unless (string-match "\\.elc" suf) (push suf tmp)))
+ (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply 'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
-;;; byte-run.el --- byte-compiler support for inlining
+;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-;; We define macro-declaration-function 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.
+;; `macro-declaration-function' are both obsolete (as marked at the end of this
+;; file) but used in many .elc files.
(defvar macro-declaration-function #'macro-declaration-function
"Function to process declarations in a macro definition.
(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.
+
+(defvar defun-declarations-alist
+ ;; FIXME: Should we also add an `obsolete' property?
+ (list
+ ;; Too bad we can't use backquote yet at this stage of the bootstrap.
+ (list 'advertised-calling-convention
+ #'(lambda (f arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+ (list 'doc-string
+ #'(lambda (f pos)
+ (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
+ (list 'indent
+ #'(lambda (f val)
+ (list 'put (list 'quote f)
+ ''lisp-indent-function (list 'quote val)))))
+ "List associating function properties to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a function's declaration,
+the FUN corresponding to PROP is called with the function name
+and the VALUES and should return the code to use to set this property.")
+
+(defvar macro-declarations-alist
+ (cons
+ (list 'debug
+ #'(lambda (name spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ defun-declarations-alist)
+ "List associating properties of macros to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a macro's declaration,
+the FUN corresponding to PROP is called with the function name
+and the VALUES and should return the code to use to set this property.")
+
(put 'defmacro 'doc-string-elt 3)
(defalias 'defmacro
(cons
the function (lambda ARGLIST BODY...) is applied to
the list ARGS... as it appears in the expression,
and the result should be a form to be evaluated instead of the original.
-
-DECL is a declaration, optional, which can specify how to indent
-calls to this macro, how Edebug should handle it, and which argument
-should be treated as documentation. It looks like this:
- (declare SPECS...)
-The elements can look like this:
- (indent INDENT)
- Set NAME's `lisp-indent-function' property to INDENT.
-
- (debug DEBUG)
- Set NAME's `edebug-form-spec' property to DEBUG. (This is
- equivalent to writing a `def-edebug-spec' for the macro.)
-
- (doc-string ELT)
- Set NAME's `doc-string-elt' property to ELT."
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `macro-declarations-alist'."
(if (stringp docstring) nil
(if decl (setq body (cons decl body)))
(setq decl docstring)
(let* ((fun (list 'function (cons 'lambda (cons arglist body))))
(def (list 'defalias
(list 'quote name)
- (list 'cons ''macro fun))))
- (if decl
- (list 'progn
- (list 'funcall 'macro-declaration-function
- (list 'quote name)
- (list 'quote decl))
- def)
+ (list 'cons ''macro fun)))
+ (declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) macro-declarations-alist))))
+ (if f (apply (car f) name (cdr x))
+ (message "Warning: Unknown macro property %S in %S"
+ (car x) name))))
+ (cdr decl))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
def)))))
;; Now that we defined defmacro we can use it!
(defmacro defun (name arglist &optional docstring &rest body)
"Define NAME as a function.
The definition is (lambda ARGLIST [DOCSTRING] BODY...).
-See also the function `interactive'."
+See also the function `interactive'.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `defun-declarations-alist'.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+ ;; We can't just have `decl' as an &optional argument, because we need
+ ;; to distinguish
+ ;; (defun foo (arg) (toto) nil)
+ ;; from
+ ;; (defun foo (arg) (toto)).
(declare (doc-string 3))
- (if docstring (setq body (cons docstring body))
- (if (null body) (setq body '(nil))))
- (list 'defalias
- (list 'quote name)
- (list 'function
- (cons 'lambda
- (cons arglist body)))))
+ (let ((decls (cond
+ ((eq (car-safe docstring) 'declare)
+ (prog1 (cdr docstring) (setq docstring nil)))
+ ((eq (car-safe (car body)) 'declare)
+ (prog1 (cdr (car body)) (setq body (cdr body)))))))
+ (if docstring (setq body (cons docstring body))
+ (if (null body) (setq body '(nil))))
+ (let ((declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name (cdr x)))
+ ;; Yuck!!
+ ((and (featurep 'cl)
+ (memq (car x) ;C.f. cl-do-proclaim.
+ '(special inline notinline optimize warn)))
+ (if (null (stringp docstring))
+ (push (list 'declare x) body)
+ (setcdr body (cons (list 'declare x) (cdr body))))
+ nil)
+ (t (message "Warning: Unknown defun property %S in %S"
+ (car x) name)))))
+ decls))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'function
+ (cons 'lambda
+ (cons arglist body))))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def))))
\f
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
;; (list 'put x ''byte-optimizer nil)))
;; fns)))
-;; This has a special byte-hunk-handler in bytecomp.el.
(defmacro defsubst (name arglist &rest body)
"Define an inline function. The syntax is just like that of `defun'."
(declare (debug defun) (doc-string 3))
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
-(defun set-advertised-calling-convention (function signature when)
+(defun set-advertised-calling-convention (function signature _when)
"Set the advertised SIGNATURE of FUNCTION.
This will allow the byte-compiler to warn the programmer when she uses
an obsolete calling convention. WHEN specifies since when the calling
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when) "23.1"))
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
\(make-obsolete 'old-fun 'new-fun \"22.1\")
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-function-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete-variable
- '(obsolete-name current-name when &optional access-type) "23.1")
+
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
'saved-value, 'saved-variable-comment."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
(null (get ,current-name prop))
(put ,current-name prop (get ,obsolete-name prop))))
(make-obsolete-variable ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-variable-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
;; FIXME This is only defined in this file because the variable- and
;; function- versions are too. Unlike those two, this one is not used
;; (file-format emacs19))"
;; nil)
+(make-obsolete-variable 'macro-declaration-function
+ 'macro-declarations-alist "24.2")
+(make-obsolete 'macro-declaration-function
+ 'macro-declarations-alist "24.2")
+
;;; byte-run.el ends here
HCoop / bpt / emacs.git / commitdiff