diff lisp/progmodes/cc-bytecomp.el @ 51714:bc91cbf50c24

Updated CC Mode to version 5.30.

--- a/lisp/progmodes/cc-bytecomp.el	Thu Jul 03 01:59:39 2003 +0000
+++ b/lisp/progmodes/cc-bytecomp.el	Thu Jul 03 12:30:59 2003 +0000
@@ -1,6 +1,6 @@
 ;;; cc-bytecomp.el --- compile time setup for proper compilation
 
-;; Copyright (C) 2000, 01 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 01, 02, 03 Free Software Foundation, Inc.
 
 ;; Author:     Martin Stjernholm
 ;; Maintainer: [e-mail]
@@ -34,7 +34,44 @@
 ;;
 ;; There's really nothing CC Mode specific here; this functionality
 ;; ought to be provided by the byte compilers or some accompanying
-;; library.
+;; library.  To use it from some package "foo.el", begin by putting
+;; the following blurb at the top of the file:
+;;
+;;   (eval-when-compile
+;;     (let ((load-path
+;;            (if (and (boundp 'byte-compile-dest-file)
+;;                     (stringp byte-compile-dest-file))
+;;                (cons (file-name-directory byte-compile-dest-file) load-path)
+;;              load-path)))
+;;       (load "cc-bytecomp" nil t))
+;;
+;; This (unfortunately rather clumsy) form will ensure that the
+;; cc-bytecomp.el in the same directory as foo.el is loaded during
+;; byte compilation of the latter.
+;;
+;; At the end of foo.el there should normally be a "(provide 'foo)".
+;; Replace it with "(cc-provide 'foo)"; that is necessary to restore
+;; the environment after the byte compilation.  If you don't have a
+;; `provide' at the end, you have to add the following as the very
+;; last form in the file:
+;;
+;;   (eval-when-compile (cc-bytecomp-restore-environment))
+;;
+;; Now everything is set to use the various functions and macros in
+;; this package.
+;;
+;; If your package is split into several files, you should use
+;; `cc-require', `cc-require-when-compile' or `cc-load' to load them.
+;; That ensures that the files in the same directory always are
+;; loaded, to avoid mixup with other versions of them that might exist
+;; elsewhere in the load path.
+;;
+;; To suppress byte compiler warnings, use the macros
+;; `cc-bytecomp-defun', `cc-bytecomp-defvar',
+;; `cc-bytecomp-obsolete-fun', and `cc-bytecomp-obsolete-var'.
+;;
+;; This file is not used at all after the package has been byte
+;; compiled.  It is however necessary when running uncompiled.
 
 
 ;;; Code:
@@ -42,53 +79,20 @@
 (defvar cc-bytecomp-unbound-variables nil)
 (defvar cc-bytecomp-original-functions nil)
 (defvar cc-bytecomp-original-properties nil)
-(defvar cc-bytecomp-load-depth 0)
 (defvar cc-bytecomp-loaded-files nil)
 (defvar cc-bytecomp-environment-set nil)
 
-(put 'cc-eval-when-compile 'lisp-indent-hook 0)
-(defmacro cc-eval-when-compile (&rest body)
-  "Like `progn', but evaluates the body at compile time.
-The result of the body appears to the compiler as a quoted constant.
-
-This variant works around what looks like a bug in
-`eval-when-compile': During byte compilation it byte compiles its
-contents before evaluating it.  That can cause forms to be compiled in
-situations they aren't intended to be compiled.  See cc-bytecomp.el
-for further discussion."
-  ;;
-  ;; Example: It's not possible to defsubst a primitive, e.g. the
-  ;; following will produce an error (in any emacs flavor), since
-  ;; `nthcdr' is a primitive function that's handled specially by the
-  ;; byte compiler and thus can't be redefined:
-  ;;
-  ;;     (defsubst nthcdr (val) val)
-  ;;
-  ;; `defsubst', like `defmacro', needs to be evaluated at compile
-  ;; time, so this will produce an error during byte compilation.
-  ;;
-  ;; CC Mode occasionally needs to do things like this for cross-emacs
-  ;; compatibility (although we try to avoid it since it results in
-  ;; byte code that isn't compatible between emacsen).  It therefore
-  ;; uses the following to conditionally do a `defsubst':
-  ;;
-  ;;     (eval-when-compile
-  ;;       (if (not (fboundp 'foo))
-  ;;           (defsubst foo ...)))
-  ;;
-  ;; But `eval-when-compile' byte compiles its contents and _then_
-  ;; evaluates it (in all current emacs versions, up to and including
-  ;; Emacs 20.6 and XEmacs 21.1 as of this writing).  So this will
-  ;; still produce an error, since the byte compiler will get to the
-  ;; defsubst anyway.  That's arguably a bug because the point with
-  ;; `eval-when-compile' is that it should evaluate rather than
-  ;; compile its contents.
-  `(eval-when-compile (eval '(progn ,@body))))
+(defmacro cc-bytecomp-debug-msg (&rest args)
+  ;;`(message ,@args)
+  )
 
 (defun cc-bytecomp-setup-environment ()
   ;; Eval'ed during compilation to setup variables, functions etc
   ;; declared with `cc-bytecomp-defvar' et al.
-  (if (= cc-bytecomp-load-depth 0)
+  (if (not load-in-progress)
+      ;; Look at `load-in-progress' to tell whether we're called
+      ;; directly in the file being compiled or just from some file
+      ;; being loaded during compilation.
       (let (p)
 	(if cc-bytecomp-environment-set
 	    (error "Byte compilation environment already set - \
@@ -98,46 +102,85 @@
 	  (if (not (boundp (car p)))
 	      (progn
 		(eval `(defvar ,(car p)))
-		(set (car p) 'cc-bytecomp-ignore)))
+		(set (car p) (intern (concat "cc-bytecomp-ignore-var:"
+					     (symbol-name (car p)))))
+		(cc-bytecomp-debug-msg
+		 "cc-bytecomp-setup-environment: Covered variable %s"
+		 (car p))))
 	  (setq p (cdr p)))
 	(setq p cc-bytecomp-original-functions)
 	(while p
 	  (let ((fun (car (car p)))
 		(temp-macro (car (cdr (car p)))))
-	    (if temp-macro
-		(eval `(defmacro ,fun ,@temp-macro))
-	      (fset fun 'cc-bytecomp-ignore)))
+	    (if (not (fboundp fun))
+		(if temp-macro
+		    (progn
+		      (eval `(defmacro ,fun ,@temp-macro))
+		      (cc-bytecomp-debug-msg
+		       "cc-bytecomp-setup-environment: Bound macro %s" fun))
+		  (fset fun (intern (concat "cc-bytecomp-ignore-fun:"
+					    (symbol-name fun))))
+		  (cc-bytecomp-debug-msg
+		   "cc-bytecomp-setup-environment: Covered function %s" fun))))
 	  (setq p (cdr p)))
 	(setq p cc-bytecomp-original-properties)
 	(while p
 	  (let ((sym (car (car (car p))))
 		(prop (cdr (car (car p))))
 		(tempdef (car (cdr (car p)))))
-	    (put sym prop tempdef))
+	    (put sym prop tempdef)
+	    (cc-bytecomp-debug-msg
+	     "cc-bytecomp-setup-environment: Bound property %s for %s to %s"
+	     prop sym tempdef))
 	  (setq p (cdr p)))
-	(setq cc-bytecomp-environment-set t))))
+	(setq cc-bytecomp-environment-set t)
+	(cc-bytecomp-debug-msg
+	 "cc-bytecomp-setup-environment: Done"))))
 
 (defun cc-bytecomp-restore-environment ()
   ;; Eval'ed during compilation to restore variables, functions etc
   ;; declared with `cc-bytecomp-defvar' et al.
-  (if (= cc-bytecomp-load-depth 0)
+  (if (not load-in-progress)
       (let (p)
 	(setq p cc-bytecomp-unbound-variables)
 	(while p
 	  (let ((var (car p)))
-	    (if (and (boundp var)
-		     (eq var 'cc-bytecomp-ignore))
-		(makunbound var)))
+	    (if (boundp var)
+		(if (eq (intern (concat "cc-bytecomp-ignore-var:"
+					(symbol-name var)))
+			(symbol-value var))
+		    (progn
+		      (makunbound var)
+		      (cc-bytecomp-debug-msg
+		       "cc-bytecomp-restore-environment: Unbound variable %s"
+		       var))
+		  (cc-bytecomp-debug-msg
+		   "cc-bytecomp-restore-environment: Not restoring variable %s"
+		   var))))
 	  (setq p (cdr p)))
 	(setq p cc-bytecomp-original-functions)
 	(while p
 	  (let ((fun (car (car p)))
+		(temp-macro (car (cdr (car p))))
 		(def (car (cdr (cdr (car p))))))
-	    (if (and (fboundp fun)
-		     (eq (symbol-function fun) 'cc-bytecomp-ignore))
-		(if (eq def 'unbound)
-		    (fmakunbound fun)
-		  (fset fun def))))
+	    (if (fboundp fun)
+		(if (eq (or temp-macro
+			    (intern (concat "cc-bytecomp-ignore-fun:"
+					    (symbol-name fun))))
+			   (symbol-function fun))
+		    (if (eq def 'unbound)
+			(progn
+			  (fmakunbound fun)
+			  (cc-bytecomp-debug-msg
+			   "cc-bytecomp-restore-environment: Unbound function %s"
+			   fun))
+		      (fset fun def)
+		      (cc-bytecomp-debug-msg
+		       "cc-bytecomp-restore-environment: Restored function %s"
+		       fun))
+		  (cc-bytecomp-debug-msg
+		   "cc-bytecomp-restore-environment: Not restoring function %s"
+		   fun))))
 	  (setq p (cdr p)))
 	(setq p cc-bytecomp-original-properties)
 	(while p
@@ -146,40 +189,60 @@
 		(tempdef (car (cdr (car p))))
 		(origdef (cdr (cdr (car p)))))
 	    (if (eq (get sym prop) tempdef)
-		(put sym prop origdef)))
+		(progn
+		  (put sym prop origdef)
+		  (cc-bytecomp-debug-msg
+		   "cc-bytecomp-restore-environment: Restored property %s for %s to %s"
+		   prop sym origdef))
+	      (cc-bytecomp-debug-msg
+	       "cc-bytecomp-restore-environment: Not restoring property %s for %s"
+	       prop sym)))
 	  (setq p (cdr p)))
-	(setq cc-bytecomp-environment-set nil))))
+	(setq cc-bytecomp-environment-set nil)
+	(cc-bytecomp-debug-msg
+	 "cc-bytecomp-restore-environment: Done"))))
+
+(eval
+ ;; This eval is to avoid byte compilation of the function below.
+ ;; There's some bug in XEmacs 21.4.6 that can cause it to dump core
+ ;; here otherwise.  My theory is that `cc-bytecomp-load' might be
+ ;; redefined recursively during the `load' inside it, and if it in
+ ;; that case is byte compiled then the byte interpreter gets
+ ;; confused.  I haven't succeeded in isolating the bug, though. /mast
 
-(defun cc-bytecomp-load (cc-part)
-  ;; Eval'ed during compilation to load a CC Mode file from the source
-  ;; directory (assuming it's the same as the compiled file
-  ;; destination dir).
-  (if (and (boundp 'byte-compile-dest-file)
-	   (stringp byte-compile-dest-file))
-      (progn
-	(cc-bytecomp-restore-environment)
-	(let ((cc-bytecomp-load-depth (1+ cc-bytecomp-load-depth))
-	      (load-path
-	       (cons (file-name-directory byte-compile-dest-file)
-		     load-path))
-	      (cc-file (concat cc-part ".el")))
-	  (if (member cc-file cc-bytecomp-loaded-files)
-	      ()
-	    (setq cc-bytecomp-loaded-files
-		  (cons cc-file cc-bytecomp-loaded-files))
-	    (load cc-file nil t t)))
-	(cc-bytecomp-setup-environment)
-	t)))
+ '(defun cc-bytecomp-load (cc-part)
+    ;; Eval'ed during compilation to load a CC Mode file from the source
+    ;; directory (assuming it's the same as the compiled file
+    ;; destination dir).
+    (if (and (boundp 'byte-compile-dest-file)
+	     (stringp byte-compile-dest-file))
+	(progn
+	  (cc-bytecomp-restore-environment)
+	  (let ((load-path
+		 (cons (file-name-directory byte-compile-dest-file)
+		       load-path))
+		(cc-file (concat cc-part ".el")))
+	    (if (member cc-file cc-bytecomp-loaded-files)
+		()
+	      (setq cc-bytecomp-loaded-files
+		    (cons cc-file cc-bytecomp-loaded-files))
+	      (cc-bytecomp-debug-msg
+	       "cc-bytecomp-load: Loading %S" cc-file)
+	      (load cc-file nil t t)
+	      (cc-bytecomp-debug-msg
+	       "cc-bytecomp-load: Loaded %S" cc-file)))
+	  (cc-bytecomp-setup-environment)
+	  t))))
 
 (defmacro cc-require (cc-part)
-  "Force loading of the corresponding .el file in the current
-directory during compilation, but compile in a `require'.  Don't use
-within `eval-when-compile'.
+  "Force loading of the corresponding .el file in the current directory
+during compilation, but compile in a `require'.  Don't use within
+`eval-when-compile'.
 
 Having cyclic cc-require's will result in infinite recursion.  That's
 somewhat intentional."
   `(progn
-     (cc-eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part)))
+     (eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part)))
      (require ,cc-part)))
 
 (defmacro cc-provide (feature)
@@ -190,9 +253,9 @@
      (provide ,feature)))
 
 (defmacro cc-load (cc-part)
-  "Force loading of the corresponding .el file in the current
-directory during compilation.  Don't use outside `eval-when-compile'
-or `eval-and-compile'.
+  "Force loading of the corresponding .el file in the current directory
+during compilation.  Don't use outside `eval-when-compile' or
+`eval-and-compile'.
 
 Having cyclic cc-load's will result in infinite recursion.  That's
 somewhat intentional."
@@ -200,6 +263,27 @@
 	    (cc-bytecomp-load ,cc-part))
        (load ,cc-part nil t nil)))
 
+(defmacro cc-require-when-compile (cc-part)
+  "Force loading of the corresponding .el file in the current directory
+during compilation, but do a compile time `require' otherwise.  Don't
+use within `eval-when-compile'."
+  `(eval-when-compile
+     (if (and (featurep 'cc-bytecomp)
+	      (cc-bytecomp-is-compiling))
+	 (if (or (not load-in-progress)
+		 (not (featurep ,cc-part)))
+	     (cc-bytecomp-load (symbol-name ,cc-part)))
+       (require ,cc-part))))
+
+(defmacro cc-external-require (feature)
+  "Do a `require' of an external package.
+This restores and sets up the compilation environment before and
+afterwards.  Don't use within `eval-when-compile'."
+  `(progn
+     (eval-when-compile (cc-bytecomp-restore-environment))
+     (require ,feature)
+     (eval-when-compile (cc-bytecomp-setup-environment))))
+
 (defun cc-bytecomp-is-compiling ()
   "Return non-nil if eval'ed during compilation.  Don't use outside
 `eval-when-compile'."
@@ -211,58 +295,95 @@
 to silence the byte compiler.  Don't use within `eval-when-compile'."
   `(eval-when-compile
      (if (boundp ',var)
-	 nil
+	 (cc-bytecomp-debug-msg
+	  "cc-bytecomp-defvar: %s bound already as variable" ',var)
        (if (not (memq ',var cc-bytecomp-unbound-variables))
-	   (setq cc-bytecomp-unbound-variables
-		 (cons ',var cc-bytecomp-unbound-variables)))
+	   (progn
+	     (cc-bytecomp-debug-msg
+	      "cc-bytecomp-defvar: Saving %s (as unbound)" ',var)
+	     (setq cc-bytecomp-unbound-variables
+		   (cons ',var cc-bytecomp-unbound-variables))))
        (if (and (cc-bytecomp-is-compiling)
-		(= cc-bytecomp-load-depth 0))
+		(not load-in-progress))
 	   (progn
 	     (defvar ,var)
-	     (set ',var 'cc-bytecomp-ignore))))))
+	     (set ',var (intern (concat "cc-bytecomp-ignore-var:"
+					(symbol-name ',var))))
+	     (cc-bytecomp-debug-msg
+	      "cc-bytecomp-defvar: Covered variable %s" ',var))))))
 
 (defmacro cc-bytecomp-defun (fun)
   "Bind the symbol as a function during compilation of the file,
-to silence the byte compiler.  Don't use within `eval-when-compile'."
+to silence the byte compiler.  Don't use within `eval-when-compile'.
+
+If the symbol already is bound as a function, it will keep that
+definition.  That means that this macro will not shut up warnings
+about incorrect number of arguments.  It's dangerous to try to replace
+existing functions since the byte compiler might need the definition
+at compile time, e.g. for macros and inline functions."
   `(eval-when-compile
      (if (fboundp ',fun)
-	 nil
+	 (cc-bytecomp-debug-msg
+	  "cc-bytecomp-defun: %s bound already as function" ',fun)
        (if (not (assq ',fun cc-bytecomp-original-functions))
-	   (setq cc-bytecomp-original-functions
-		 (cons (list ',fun nil 'unbound)
-		       cc-bytecomp-original-functions)))
+	   (progn
+	     (cc-bytecomp-debug-msg
+	      "cc-bytecomp-defun: Saving %s (as unbound)" ',fun)
+	     (setq cc-bytecomp-original-functions
+		   (cons (list ',fun nil 'unbound)
+			 cc-bytecomp-original-functions))))
        (if (and (cc-bytecomp-is-compiling)
-		(= cc-bytecomp-load-depth 0))
-	   (fset ',fun 'cc-bytecomp-ignore)))))
+		(not load-in-progress))
+	   (progn
+	     (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:"
+					 (symbol-name ',fun))))
+	     (cc-bytecomp-debug-msg
+	      "cc-bytecomp-defun: Covered function %s" ',fun))))))
 
 (put 'cc-bytecomp-defmacro 'lisp-indent-function 'defun)
 (defmacro cc-bytecomp-defmacro (fun &rest temp-macro)
   "Bind the symbol as a macro during compilation (and evaluation) of the
 file.  Don't use outside `eval-when-compile'."
-  `(progn
-     (if (not (assq ',fun cc-bytecomp-original-functions))
-	 (setq cc-bytecomp-original-functions
-	       (cons (list ',fun
-			   ',temp-macro
-			   (if (fboundp ',fun)
-			       (symbol-function ',fun)
-			     'unbound))
-		     cc-bytecomp-original-functions)))
-     (defmacro ,fun ,@temp-macro)))
+  `(let ((orig-fun (assq ',fun cc-bytecomp-original-functions)))
+     (if (not orig-fun)
+	 (setq orig-fun
+	       (list ',fun
+		     nil
+		     (if (fboundp ',fun)
+			 (progn
+			   (cc-bytecomp-debug-msg
+			    "cc-bytecomp-defmacro: Saving %s" ',fun)
+			   (symbol-function ',fun))
+		       (cc-bytecomp-debug-msg
+			"cc-bytecomp-defmacro: Saving %s as unbound" ',fun)
+		       'unbound))
+	       cc-bytecomp-original-functions
+	       (cons orig-fun cc-bytecomp-original-functions)))
+     (defmacro ,fun ,@temp-macro)
+     (cc-bytecomp-debug-msg
+      "cc-bytecomp-defmacro: Bound macro %s" ',fun)
+     (setcar (cdr orig-fun) (symbol-function ',fun))))
 
 (defmacro cc-bytecomp-put (symbol propname value)
   "Set a property on a symbol during compilation (and evaluation) of
 the file.  Don't use outside `eval-when-compile'."
-  `(cc-eval-when-compile
+  `(eval-when-compile
      (if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
-	 (setq cc-bytecomp-original-properties
-	       (cons (cons (cons ,symbol ,propname)
-			   (cons ,value (get ,symbol ,propname)))
-		     cc-bytecomp-original-properties)))
-     (put ,symbol ,propname ,value)))
+	 (progn
+	   (cc-bytecomp-debug-msg
+	    "cc-bytecomp-put: Saving property %s for %s with value %s"
+	    ,propname ,symbol (get ,symbol ,propname))
+	   (setq cc-bytecomp-original-properties
+		 (cons (cons (cons ,symbol ,propname)
+			     (cons ,value (get ,symbol ,propname)))
+		       cc-bytecomp-original-properties))))
+     (put ,symbol ,propname ,value)
+     (cc-bytecomp-debug-msg
+      "cc-bytecomp-put: Bound property %s for %s to %s"
+      ,propname ,symbol ,value)))
 
 (defmacro cc-bytecomp-obsolete-var (symbol)
-  "Suppress warnings about that the given symbol is an obsolete variable.
+  "Suppress warnings that the given symbol is an obsolete variable.
 Don't use within `eval-when-compile'."
   `(eval-when-compile
      (if (get ',symbol 'byte-obsolete-variable)
@@ -278,21 +399,38 @@
     (byte-compile-obsolete form)))
 
 (defmacro cc-bytecomp-obsolete-fun (symbol)
-  "Suppress warnings about that the given symbol is an obsolete function.
+  "Suppress warnings that the given symbol is an obsolete function.
 Don't use within `eval-when-compile'."
   `(eval-when-compile
      (if (eq (get ',symbol 'byte-compile) 'byte-compile-obsolete)
 	 (cc-bytecomp-put ',symbol 'byte-compile
-			  'cc-bytecomp-ignore-obsolete))))
+			  'cc-bytecomp-ignore-obsolete)
+       ;; This avoids a superfluous compiler warning
+       ;; about calling `get' for effect.
+       t)))
 
-;; Override ourselves with a version loaded from source if we're
-;; compiling, like cc-require does for all the other files.
-(if (and (cc-bytecomp-is-compiling)
-	 (= cc-bytecomp-load-depth 0))
-    (let ((load-path
-	   (cons (file-name-directory byte-compile-dest-file) load-path))
-	  (cc-bytecomp-load-depth 1))
-      (load "cc-bytecomp.el" nil t t)))
+(defmacro cc-bytecomp-boundp (symbol)
+  "Return non-nil if the given symbol is bound as a variable outside
+the compilation.  This is the same as using `boundp' but additionally
+exclude any variables that have been bound during compilation with
+`cc-bytecomp-defvar'."
+  (if (and (cc-bytecomp-is-compiling)
+	   (memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
+      nil
+    `(boundp ,symbol)))
+
+(defmacro cc-bytecomp-fboundp (symbol)
+  "Return non-nil if the given symbol is bound as a function outside
+the compilation.  This is the same as using `fboundp' but additionally
+exclude any functions that have been bound during compilation with
+`cc-bytecomp-defun'."
+  (let (fun-elem)
+    (if (and (cc-bytecomp-is-compiling)
+	     (setq fun-elem (assq (car (cdr symbol))
+				  cc-bytecomp-original-functions))
+	     (eq (elt fun-elem 2) 'unbound))
+	nil
+      `(fboundp ,symbol))))
 
 
 (provide 'cc-bytecomp)