lisp/progmodes/cc-bytecomp.el

   1 ;;; cc-bytecomp.el --- compile time setup for proper compilation
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author:     Martin Stjernholm
   7 ;; Maintainer: bug-cc-mode@gnu.org
   8 ;; Created:    15-Jul-2000
   9 ;; Version:    See cc-mode.el
  10 ;; Keywords:   c languages oop
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 3, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is used to ensure that the CC Mode files are correctly
  32 ;; compiled regardless the environment (e.g. if an older CC Mode with
  33 ;; outdated macros are loaded during compilation).  It also provides
  34 ;; features to defeat the compiler warnings for selected symbols.
  35 ;;
  36 ;; There's really nothing CC Mode specific here; this functionality
  37 ;; ought to be provided by the byte compilers or some accompanying
  38 ;; library.  To use it from some package "foo.el", begin by putting
  39 ;; the following blurb at the top of the file:
  40 ;;
  41 ;;   (eval-when-compile
  42 ;;     (let ((load-path
  43 ;;            (if (and (boundp 'byte-compile-dest-file)
  44 ;;                     (stringp byte-compile-dest-file))
  45 ;;                (cons (file-name-directory byte-compile-dest-file) load-path)
  46 ;;              load-path)))
  47 ;;       (load "cc-bytecomp" nil t))
  48 ;;
  49 ;; This (unfortunately rather clumsy) form will ensure that the
  50 ;; cc-bytecomp.el in the same directory as foo.el is loaded during
  51 ;; byte compilation of the latter.
  52 ;;
  53 ;; At the end of foo.el there should normally be a "(provide 'foo)".
  54 ;; Replace it with "(cc-provide 'foo)"; that is necessary to restore
  55 ;; the environment after the byte compilation.  If you don't have a
  56 ;; `provide' at the end, you have to add the following as the very
  57 ;; last form in the file:
  58 ;;
  59 ;;   (eval-when-compile (cc-bytecomp-restore-environment))
  60 ;;
  61 ;; Now everything is set to use the various functions and macros in
  62 ;; this package.
  63 ;;
  64 ;; If your package is split into several files, you should use
  65 ;; `cc-require', `cc-require-when-compile' or `cc-load' to load them.
  66 ;; That ensures that the files in the same directory always are
  67 ;; loaded, to avoid mixup with other versions of them that might exist
  68 ;; elsewhere in the load path.
  69 ;;
  70 ;; To suppress byte compiler warnings, use the macros
  71 ;; `cc-bytecomp-defun', `cc-bytecomp-defvar',
  72 ;; `cc-bytecomp-obsolete-fun', and `cc-bytecomp-obsolete-var'.
  73 ;;
  74 ;; This file is not used at all after the package has been byte
  75 ;; compiled.  It is however necessary when running uncompiled.
  76
  77 \f
  78 ;;; Code:
  79
  80 (defvar cc-bytecomp-unbound-variables nil)
  81 (defvar cc-bytecomp-original-functions nil)
  82 (defvar cc-bytecomp-original-properties nil)
  83 (defvar cc-bytecomp-loaded-files nil)
  84 (defvar cc-bytecomp-environment-set nil)
  85
  86 (defmacro cc-bytecomp-debug-msg (&rest args)
  87   ;;`(message ,@args)
  88   )
  89
  90 (defun cc-bytecomp-setup-environment ()
  91   ;; Eval'ed during compilation to setup variables, functions etc
  92   ;; declared with `cc-bytecomp-defvar' et al.
  93   (if (not load-in-progress)
  94       ;; Look at `load-in-progress' to tell whether we're called
  95       ;; directly in the file being compiled or just from some file
  96       ;; being loaded during compilation.
  97       (let (p)
  98         (if cc-bytecomp-environment-set
  99             (error "Byte compilation environment already set - \
 100 perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
 101         (setq p cc-bytecomp-unbound-variables)
 102         (while p
 103           (if (not (boundp (car p)))
 104               (progn
 105                 (eval `(defvar ,(car p)))
 106                 (set (car p) (intern (concat "cc-bytecomp-ignore-var:"
 107                                              (symbol-name (car p)))))
 108                 (cc-bytecomp-debug-msg
 109                  "cc-bytecomp-setup-environment: Covered variable %s"
 110                  (car p))))
 111           (setq p (cdr p)))
 112         (setq p cc-bytecomp-original-functions)
 113         (while p
 114           (let ((fun (car (car p)))
 115                 (temp-macro (car (cdr (car p)))))
 116             (if (not (fboundp fun))
 117                 (if temp-macro
 118                     (progn
 119                       (eval `(defmacro ,fun ,@temp-macro))
 120                       (cc-bytecomp-debug-msg
 121                        "cc-bytecomp-setup-environment: Bound macro %s" fun))
 122                   (fset fun (intern (concat "cc-bytecomp-ignore-fun:"
 123                                             (symbol-name fun))))
 124                   (cc-bytecomp-debug-msg
 125                    "cc-bytecomp-setup-environment: Covered function %s" fun))))
 126           (setq p (cdr p)))
 127         (setq p cc-bytecomp-original-properties)
 128         (while p
 129           (let ((sym (car (car (car p))))
 130                 (prop (cdr (car (car p))))
 131                 (tempdef (car (cdr (car p)))))
 132             (put sym prop tempdef)
 133             (cc-bytecomp-debug-msg
 134              "cc-bytecomp-setup-environment: Bound property %s for %s to %s"
 135              prop sym tempdef))
 136           (setq p (cdr p)))
 137         (setq cc-bytecomp-environment-set t)
 138         (cc-bytecomp-debug-msg
 139          "cc-bytecomp-setup-environment: Done"))))
 140
 141 (defun cc-bytecomp-restore-environment ()
 142   ;; Eval'ed during compilation to restore variables, functions etc
 143   ;; declared with `cc-bytecomp-defvar' et al.
 144   (if (not load-in-progress)
 145       (let (p)
 146         (setq p cc-bytecomp-unbound-variables)
 147         (while p
 148           (let ((var (car p)))
 149             (if (boundp var)
 150                 (if (eq (intern (concat "cc-bytecomp-ignore-var:"
 151                                         (symbol-name var)))
 152                         (symbol-value var))
 153                     (progn
 154                       (makunbound var)
 155                       (cc-bytecomp-debug-msg
 156                        "cc-bytecomp-restore-environment: Unbound variable %s"
 157                        var))
 158                   (cc-bytecomp-debug-msg
 159                    "cc-bytecomp-restore-environment: Not restoring variable %s"
 160                    var))))
 161           (setq p (cdr p)))
 162         (setq p cc-bytecomp-original-functions)
 163         (while p
 164           (let ((fun (car (car p)))
 165                 (temp-macro (car (cdr (car p))))
 166                 (def (car (cdr (cdr (car p))))))
 167             (if (fboundp fun)
 168                 (if (eq (or temp-macro
 169                             (intern (concat "cc-bytecomp-ignore-fun:"
 170                                             (symbol-name fun))))
 171                            (symbol-function fun))
 172                     (if (eq def 'unbound)
 173                         (progn
 174                           (fmakunbound fun)
 175                           (cc-bytecomp-debug-msg
 176                            "cc-bytecomp-restore-environment: Unbound function %s"
 177                            fun))
 178                       (fset fun def)
 179                       (cc-bytecomp-debug-msg
 180                        "cc-bytecomp-restore-environment: Restored function %s"
 181                        fun))
 182                   (cc-bytecomp-debug-msg
 183                    "cc-bytecomp-restore-environment: Not restoring function %s"
 184                    fun))))
 185           (setq p (cdr p)))
 186         (setq p cc-bytecomp-original-properties)
 187         (while p
 188           (let ((sym (car (car (car p))))
 189                 (prop (cdr (car (car p))))
 190                 (tempdef (car (cdr (car p))))
 191                 (origdef (cdr (cdr (car p)))))
 192             (if (eq (get sym prop) tempdef)
 193                 (progn
 194                   (put sym prop origdef)
 195                   (cc-bytecomp-debug-msg
 196                    "cc-bytecomp-restore-environment: Restored property %s for %s to %s"
 197                    prop sym origdef))
 198               (cc-bytecomp-debug-msg
 199                "cc-bytecomp-restore-environment: Not restoring property %s for %s"
 200                prop sym)))
 201           (setq p (cdr p)))
 202         (setq cc-bytecomp-environment-set nil)
 203         (cc-bytecomp-debug-msg
 204          "cc-bytecomp-restore-environment: Done"))))
 205
 206 (eval
 207  ;; This eval is to avoid byte compilation of the function below.
 208  ;; There's some bug in XEmacs 21.4.6 that can cause it to dump core
 209  ;; here otherwise.  My theory is that `cc-bytecomp-load' might be
 210  ;; redefined recursively during the `load' inside it, and if it in
 211  ;; that case is byte compiled then the byte interpreter gets
 212  ;; confused.  I haven't succeeded in isolating the bug, though. /mast
 213
 214  '(defun cc-bytecomp-load (cc-part)
 215     ;; Eval'ed during compilation to load a CC Mode file from the source
 216     ;; directory (assuming it's the same as the compiled file
 217     ;; destination dir).
 218     (if (and (boundp 'byte-compile-dest-file)
 219              (stringp byte-compile-dest-file))
 220         (progn
 221           (cc-bytecomp-restore-environment)
 222           (let ((load-path
 223                  (cons (file-name-directory byte-compile-dest-file)
 224                        load-path))
 225                 (cc-file (concat cc-part ".el")))
 226             (if (member cc-file cc-bytecomp-loaded-files)
 227                 ()
 228               (setq cc-bytecomp-loaded-files
 229                     (cons cc-file cc-bytecomp-loaded-files))
 230               (cc-bytecomp-debug-msg
 231                "cc-bytecomp-load: Loading %S" cc-file)
 232               (load cc-file nil t t)
 233               (cc-bytecomp-debug-msg
 234                "cc-bytecomp-load: Loaded %S" cc-file)))
 235           (cc-bytecomp-setup-environment)
 236           t))))
 237
 238 (defmacro cc-require (cc-part)
 239   "Force loading of the corresponding .el file in the current directory
 240 during compilation, but compile in a `require'.  Don't use within
 241 `eval-when-compile'.
 242
 243 Having cyclic cc-require's will result in infinite recursion.  That's
 244 somewhat intentional."
 245   `(progn
 246      (eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part)))
 247      (require ,cc-part)))
 248
 249 (defmacro cc-provide (feature)
 250   "A replacement for the `provide' form that restores the environment
 251 after the compilation.  Don't use within `eval-when-compile'."
 252   `(progn
 253      (eval-when-compile (cc-bytecomp-restore-environment))
 254      (provide ,feature)))
 255
 256 (defmacro cc-load (cc-part)
 257   "Force loading of the corresponding .el file in the current directory
 258 during compilation.  Don't use outside `eval-when-compile' or
 259 `eval-and-compile'.
 260
 261 Having cyclic cc-load's will result in infinite recursion.  That's
 262 somewhat intentional."
 263   `(or (and (featurep 'cc-bytecomp)
 264             (cc-bytecomp-load ,cc-part))
 265        (load ,cc-part nil t nil)))
 266
 267 (defmacro cc-require-when-compile (cc-part)
 268   "Force loading of the corresponding .el file in the current directory
 269 during compilation, but do a compile time `require' otherwise.  Don't
 270 use within `eval-when-compile'."
 271   `(eval-when-compile
 272      (if (and (featurep 'cc-bytecomp)
 273               (cc-bytecomp-is-compiling))
 274          (if (or (not load-in-progress)
 275                  (not (featurep ,cc-part)))
 276              (cc-bytecomp-load (symbol-name ,cc-part)))
 277        (require ,cc-part))))
 278
 279 (defmacro cc-external-require (feature)
 280   "Do a `require' of an external package.
 281 This restores and sets up the compilation environment before and
 282 afterwards.  Don't use within `eval-when-compile'."
 283   `(progn
 284      (eval-when-compile (cc-bytecomp-restore-environment))
 285      (require ,feature)
 286      (eval-when-compile (cc-bytecomp-setup-environment))))
 287
 288 (defun cc-bytecomp-is-compiling ()
 289   "Return non-nil if eval'ed during compilation.  Don't use outside
 290 `eval-when-compile'."
 291   (and (boundp 'byte-compile-dest-file)
 292        (stringp byte-compile-dest-file)))
 293
 294 (defmacro cc-bytecomp-defvar (var)
 295   "Binds the symbol as a variable during compilation of the file,
 296 to silence the byte compiler.  Don't use within `eval-when-compile'."
 297   `(eval-when-compile
 298      (if (boundp ',var)
 299          (cc-bytecomp-debug-msg
 300           "cc-bytecomp-defvar: %s bound already as variable" ',var)
 301        (if (not (memq ',var cc-bytecomp-unbound-variables))
 302            (progn
 303              (cc-bytecomp-debug-msg
 304               "cc-bytecomp-defvar: Saving %s (as unbound)" ',var)
 305              (setq cc-bytecomp-unbound-variables
 306                    (cons ',var cc-bytecomp-unbound-variables))))
 307        (if (and (cc-bytecomp-is-compiling)
 308                 (not load-in-progress))
 309            (progn
 310              (defvar ,var)
 311              (set ',var (intern (concat "cc-bytecomp-ignore-var:"
 312                                         (symbol-name ',var))))
 313              (cc-bytecomp-debug-msg
 314               "cc-bytecomp-defvar: Covered variable %s" ',var))))))
 315
 316 (defmacro cc-bytecomp-defun (fun)
 317   "Bind the symbol as a function during compilation of the file,
 318 to silence the byte compiler.  Don't use within `eval-when-compile'.
 319
 320 If the symbol already is bound as a function, it will keep that
 321 definition.  That means that this macro will not shut up warnings
 322 about incorrect number of arguments.  It's dangerous to try to replace
 323 existing functions since the byte compiler might need the definition
 324 at compile time, e.g. for macros and inline functions."
 325   `(eval-when-compile
 326      (if (fboundp ',fun)
 327          (cc-bytecomp-debug-msg
 328           "cc-bytecomp-defun: %s bound already as function" ',fun)
 329        (if (not (assq ',fun cc-bytecomp-original-functions))
 330            (progn
 331              (cc-bytecomp-debug-msg
 332               "cc-bytecomp-defun: Saving %s (as unbound)" ',fun)
 333              (setq cc-bytecomp-original-functions
 334                    (cons (list ',fun nil 'unbound)
 335                          cc-bytecomp-original-functions))))
 336        (if (and (cc-bytecomp-is-compiling)
 337                 (not load-in-progress))
 338            (progn
 339              (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:"
 340                                          (symbol-name ',fun))))
 341              (cc-bytecomp-debug-msg
 342               "cc-bytecomp-defun: Covered function %s" ',fun))))))
 343
 344 (put 'cc-bytecomp-defmacro 'lisp-indent-function 'defun)
 345 (defmacro cc-bytecomp-defmacro (fun &rest temp-macro)
 346   "Bind the symbol as a macro during compilation (and evaluation) of the
 347 file.  Don't use outside `eval-when-compile'."
 348   `(let ((orig-fun (assq ',fun cc-bytecomp-original-functions)))
 349      (if (not orig-fun)
 350          (setq orig-fun
 351                (list ',fun
 352                      nil
 353                      (if (fboundp ',fun)
 354                          (progn
 355                            (cc-bytecomp-debug-msg
 356                             "cc-bytecomp-defmacro: Saving %s" ',fun)
 357                            (symbol-function ',fun))
 358                        (cc-bytecomp-debug-msg
 359                         "cc-bytecomp-defmacro: Saving %s as unbound" ',fun)
 360                        'unbound))
 361                cc-bytecomp-original-functions
 362                (cons orig-fun cc-bytecomp-original-functions)))
 363      (defmacro ,fun ,@temp-macro)
 364      (cc-bytecomp-debug-msg
 365       "cc-bytecomp-defmacro: Bound macro %s" ',fun)
 366      (setcar (cdr orig-fun) (symbol-function ',fun))))
 367
 368 (defmacro cc-bytecomp-put (symbol propname value)
 369   "Set a property on a symbol during compilation (and evaluation) of
 370 the file.  Don't use outside `eval-when-compile'."
 371   `(eval-when-compile
 372      (if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
 373          (progn
 374            (cc-bytecomp-debug-msg
 375             "cc-bytecomp-put: Saving property %s for %s with value %s"
 376             ,propname ,symbol (get ,symbol ,propname))
 377            (setq cc-bytecomp-original-properties
 378                  (cons (cons (cons ,symbol ,propname)
 379                              (cons ,value (get ,symbol ,propname)))
 380                        cc-bytecomp-original-properties))))
 381      (put ,symbol ,propname ,value)
 382      (cc-bytecomp-debug-msg
 383       "cc-bytecomp-put: Bound property %s for %s to %s"
 384       ,propname ,symbol ,value)))
 385
 386 (defmacro cc-bytecomp-obsolete-var (symbol)
 387   "Suppress warnings that the given symbol is an obsolete variable.
 388 Don't use within `eval-when-compile'."
 389   `(eval-when-compile
 390      (if (get ',symbol 'byte-obsolete-variable)
 391          (cc-bytecomp-put ',symbol 'byte-obsolete-variable nil)
 392        ;; This avoids a superfluous compiler warning
 393        ;; about calling `get' for effect.
 394        t)))
 395
 396 (defun cc-bytecomp-ignore-obsolete (form)
 397   ;; Wraps a call to `byte-compile-obsolete' that suppresses the warning.
 398   (let ((byte-compile-warnings byte-compile-warnings))
 399     (byte-compile-disable-warning 'obsolete)
 400     (byte-compile-obsolete form)))
 401
 402 (defmacro cc-bytecomp-obsolete-fun (symbol)
 403   "Suppress warnings that the given symbol is an obsolete function.
 404 Don't use within `eval-when-compile'."
 405   `(eval-when-compile
 406      (if (eq (get ',symbol 'byte-compile) 'byte-compile-obsolete)
 407          (cc-bytecomp-put ',symbol 'byte-compile
 408                           'cc-bytecomp-ignore-obsolete)
 409        ;; This avoids a superfluous compiler warning
 410        ;; about calling `get' for effect.
 411        t)))
 412
 413 (defmacro cc-bytecomp-boundp (symbol)
 414   "Return non-nil if the given symbol is bound as a variable outside
 415 the compilation.  This is the same as using `boundp' but additionally
 416 exclude any variables that have been bound during compilation with
 417 `cc-bytecomp-defvar'."
 418   (if (and (cc-bytecomp-is-compiling)
 419            (memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
 420       nil
 421     `(boundp ,symbol)))
 422
 423 (defmacro cc-bytecomp-fboundp (symbol)
 424   "Return non-nil if the given symbol is bound as a function outside
 425 the compilation.  This is the same as using `fboundp' but additionally
 426 exclude any functions that have been bound during compilation with
 427 `cc-bytecomp-defun'."
 428   (let (fun-elem)
 429     (if (and (cc-bytecomp-is-compiling)
 430              (setq fun-elem (assq (car (cdr symbol))
 431                                   cc-bytecomp-original-functions))
 432              (eq (elt fun-elem 2) 'unbound))
 433         nil
 434       `(fboundp ,symbol))))
 435
 436 \f
 437 (provide 'cc-bytecomp)
 438
 439 ;; arch-tag: 2d71b3ad-57b0-4b13-abd3-ab836e08f975
 440 ;;; cc-bytecomp.el ends here