mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-08 15:30:40 -08:00
Code Issues Projects Releases Wiki Activity

Merge from emacs--devo--0

Browse source 
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-283
This commit is contained in:
Miles Bader 2007-11-11 00:56:44 +00:00
commit f23d76bdef
403 changed files with 36975 additions and 16864 deletions
Download patch file Download diff file Expand all files Collapse all files

173
lisp/emacs-lisp/bytecomp.el
View file

@ -362,7 +362,10 @@ Elements of the list may be:
interactive-only
commands that normally shouldn't be called from Lisp code.
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect."
mapcar mapcar called for effect.
If the list begins with `not', then the remaining elements specify warnings to
suppress. For example, (not mapcar) will suppress warnings about mapcar."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
@ -377,6 +380,8 @@ Elements of the list may be:
(defun byte-compile-warnings-safe-p (x)
(or (booleanp x)
(and (listp x)
(if (eq (car x) 'not) (setq x (cdr x))
t)
(equal (mapcar
(lambda (e)
(when (memq e '(free-vars unresolved
@ -388,6 +393,46 @@ Elements of the list may be:
x)
x))))
(defun byte-compile-warning-enabled-p (warning)
"Return non-nil if WARNING is enabled, according to `byte-compile-warnings'."
(or (eq byte-compile-warnings t)
(if (eq (car byte-compile-warnings) 'not)
(not (memq warning byte-compile-warnings))
(memq warning byte-compile-warnings))))
;;;###autoload
(defun byte-compile-disable-warning (warning)
"Change `byte-compile-warnings' to disable WARNING.
If `byte-compile-warnings' is t, set it to `(not WARNING)'.
Otherwise, if the first element is `not', add WARNING, else remove it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified."
(setq byte-compile-warnings
(cond ((eq byte-compile-warnings t)
(list 'not warning))
((eq (car byte-compile-warnings) 'not)
(if (memq warning byte-compile-warnings)
byte-compile-warnings
(append byte-compile-warnings (list warning))))
(t
(delq warning byte-compile-warnings)))))
;;;###autoload
(defun byte-compile-enable-warning (warning)
"Change `byte-compile-warnings' to enable WARNING.
If `byte-compile-warnings' is `t', do nothing. Otherwise, if the
first element is `not', remove WARNING, else add it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified."
(or (eq byte-compile-warnings t)
(setq byte-compile-warnings
(cond ((eq (car byte-compile-warnings) 'not)
(delq warning byte-compile-warnings))
((memq warning byte-compile-warnings)
byte-compile-warnings)
(t
(append byte-compile-warnings (list warning)))))))
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line)
@ -830,7 +875,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((hist-orig load-history)
(hist-nil-orig current-load-list))
(prog1 (eval form)
(when (memq 'noruntime byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'noruntime)
(let ((hist-new load-history)
(hist-nil-new current-load-list))
;; Go through load-history, look for newly loaded files
@ -858,7 +903,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(push s byte-compile-noruntime-functions))
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
(when (memq 'cl-functions byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'cl-functions)
(let ((hist-new load-history))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
@ -876,8 +921,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((tem current-load-list))
(while (not (eq tem hist-nil-orig))
(when (equal (car tem) '(require . cl))
(setq byte-compile-warnings
(remq 'cl-functions byte-compile-warnings)))
(byte-compile-disable-warning 'cl-functions))
(setq tem (cdr tem)))))))
;;; byte compiler messages
@ -1075,7 +1119,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(handler (nth 1 new))
(when (nth 2 new)))
(byte-compile-set-symbol-position (car form))
(if (memq 'obsolete byte-compile-warnings)
(if (byte-compile-warning-enabled-p 'obsolete)
(byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
(if when (concat " (as of Emacs " when ")") "")
(if (stringp (car new))
@ -1421,7 +1465,7 @@ extra args."
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
(when (memq 'unresolved byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'unresolved)
(let ((byte-compile-current-form :end)
(noruntime nil)
(unresolved nil))
@ -1484,9 +1528,7 @@ symbol itself."
byte-compile-dynamic-docstrings)
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
(byte-compile-warnings (if (eq byte-compile-warnings t)
byte-compile-warning-types
byte-compile-warnings))
(byte-compile-warnings byte-compile-warnings)
)
body)))
@ -1829,9 +1871,7 @@ With argument, insert value in current buffer after the form."
(read-with-symbol-positions inbuffer)
(read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings (if (eq byte-compile-warnings t)
;; byte-compile-warning-types
;; byte-compile-warnings))
;; (byte-compile-warnings byte-compile-warnings)
)
(byte-compile-close-variables
(with-current-buffer
@ -2210,7 +2250,7 @@ list that represents a doc string reference.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
(when (memq 'free-vars byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 form) byte-compile-bound-variables)
(if (eq (car form) 'defconst)
(push (nth 1 form) byte-compile-const-variables)))
@ -2220,12 +2260,19 @@ list that represents a doc string reference.
(byte-compile-top-level (nth 2 form) nil 'file))))
form))
(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
(defun byte-compile-file-form-define-abbrev-table (form)
(when (and (byte-compile-warning-enabled-p 'free-vars)
(eq 'quote (car-safe (car-safe (cdr form)))))
(push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
(when (memq 'callargs byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
(when (memq 'free-vars byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 (nth 1 form)) byte-compile-bound-variables))
(let ((tail (nthcdr 4 form)))
(while tail
@ -2248,8 +2295,7 @@ list that represents a doc string reference.
(apply 'require args)
;; 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))))
(byte-compile-disable-warning 'cl-functions)))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
@ -2295,12 +2341,12 @@ list that represents a doc string reference.
(cons (list name nil nil) byte-compile-call-tree))))
(setq byte-compile-current-form name) ; for warnings
(if (memq 'redefine byte-compile-warnings)
(if (byte-compile-warning-enabled-p 'redefine)
(byte-compile-arglist-warn form macrop))
(if byte-compile-verbose
(message "Compiling %s... (%s)" (or filename "") (nth 1 form)))
(cond (that-one
(if (and (memq 'redefine byte-compile-warnings)
(if (and (byte-compile-warning-enabled-p 'redefine)
;; don't warn when compiling the stubs in byte-run...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
@ -2309,7 +2355,7 @@ list that represents a doc string reference.
(nth 1 form)))
(setcdr that-one nil))
(this-one
(when (and (memq 'redefine byte-compile-warnings)
(when (and (byte-compile-warning-enabled-p 'redefine)
;; hack: don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
(not (assq (nth 1 form)
@ -2320,7 +2366,7 @@ list that represents a doc string reference.
((and (fboundp name)
(eq (car-safe (symbol-function name))
(if macrop 'lambda 'macro)))
(when (memq 'redefine byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'redefine)
(byte-compile-warn "%s `%s' being redefined as a %s"
(if macrop "function" "macro")
(nth 1 form)
@ -2560,7 +2606,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(nconc (and (memq 'free-vars byte-compile-warnings)
(nconc (and (byte-compile-warning-enabled-p 'free-vars)
(delq '&rest (delq '&optional (copy-sequence arglist))))
byte-compile-bound-variables))
(body (cdr (cdr fun)))
@ -2800,7 +2846,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(handler (get fn 'byte-compile)))
(when (byte-compile-const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(and (memq 'interactive-only byte-compile-warnings)
(and (byte-compile-warning-enabled-p 'interactive-only)
(memq fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" fn))
@ -2815,12 +2861,12 @@ That command is designed for interactive use only" fn))
byte-compile-compatibility)
(get (get fn 'byte-opcode) 'emacs19-opcode))))
(funcall handler form)
(when (memq 'callargs byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'callargs)
(if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
(byte-compile-nogroup-warn form))
(byte-compile-callargs-warn form))
(byte-compile-normal-call form))
(if (memq 'cl-functions byte-compile-warnings)
(if (byte-compile-warning-enabled-p 'cl-functions)
(byte-compile-cl-warn form))))
((and (or (byte-code-function-p (car form))
(eq (car-safe (car form)) 'lambda))
@ -2837,7 +2883,7 @@ That command is designed for interactive use only" fn))
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
(when (and for-effect (eq (car form) 'mapcar)
(memq 'mapcar byte-compile-warnings))
(byte-compile-warning-enabled-p 'mapcar))
(byte-compile-set-symbol-position 'mapcar)
(byte-compile-warn
"`mapcar' called for effect; use `mapc' or `dolist' instead"))
@ -2857,7 +2903,7 @@ That command is designed for interactive use only" fn))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
(if (and (get var 'byte-obsolete-variable)
(memq 'obsolete byte-compile-warnings)
(byte-compile-warning-enabled-p 'obsolete)
(not (eq var byte-compile-not-obsolete-var)))
(let* ((ob (get var 'byte-obsolete-variable))
(when (cdr ob)))
@ -2866,7 +2912,7 @@ That command is designed for interactive use only" fn))
(if (stringp (car ob))
(car ob)
(format "use `%s' instead." (car ob))))))
(if (memq 'free-vars byte-compile-warnings)
(if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(or (boundp var)
@ -3448,6 +3494,32 @@ That command is designed for interactive use only" fn))
(if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag))
;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
;; Only return items that are not in ONLY-IF-NOT-PRESENT.
(defun byte-compile-find-bound-condition (condition-param
pred-list
&optional only-if-not-present)
(let ((result nil)
(nth-one nil)
(cond-list
(if (memq (car-safe condition-param) pred-list)
;; The condition appears by itself.
(list condition-param)
;; If the condition is an `and', look for matches among the
;; `and' arguments.
(when (eq 'and (car-safe condition-param))
(cdr condition-param)))))
(dolist (crt cond-list)
(when (and (memq (car-safe crt) pred-list)
(eq 'quote (car-safe (setq nth-one (nth 1 crt))))
;; Ignore if the symbol is already on the unresolved
;; list.
(not (assq (nth 1 nth-one) ; the relevant symbol
only-if-not-present)))
(push (nth 1 (nth 1 crt)) result)))
result))
(defmacro byte-compile-maybe-guarded (condition &rest body)
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
@ -3459,35 +3531,34 @@ being undefined will be suppressed.
If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
`(let* ((fbound
(if (eq 'fboundp (car-safe ,condition))
(and (eq 'quote (car-safe (nth 1 ,condition)))
;; Ignore if the symbol is already on the
;; unresolved list.
(not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
byte-compile-unresolved-functions))
(nth 1 (nth 1 ,condition)))))
(bound (if (or (eq 'boundp (car-safe ,condition))
(eq 'default-boundp (car-safe ,condition)))
(and (eq 'quote (car-safe (nth 1 ,condition)))
(nth 1 (nth 1 ,condition)))))
`(let* ((fbound-list (byte-compile-find-bound-condition
,condition (list 'fboundp)
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
,condition (list 'boundp 'default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(if bound
(cons bound byte-compile-bound-variables)
(if bound-list
(append bound-list byte-compile-bound-variables)
byte-compile-bound-variables))
;; Suppress all warnings, for code not used in Emacs.
(byte-compile-warnings
(if (member ,condition '((featurep 'xemacs)
(not (featurep 'emacs))))
nil byte-compile-warnings)))
;; FIXME: by the time this is executed the `featurep'
;; emacs/xemacs tests have been optimized away, so this is
;; not doing anything useful here, is should probably be
;; moved to a different place.
;; (byte-compile-warnings
;; (if (member ,condition '((featurep 'xemacs)
;; (not (featurep 'emacs))))
;; nil byte-compile-warnings))
)
(unwind-protect
(progn ,@body)
;; Maybe remove the function symbol from the unresolved list.
(if fbound
(dolist (fbound fbound-list)
(when fbound
(setq byte-compile-unresolved-functions
(delq (assq fbound byte-compile-unresolved-functions)
byte-compile-unresolved-functions))))))
byte-compile-unresolved-functions)))))))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
@ -3809,7 +3880,7 @@ that suppresses all warnings during execution of BODY."
(if (= 1 ncall) "" "s")
(if (< ncall 2) "requires" "accepts only")
"2-3")))
(when (memq 'free-vars byte-compile-warnings)
(when (byte-compile-warning-enabled-p 'free-vars)
(push var byte-compile-bound-variables)
(if (eq fun 'defconst)
(push var byte-compile-const-variables)))
@ -3901,7 +3972,7 @@ that suppresses all warnings during execution of BODY."
(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
(if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
(memq 'make-local byte-compile-warnings))
(byte-compile-warning-enabled-p 'make-local))
(byte-compile-warn
"`make-variable-buffer-local' should be called at toplevel"))
(byte-compile-normal-call form))