emacs: lisp/emacs-lisp/bytecomp.el comparison

comparison lisp/emacs-lisp/bytecomp.el @ 85730:a1e136978a9a

(byte-compile-warnings): Document `not'. (byte-compile-warnings-safe-p): Handle `not'. (byte-compile-warning-enabled-p, byte-compile-disable-warning) (byte-compile-enable-warning): New functions. (byte-compile-eval-before-compile) (byte-compile-file-form-require): Use byte-compile-disable-warning. (byte-compile-close-variables): Locally bind byte-compile-warnings, but do not modify it. (byte-compile-eval, byte-compile-obsolete) (byte-compile-warn-about-unresolved-functions) (byte-compile-file-form-defvar) (byte-compile-file-form-custom-declare-variable) (byte-compile-file-form-require) (byte-compile-file-form-defmumble, byte-compile-lambda) (byte-compile-form, byte-compile-normal-call) (byte-compile-variable-ref, byte-compile-defvar) (byte-compile-make-variable-buffer-local): Use byte-compile-warning-enabled-p.

author	Glenn Morris <rgm@gnu.org>
date	Sun, 28 Oct 2007 23:52:50 +0000
parents	13b5281d0188
children	1b8904c5babf

comparison

equal deleted inserted replaced

-:bd2837f89a3b
+:a1e136978a9a
 cl-functions    calls to runtime functions from the CL package (as
 		  distinguished from macros and aliases).
 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"
 		      (const free-vars) (const unresolved)
 		      (const callargs) (const redefine)
 ;;;###autoload
 (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
 				     callargs redefine
 				     obsolete noruntime
 				     cl-functions interactive-only
 				     make-local mapcar))
 		       e))
 		   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."
+(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."
+(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)
 "List of commands that are not meant to be called from Lisp.")
 "Eval FORM and mark the functions defined therein.
 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
 	  ;; and mark all the functions defined therein.
 	  (while (and hist-new (not (eq hist-new hist-orig)))
 	      (let ((s (pop hist-nil-new)))
 		(when (and (symbolp s) (not (memq s old-autoloads)))
 		  (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.
 	  (while (and hist-new (not (eq hist-new hist-orig)))
 	    (let ((xs (pop hist-new)))
 (prog1 (eval form)
 ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
 (let ((tem current-load-list))
 	(while (not (eq tem hist-nil-orig))
 	  (when (equal (car tem) '(require . cl))
-	    (setq byte-compile-warnings
+(byte-compile-disable-warning 'cl-functions))
-		  (remq 'cl-functions byte-compile-warnings)))
 	  (setq tem (cdr tem)))))))
 ;;; byte compiler messages
 (defvar byte-compile-current-form nil)
 (defun byte-compile-obsolete (form)
 (let* ((new (get (car form) 'byte-obsolete-info))
 	 (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))
 			       (car new)
 			     (format "use `%s' instead." (car new)))))
 ;; If we have compiled any calls to functions which are not known to be
 ;; 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))
 ;; Separate the functions that will not be available at runtime
 ;; from the truly unresolved ones.
 		(byte-compile-dynamic byte-compile-dynamic)
 		(byte-compile-dynamic-docstrings
 		 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-warnings byte-compile-warnings)
-					   byte-compile-warning-types
-					 byte-compile-warnings))
 		)
 	      body)))
 (defmacro displaying-byte-compile-warnings (&rest body)
 `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
 	;; This allows us to get the positions of symbols read; it's
 	;; new in Emacs 22.1.
 	(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-warnings byte-compile-warnings)
-	;;				     byte-compile-warning-types
-	;;				   byte-compile-warnings))
 	)
 (byte-compile-close-variables
 (with-current-buffer
 (setq outbuffer (get-buffer-create " *Compiler Output*"))
 (set-buffer-multibyte t)
 (defun byte-compile-file-form-defvar (form)
 (if (null (nth 3 form))
 ;; 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)))
 (cond ((consp (nth 2 form))
 	   (setq form (copy-sequence form))
 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
 ;; If there are any (function (lambda ...)) expressions, compile
 ;; those functions.
 (defun byte-compile-file-form-require (form)
 (let ((args (mapcar 'eval (cdr form))))
 (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
+(byte-compile-disable-warning 'cl-functions)))
-	      (remq 'cl-functions byte-compile-warnings))))
 (byte-compile-keep-pending form 'byte-compile-normal-call))
 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
 	(or (assq name byte-compile-call-tree)
 	    (setq byte-compile-call-tree
 		  (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)))
 	       (byte-compile-warn
 		 "`%s' defined multiple times, as both function and macro"
 		 (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)
 			       byte-compile-initial-macro-environment)))
 	     (byte-compile-warn "%s `%s' defined multiple times in this file"
 				(if macrop "macro" "function")
 				(nth 1 form))))
 	  ((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)
 				(if macrop "macro" "function")))
 	   ;; shadow existing definition
 (error "Not a lambda list: %S" fun))
 (byte-compile-set-symbol-position 'lambda))
 (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)))
 	 (doc (if (stringp (car body))
 		  (prog1 (car body)
 	((symbolp (car form))
 	 (let* ((fn (car form))
 		(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))
 	   (if (and handler
 ;; Make sure that function exists.  This is important
 (functionp handler))
 		    (not (and (byte-compile-version-cond
 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))
 	      ;; if the form comes out the same way it went in, that's
 	      ;; because it was malformed, and we couldn't unfold it.
 (defun byte-compile-normal-call (form)
 (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"))
 (byte-compile-push-constant (car form))
 (mapc 'byte-compile-form (cdr form))	; wasteful, but faster.
 	     ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
 	     (t "variable reference to %s `%s'"))
 (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)))
 	  (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
 			     (if when (concat " (as of Emacs " when ")") "")
 			     (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)
 	      (memq var byte-compile-bound-variables)
 	      (if (eq base-op 'byte-varset)
 	 "`%s' called with %d argument%s, but %s %s"
 	 fun ncall
 	 (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)))
 (byte-compile-body-do-effect
 (list
 ;; Warn about misuses of make-variable-buffer-local.
 (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))
 (put 'make-variable-buffer-local
 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)

Mercurial > emacs

comparison lisp/emacs-lisp/bytecomp.el @ 85730:a1e136978a9a