;;; bytecomp.el --- compilation of Lisp code into byte code
-;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
+;; 2003, 2004 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; `obsolete' (obsolete variables and functions)
;; `noruntime' (calls to functions only defined
;; within `eval-when-compile')
+;; `cl-warnings' (calls to CL functions)
+;; `interactive-only' (calls to commands that are
+;; not good to call from Lisp)
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
:type 'boolean)
(defconst byte-compile-warning-types
- '(redefine callargs free-vars unresolved obsolete noruntime cl-functions)
+ '(redefine callargs free-vars unresolved
+ obsolete noruntime cl-functions interactive-only)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
noruntime functions that may not be defined at runtime (typically
defined only under `eval-when-compile').
cl-functions calls to runtime functions from the CL package (as
- distinguished from macros and aliases)."
+ distinguished from macros and aliases).
+ interactive-only
+ commands that normally shouldn't be called from Lisp code."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
(const callargs) (const redefine)
- (const obsolete) (const noruntime) (const cl-functions))))
+ (const obsolete) (const noruntime)
+ (const cl-functions) (const interactive-only))))
+
+(defvar byte-compile-interactive-only-functions
+ '(beginning-of-buffer end-of-buffer replace-string replace-regexp
+ insert-file)
+ "List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-var nil
"If non-nil, this is a variable that shouldn't be reported as obsolete.")
"Alist of functions defined in the file being compiled.
This is so we can inline them when necessary.
Each element looks like (FUNCTIONNAME . DEFINITION). It is
-\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
+\(FUNCTIONNAME . nil) when a function is redefined as a macro.
+It is \(FUNCTIONNAME . t) when all we know is that it was defined,
+and we don't know the definition.")
(defvar byte-compile-unresolved-functions nil
"Alist of undefined functions to which calls have been compiled.
(when byte-compile-read-position
(let (last entry)
(while (progn
- (setq last byte-compile-last-position
- entry (assq sym read-symbol-positions-list))
- (when entry
- (setq byte-compile-last-position
- (+ byte-compile-read-position (cdr entry))
- read-symbol-positions-list
- (byte-compile-delete-first
- entry read-symbol-positions-list)))
+ (setq last byte-compile-last-position
+ entry (assq sym read-symbol-positions-list))
+ (when entry
+ (setq byte-compile-last-position
+ (+ byte-compile-read-position (cdr entry))
+ read-symbol-positions-list
+ (byte-compile-delete-first
+ entry read-symbol-positions-list)))
(or (and allow-previous (not (= last byte-compile-last-position)))
(> last byte-compile-last-position)))))))
\f
;;; sanity-checking arglists
+;; If a function has an entry saying (FUNCTION . t).
+;; that means we know it is defined but we don't know how.
+;; If a function has an entry saying (FUNCTION . nil),
+;; that means treat it as not defined.
(defun byte-compile-fdefinition (name macro-p)
(let* ((list (if macro-p
byte-compile-macro-environment
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
- (sig (if def
+ (sig (if (and def (not (eq def t)))
(byte-compile-arglist-signature
(if (eq 'lambda (car-safe def))
(nth 1 def)
(byte-compile-format-warn form)
;; Check to see if the function will be available at runtime
;; and/or remember its arity if it's unknown.
- (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
+ (or (and (or def (fboundp (car form))) ; might be a subr or autoload.
(not (memq (car form) byte-compile-noruntime-functions)))
(eq (car form) byte-compile-current-form) ; ## this doesn't work
; with recursion.
(if cons
(or (memq n (cdr cons))
(setcdr cons (cons n (cdr cons))))
- (setq byte-compile-unresolved-functions
- (cons (list (car form) n)
- byte-compile-unresolved-functions)))))))
+ (push (list (car form) n)
+ byte-compile-unresolved-functions))))))
(defun byte-compile-format-warn (form)
"Warn if FORM is `format'-like with inconsistent args.
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
(let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
- (if old
+ (if (and old (not (eq old t)))
(let ((sig1 (byte-compile-arglist-signature
(if (eq 'lambda (car-safe old))
(nth 1 old)
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
(symbolp (nth 1 (nth 1 form))))
- (add-to-list 'byte-compile-function-environment
- (cons (nth 1 (nth 1 form))
- (cons 'autoload (cdr (cdr form))))))
+ (push (cons (nth 1 (nth 1 form))
+ (cons 'autoload (cdr (cdr form))))
+ byte-compile-function-environment))
(if (stringp (nth 3 form))
form
;; No doc string, so we can compile this as a normal form.
(let ((old-load-list current-load-list)
(args (mapcar 'eval (cdr form))))
(apply 'require args)
- ;; Detech (require 'cl) in a way that works even if cl is already loaded.
+ ;; Detect (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))
(setq byte-compile-warnings
(remq 'cl-functions byte-compile-warnings))))
(defun byte-compile-form (form &optional for-effect)
(setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
- (when (symbolp form)
- (byte-compile-set-symbol-position form))
(cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
+ (when (symbolp form)
+ (byte-compile-set-symbol-position form))
(byte-compile-constant form))
((and for-effect byte-compile-delete-errors)
+ (when (symbolp form)
+ (byte-compile-set-symbol-position form))
(setq for-effect nil))
(t (byte-compile-variable-ref 'byte-varref form))))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (byte-compile-set-symbol-position fn)
(when (byte-compile-const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
+ (and (memq 'interactive-only byte-compile-warnings)
+ (memq (car form) byte-compile-interactive-only-functions)
+ (byte-compile-warn "`%s' used from Lisp code\n\
+That command is designed for interactive use only" fn))
(if (and handler
(or (not (byte-compile-version-cond
byte-compile-compatibility))
(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
- (funcall handler form)
+ (progn
+ (byte-compile-set-symbol-position fn)
+ (funcall handler form))
(if (memq 'callargs byte-compile-warnings)
(byte-compile-callargs-warn form))
(byte-compile-normal-call form))
(byte-defop-compiler-1 defconst byte-compile-defvar)
(byte-defop-compiler-1 autoload)
(byte-defop-compiler-1 lambda byte-compile-lambda-form)
-(byte-defop-compiler-1 defalias)
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
(error "`lambda' used as function name is invalid"))
;; Compile normally, but deal with warnings for the function being defined.
-(defun byte-compile-defalias (form)
+(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
+(defun byte-compile-file-form-defalias (form)
(if (and (consp (cdr form)) (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form)))
- (consp (nthcdr 2 form))
- (consp (nth 2 form))
- (eq (car (nth 2 form)) 'quote)
- (consp (cdr (nth 2 form)))
- (symbolp (nth 1 (nth 2 form))))
- (progn
+ (symbolp (nth 1 (nth 1 form))))
+ (let ((constant
+ (and (consp (nthcdr 2 form))
+ (consp (nth 2 form))
+ (eq (car (nth 2 form)) 'quote)
+ (consp (cdr (nth 2 form)))
+ (symbolp (nth 1 (nth 2 form))))))
(byte-compile-defalias-warn (nth 1 (nth 1 form)))
- (setq byte-compile-function-environment
- (cons (cons (nth 1 (nth 1 form))
- (nth 1 (nth 2 form)))
- byte-compile-function-environment))))
+ (push (cons (nth 1 (nth 1 form))
+ (if constant (nth 1 (nth 2 form)) t))
+ byte-compile-function-environment)))
(byte-compile-normal-call form))
;; Turn off warnings about prior calls to the function being defalias'd.
(while rest
(or (nth 1 (car rest))
(null (setq f (car (car rest))))
- (byte-compile-fdefinition f t)
+ (functionp (byte-compile-fdefinition f t))
(commandp (byte-compile-fdefinition f nil))
(setq uncalled (cons f uncalled)))
(setq rest (cdr rest)))
(run-hooks 'bytecomp-load-hook)
-;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
+;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
;;; bytecomp.el ends here