changeset 8735:d1f0811de024

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/emacs-lisp/elp.el	Wed Sep 14 09:03:27 1994 +0000
@@ -0,0 +1,493 @@
+;;; elp.el --- Emacs Lisp Profiler
+
+;; Author: 1994 Barry A. Warsaw, Century Computing, Inc. <[e-mail]>
+;; Maintainer:    [e-mail]
+;; Created:       26-Feb-1994
+;; Version:       2.11
+;; Last Modified: 1994/06/06 22:38:07
+;; Keywords:      Emacs Lisp Profile Timing
+
+;; Copyright (C) 1994 Barry A. Warsaw
+
+;; This file is not yet part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; LCD Archive Entry:
+;; elp|Barry A. Warsaw|[e-mail]|
+;; Emacs Lisp Profiler|
+;; 1994/06/06 22:38:07|2.11|~/misc/elp.el.Z|
+
+;;; Commentary:
+;;
+;; This program is based on the only two existing Emacs Lisp profilers
+;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's
+;; profiler.el. Both were written for Emacs 18 and both were pretty
+;; good first shots at profiling, but I found that they didn't provide
+;; the functionality or interface that I wanted.  So I wrote this.
+;; I've tested elp in Lucid Emacs 19.9 and in Emacs 19.22. There's no
+;; point in even trying to make this work with Emacs 18.
+
+;; Unlike previous profilers, elp uses Emacs 19's built-in function
+;; current-time to return interval times.  This obviates the need for
+;; both an external C program and Emacs processes to communicate with
+;; such a program, and thus simplifies the package as a whole.  One
+;; small shortcut: I throw away the most significant 16 bits of
+;; seconds returned by current-time since I doubt anyone will ever
+;; want to profile stuff on the order of 18 hours.  2^16 == 65536
+;; seconds == ~1092 minutes == ~18 hours.
+
+;; Note that there are plenty of factors that could make the times
+;; reported unreliable, including the accuracy and granularity of your
+;; system clock, and the overhead spent in lisp calculating and
+;; recording the intervals.  The latter I figure is pretty constant
+;; so, while the times may not be entirely accurate, I think they'll
+;; give you a good feel for the relative amount of work spent in the
+;; various lisp routines you are profiling.  Note further that times
+;; are calculated using wall-clock time, so other system load will
+;; affect accuracy too.
+
+;; There are only 3 variables you can change to customize behavior of
+;; elp. See below for their description.
+;;
+;; Here is a list of the interactive commands you can use:
+;;   elp-instrument-function
+;;   elp-restore-function
+;;   elp-instrument-list
+;;   elp-restore-list
+;;   elp-restore-all
+;;   elp-reset-function
+;;   elp-reset-list
+;;   elp-reset-all
+;;   elp-results
+;;   elp-submit-bug-report
+;;
+;; Here are some brief usage notes.  If you want to profile a bunch of
+;; functions, set elp-function-list to the list of symbols, then call
+;; elp-instrument-list.  This hacks the functions so that profiling
+;; information is recorded whenever they are called.  To print out the
+;; current results, use elp-results.  With elp-reset-after-results set
+;; to non-nil, profiling information will be reset whenever the
+;; results are displayed, but you can reset all profiling info with
+;; elp-reset-all.
+;;
+;; If you want to sort the results, set elp-sort-by-function to some
+;; predicate function.  The three most obvious choices are predefined:
+;; elp-sort-by-call-count, elp-sort-by-average-time, and
+;; elp-sort-by-total-time.
+;;
+;; Elp can instrument byte-compiled functions just as easily as
+;; interpreted functions.  However, when you redefine a function (e.g.
+;; with eval-defun), you'll need to re-instrument it with
+;; elp-instrument-function.  Re-instrumenting resets profiling
+;; information for that function.  Elp can also handle interactive
+;; functions (i.e. commands), but of course any time spent idling for
+;; user prompts will show up in the timing results.
+;;
+;; You can also designate a `master' function.  Profiling times will
+;; be gathered for instrumented functions only during execution of
+;; this master function.  Thus, if you have some defuns like:
+;;
+;;  (defun foo () (do-something-time-intensive))
+;;  (defun bar () (foo))
+;;  (defun baz () (bar) (foo))
+;;
+;; and you want to find out the amount of time spent in bar and foo,
+;; but only during execution of bar, make bar the master and the call
+;; of foo from baz will not add to foo's total timing sums.  Use
+;; elp-set-master and elp-unset-master to utilize this feature.  Only
+;; one master function can be used at a time.
+
+;; You can restore any function's original function definition with
+;; elp-restore-function.  The other instrument, restore, and reset
+;; functions are provided for symmetry.
+
+;;; Code:
+
+
+;; start user configuration variables
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+
+(defvar elp-function-list nil
+  "*List of function to profile.")
+
+(defvar elp-reset-after-results t
+  "*Non-nil means reset all profiling info after results are displayed.
+Results are displayed with the `elp-results' command.")
+
+(defvar elp-sort-by-function nil
+  "*Non-nil specifies elp results sorting function.
+These functions are currently available:
+
+  elp-sort-by-call-count   -- sort by the highest call count
+  elp-sort-by-total-time   -- sort by the highest total time
+  elp-sort-by-average-time -- sort by the highest average times
+
+You can write you're own sort function. It should adhere to the
+interface specified by the PRED argument for the `sort' defun.  Each
+\"element of LIST\" is really a 4 element vector where element 0 is
+the call count, element 1 is the total time spent in the function,
+element 2 is the average time spent in the function, and element 3 is
+the symbol's name string.")
+
+
+;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+;; end user configuration variables
+
+
+(defconst elp-version "2.11"
+  "ELP version number.")
+
+(defconst elp-help-address "[e-mail]"
+  "Address accepting submissions of bug reports and questions.")
+
+(defvar elp-results-buffer "*ELP Profiling Results*"
+  "Buffer name for outputting profiling results.")
+
+(defconst elp-timer-info-property 'elp-info
+  "ELP information property name.")
+
+(defvar elp-all-instrumented-list nil
+  "List of all functions currently being instrumented.")
+
+(defvar elp-record-p t
+  "Controls whether functions should record times or not.
+This variable is set by the master function.")
+
+(defvar elp-master nil
+  "Master function symbol.")
+
+
+(defun elp-instrument-function (funsym)
+  "Instrument FUNSYM for profiling.
+FUNSYM must be a symbol of a defined function."
+  (interactive "aFunction to instrument: ")
+  ;; TBD what should we do if the function is already instrumented???
+  (let* ((funguts (symbol-function funsym))
+	 (infovec (vector 0 0 funguts))
+	 (newguts '(lambda (&rest args))))
+    ;; put rest of newguts together
+    (if (commandp funsym)
+	(setq newguts (append newguts '((interactive)))))
+    (setq newguts (append newguts (list
+				   (list 'elp-wrapper
+					 (list 'quote funsym)
+					 (list 'and
+					       '(interactive-p)
+					       (not (not (commandp funsym))))
+					 'args))))
+    ;; to record profiling times, we set the symbol's function
+    ;; definition so that it runs the elp-wrapper function with the
+    ;; function symbol as an argument.  We place the old function
+    ;; definition on the info vector.
+    ;;
+    ;; The info vector data structure is a 3 element vector.  The 0th
+    ;; element is the call-count, i.e. the total number of times this
+    ;; function has been entered.  This value is bumped up on entry to
+    ;; the function so that non-local exists are still recorded. TBD:
+    ;; I haven't tested non-local exits at all, so no guarantees.
+    ;;
+    ;; The 1st element is the total amount of time in usecs that have
+    ;; been spent inside this function.  This number is added to on
+    ;; function exit.
+    ;;
+    ;; The 2nd element is the old function definition list.  This gets
+    ;; funcall'd in between start/end time retrievals. I believe that
+    ;; this lets us profile even byte-compiled functions.
+
+    ;; put the info vector on the property list
+    (put funsym elp-timer-info-property infovec)
+
+    ;; set the symbol's new profiling function definition to run
+    ;; elp-wrapper
+    (fset funsym newguts)
+
+    ;; add this function to the instrumentation list
+    (or (memq funsym elp-all-instrumented-list)
+	(setq elp-all-instrumented-list
+	      (cons funsym elp-all-instrumented-list)))
+    ))
+
+(defun elp-restore-function (funsym)
+  "Restore an instrumented function to its original definition.
+Argument FUNSYM is the symbol of a defined function."
+  (interactive "aFunction to restore: ")
+  (let ((info (get funsym elp-timer-info-property)))
+    ;; delete the function from the all instrumented list
+    (setq elp-all-instrumented-list
+	  (delq funsym elp-all-instrumented-list))
+
+    ;; if the function was the master, reset the master
+    (if (eq funsym elp-master)
+	(setq elp-master nil
+	      elp-record-p t))
+
+    ;; zap the properties
+    (put funsym elp-timer-info-property nil)
+
+    ;; restore the original function definition, but if the function
+    ;; wasn't instrumented do nothing.  we do this after the above
+    ;; because its possible the function got un-instrumented due to
+    ;; circumstances beyond our control.  Also, check to make sure
+    ;; that the current function symbol points to elp-wrapper.  If
+    ;; not, then the user probably did an eval-defun while the
+    ;; function was instrumented and we don't want to destroy the new
+    ;; definition.
+    (and info
+	 (assq 'elp-wrapper (symbol-function funsym))
+	 (fset funsym (aref info 2)))))
+
+(defun elp-instrument-list (&optional list)
+  "Instrument for profiling, all functions in `elp-function-list'.
+Use optional LIST if provided instead."
+  (interactive "PList of functions to instrument: ")
+  (let ((list (or list elp-function-list)))
+    (mapcar 'elp-instrument-function list)))
+
+(defun elp-restore-list (&optional list)
+  "Restore the original definitions for all functions in `elp-function-list'.
+Use optional LIST if provided instead."
+  (interactive "PList of functions to restore: ")
+  (let ((list (or list elp-function-list)))
+    (mapcar 'elp-restore-function list)))
+
+(defun elp-restore-all ()
+  "Restores the original definitions of all functions being profiled."
+  (interactive)
+  (elp-restore-list elp-all-instrumented-list))
+
+
+(defun elp-reset-function (funsym)
+  "Reset the profiling information for FUNSYM."
+  (interactive "aFunction to reset: ")
+  (let ((info (get funsym elp-timer-info-property)))
+    (or info
+	(error "%s is not instrumented for profiling." funsym))
+    (aset info 0 0)			;reset call counter
+    (aset info 1 0.0)			;reset total time
+    ;; don't muck with aref 2 as that is the old symbol definition
+    ))
+
+(defun elp-reset-list (&optional list)
+  "Reset the profiling information for all functions in `elp-function-list'.
+Use optional LIST if provided instead."
+  (interactive "PList of functions to reset: ")
+  (let ((list (or list elp-function-list)))
+    (mapcar 'elp-reset-function list)))
+
+(defun elp-reset-all ()
+  "Reset the profiling information for all functions being profiled."
+  (interactive)
+  (elp-reset-list elp-all-instrumented-list))
+
+(defun elp-set-master (funsym)
+  "Set the master function for profiling."
+  (interactive "aMaster function: ")
+  ;; when there's a master function, recording is turned off by
+  ;; default
+  (setq elp-master funsym
+	elp-record-p nil)
+  ;; make sure master function is instrumented
+  (or (memq funsym elp-all-instrumented-list)
+      (elp-instrument-function funsym)))
+
+(defun elp-unset-master ()
+  "Unsets the master function."
+  ;; when there's no master function, recording is turned on by default.
+  (setq elp-master nil
+	elp-record-p t))
+
+
+(defsubst elp-get-time ()
+  ;; get current time in seconds and microseconds. I throw away the
+  ;; most significant 16 bits of seconds since I doubt we'll ever want
+  ;; to profile lisp on the order of 18 hours. See notes at top of file.
+  (let ((now (current-time)))
+    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
+
+(defun elp-wrapper (funsym interactive-p args)
+  "This function has been instrumented for profiling by the ELP.
+ELP is the Emacs Lisp Profiler.  To restore the function to its
+original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
+  ;; turn on recording if this is the master function
+  (if (and elp-master
+	   (eq funsym elp-master))
+      (setq elp-record-p t))
+  ;; get info vector and original function symbol
+  (let* ((info (get funsym elp-timer-info-property))
+	 (func (aref info 2))
+	 result)
+    (or func
+	(error "%s is not instrumented for profiling." funsym))
+    (if (not elp-record-p)
+	;; when not recording, just call the original function symbol
+	;; and return the results.
+	(setq result
+	      (if interactive-p
+		  (call-interactively func)
+		(apply func args)))
+      ;; we are recording times
+      (let ((enter-time (elp-get-time)))
+	;; increment the call-counter
+	(aset info 0 (1+ (aref info 0)))
+	;; now call the old symbol function, checking to see if it
+	;; should be called interactively.  make sure we return the
+	;; correct value
+	(setq result
+	      (if interactive-p
+		  (call-interactively func)
+		(apply func args)))
+	;; calculate total time in function
+	(aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time)))
+	))
+    ;; turn off recording if this is the master function
+    (if (and elp-master
+	     (eq funsym elp-master))
+	(setq elp-record-p nil))
+    result))
+
+
+;; shut the byte-compiler up
+(defvar elp-field-len nil)
+(defvar elp-cc-len nil)
+(defvar elp-at-len nil)
+(defvar elp-et-len nil)
+
+(defun elp-sort-by-call-count (vec1 vec2)
+  ;; sort by highest call count.  See `sort'.
+  (>= (aref vec1 0) (aref vec2 0)))
+
+(defun elp-sort-by-total-time (vec1 vec2)
+  ;; sort by highest total time spent in function. See `sort'.
+  (>= (aref vec1 1) (aref vec2 1)))
+
+(defun elp-sort-by-average-time (vec1 vec2)
+  ;; sort by highest average time spent in function. See `sort'.
+  (>= (aref vec1 2) (aref vec2 2)))
+
+(defun elp-output-result (resultvec)
+  ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
+  ;; more element vector where aref 0 is the call count, aref 1 is the
+  ;; total time spent in the function, aref 2 is the average time
+  ;; spent in the function, and aref 3 is the symbol's string
+  ;; name. All other elements in the vector are ignored.
+  (let* ((cc (aref resultvec 0))
+	 (tt (aref resultvec 1))
+	 (at (aref resultvec 2))
+	 (symname (aref resultvec 3))
+	 callcnt totaltime avetime)
+    (insert symname)
+    (insert-char 32 (+ elp-field-len (- (length symname)) 2))
+    (setq callcnt (number-to-string cc)
+	  totaltime (number-to-string tt)
+	  avetime (number-to-string at))
+    ;; print stuff out, formatting it nicely
+    (insert callcnt)
+    (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
+    (if (> (length totaltime) elp-et-len)
+	(insert (substring totaltime 0 elp-et-len) "  ")
+      (insert totaltime)
+      (insert-char 32 (+ elp-et-len (- (length totaltime)) 2)))
+    (if (> (length avetime) elp-at-len)
+	(insert (substring avetime 0 elp-at-len))
+      (insert avetime))
+    (insert "\n")))
+
+(defun elp-results ()
+  "Display current profiling results.
+If `elp-reset-after-results' is non-nil, then current profiling
+information for all instrumented functions are reset after results are
+displayed."
+  (interactive)
+  (let ((curbuf (current-buffer))
+	(resultsbuf (get-buffer-create elp-results-buffer)))
+    (set-buffer resultsbuf)
+    (erase-buffer)
+    (beginning-of-buffer)
+    ;; get the length of the longest function name being profiled
+    (let* ((longest 0)
+	   (title "Function Name")
+	   (titlelen (length title))
+	   (elp-field-len titlelen)
+	   (cc-header "Call Count")
+	   (elp-cc-len    (length cc-header))
+	   (et-header "Elapsed Time")
+	   (elp-et-len    (length et-header))
+	   (at-header "Average Time")
+	   (elp-at-len    (length at-header))
+	   (resvec
+	    (mapcar
+	     (function
+	      (lambda (funsym)
+		(let* ((info (get funsym elp-timer-info-property))
+		       (symname (format "%s" funsym))
+		       (cc (aref info 0))
+		       (tt (aref info 1)))
+		  (if (not info)
+		      (insert "No profiling information found for: "
+			      symname)
+		    (setq longest (max longest (length symname)))
+		    (vector cc tt (if (zerop cc)
+				      0.0 ;avoid arithmetic div-by-zero errors
+				    (/ (float tt) (float cc)))
+			    symname)))))
+	     elp-all-instrumented-list))
+	   )				; end let*
+      (insert title)
+      (if (> longest titlelen)
+	  (progn
+	    (insert-char 32 (- longest titlelen))
+	    (setq elp-field-len longest)))
+      (insert "  " cc-header "  " et-header "  " at-header "\n")
+      (insert-char ?= elp-field-len)
+      (insert "  ")
+      (insert-char ?= elp-cc-len)
+      (insert "  ")
+      (insert-char ?= elp-et-len)
+      (insert "  ")
+      (insert-char ?= elp-at-len)
+      (insert "\n")
+      ;; if sorting is enabled, then sort the results list. in either
+      ;; case, call elp-output-result to output the result in the
+      ;; buffer
+      (if elp-sort-by-function
+	  (setq resvec (sort resvec elp-sort-by-function)))
+      (mapcar 'elp-output-result resvec))
+    ;; now pop up results buffer
+    (set-buffer curbuf)
+    (pop-to-buffer resultsbuf)
+    ;; reset profiling info if desired
+    (and elp-reset-after-results
+	 (elp-reset-all))))
+
+
+(eval-when-compile
+ (require 'reporter))
+
+(defun elp-submit-bug-report ()
+  "Submit via mail, a bug report on elp."
+  (interactive)
+  (and
+   (y-or-n-p "Do you want to submit a report on elp? ")
+   (require 'reporter)
+   (reporter-submit-bug-report
+    elp-help-address (concat "elp " elp-version)
+    '(elp-reset-after-results
+      elp-sort-by-function))))
+
+
+(provide 'elp)
+;; elp.el ends here
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/progmodes/cpp.el	Wed Sep 14 09:03:27 1994 +0000
@@ -0,0 +1,773 @@
+;;; cpp.el --- Highlight or hide text according to cpp conditionals.
+
+;; Copyright (C) 1994 Free Software Foundation
+
+;; Author: Per Abrahamsen <[e-mail]>
+;; Version: $Id: 0.2 ALPHA RELEASE WITH BUGS $
+;; Keywords: c, faces, tools
+
+;; LCD Archive Entry:
+;; cpp|Per Abrahamsen|[e-mail]|
+;; Highlight or hide text according to cpp conditionals|
+;; $Date: 1994-07-20 $|$Revision: 0.2 $|~/misc/cpp.Z|
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Comments:
+
+;; Parse a text for C preprocessor conditionals, and highlight or hide
+;; the text inside the conditionals as you wish.
+
+;; Insert the following in your `emacs' to activate it.  This assumes
+;; you use BAW's superior cc-mode instead of Boring Old C-Mode.
+
+;; (autoload 'cpp-parse-buffer "cpp" "Parse and display cpp conditionals." t)
+  
+;; (eval-after-load "cc-mode"
+;;   '(progn
+;;      (define-key c-mode-map "\C-c\C-x" 'cpp-parse-buffer)
+;;      (define-key-after (bar (lookup-key c-mode-map [ menu-bar c ]))
+;;        [ cpp-parse ] '("Parse Conditionals" . cpp-parse-buffer) 'up))))
+
+;; Requires GNU Emacs 19.
+
+;;; Todo:
+
+;; Should parse "#if" and "#elif" expressions and merge the faces
+;; somehow. 
+
+;; Somehow it is sometimes possible to make changes near a read only
+;; area which you can't undo.  Their are other strange effects in that
+;; area.
+
+;; The Edit buffer should -- optionally -- appear in its own frame.
+
+;; Conditionals seem to be rear-sticky.  They shouldn't be.
+
+;; Restore window configurations when exiting CPP Edit buffer.
+
+;;; Code:
+
+;;; Customization:
+
+(defvar cpp-known-face 'invisible
+  "*Face used for known cpp symbols.")
+
+(defvar cpp-unknown-face 'highlight
+  "*Face used for unknown cpp cymbols.")
+
+(defvar cpp-face-type 'light 
+  "*Indicate what background face type you prefer.
+Can be either light or dark for color screens, mono for monochrome
+screens, and none if you don't use a window system.")
+
+(defvar cpp-known-writable t
+  "*Non-nil means you are allowed to modify the known conditionals.")
+
+(defvar cpp-unknown-writable t
+  "*Non-nil means you are allowed to modify the unknown conditionals.")
+
+;;; Parse Buffer:
+
+(defvar cpp-parse-symbols nil
+  "List of cpp macros used in the local buffer.")
+(make-variable-buffer-local 'cpp-parse-symbols)
+
+(defconst cpp-parse-regexp
+  ;; Regexp matching all tokens needed to find conditionals.
+  (concat
+   "'\\|\"\\|/\\*\\|//\\|"
+   "\\(^[ \t]*#[ \t]*\\(ifdef\\|ifndef\\|if\\|"
+   "elif\\|else\\|endif\\)\\b\\)"))
+
+;;;###autoload
+(defun cpp-parse-buffer (arg)
+  "Parse all conditionals in the current buffer end edit symbols.
+A prefix arg supress editing the symbols."
+  (interactive "P")
+  (setq cpp-parse-symbols nil)
+  (cpp-parse-reset)
+  (if (null cpp-edit-list)
+      (cpp-edit-load))
+  (let (stack)
+    (save-excursion
+      (goto-char (point-min))
+      (cpp-progress-message "Parsing...")
+      (while (re-search-forward cpp-parse-regexp nil t)
+	(cpp-progress-message "Parsing...%d%%"
+			  (/ (* 100 (- (point) (point-min))) (buffer-size)))
+	(let ((match (buffer-substring (match-beginning 0) (match-end 0))))
+	  (cond ((or (string-equal match "'")
+		     (string-equal match "\""))
+		 (goto-char (match-beginning 0))
+		 (condition-case nil
+		     (forward-sexp)
+		   (error (cpp-parse-error
+			   "Unterminated string or character"))))
+		((string-equal match "/*")
+		 (or (search-forward "*/" nil t)
+		     (error "Unterminated comment")))
+		((string-equal match "//")
+		 (skip-chars-forward "^\n\r"))
+		(t
+		 (end-of-line 1)
+		 (let ((from (match-beginning 1))
+		       (to (1+ (point)))
+		       (type (buffer-substring (match-beginning 2)
+					       (match-end 2)))
+		       (expr (buffer-substring (match-end 1) (point))))
+		   (cond ((string-equal type "ifdef")
+			  (cpp-parse-open t expr from to))
+			 ((string-equal type "ifndef")
+			  (cpp-parse-open nil expr from to))
+			 ((string-equal type "if")
+			  (cpp-parse-open t expr from to))
+			 ((string-equal type "elif")
+			  (let (cpp-known-face cpp-unknown-face)
+			    (cpp-parse-close from to))
+			  (cpp-parse-open t expr from to))
+			 ((string-equal type "else")
+			  (or stack (cpp-parse-error "Top level #else"))
+			  (let ((entry (list (not (nth 0 (car stack)))
+					     (nth 1 (car stack))
+					     from to)))
+			    (cpp-parse-close from to)
+			    (setq stack (cons entry stack))))
+			 ((string-equal type "endif")
+			  (cpp-parse-close from to))
+			 (t
+			  (cpp-parse-error "Parser error"))))))))
+      (message "Parsing...done"))
+    (if stack
+      (save-excursion
+	(goto-char (nth 3 (car stack)))
+	(cpp-parse-error "Unclosed conditional"))))
+  (or arg
+      (null cpp-parse-symbols)
+      (cpp-parse-edit)))
+
+(defun cpp-parse-open (branch expr begin end)
+  ;; Push information about conditional to stack.
+  (while (string-match "\\b[ \t]*/\\*.*\\*/[ \t]*\\b" expr)
+    (setq expr (concat (substring expr 0 (match-beginning 0))
+		       (substring expr (match-end 0)))))
+  (if (string-match "\\b[ \t]*\\(//.*\\)?$" expr)
+      (setq expr (substring expr 0 (match-beginning 0))))
+  (while (string-match "[ \t]+" expr)
+      (setq expr (concat (substring expr 0 (match-beginning 0))
+			 (substring expr (match-end 0)))))
+  (setq stack (cons (list branch expr begin end) stack))
+  (or (member expr cpp-parse-symbols)
+      (setq cpp-parse-symbols
+	    (cons expr cpp-parse-symbols)))
+  (if (assoc expr cpp-edit-list)
+      (cpp-make-known-overlay begin end)
+    (cpp-make-unknown-overlay begin end)))
+
+(defun cpp-parse-close (from to)
+  ;; Pop top of stack and create overlay.
+  (let ((entry (assoc (nth 1 (car stack)) cpp-edit-list))
+	(branch (nth 0 (car stack)))
+	(begin (nth 2 (car stack)))
+	(end (nth 3 (car stack))))
+    (setq stack (cdr stack))
+    (if entry
+	(let ((face (nth (if branch 1 2) entry))
+	      (read-only (eq (not branch) (nth 3 entry)))
+	      (priority (length stack))
+	      (overlay (make-overlay end from)))
+	  (cpp-make-known-overlay from to)
+	  (setq cpp-overlay-list (cons overlay cpp-overlay-list))
+	  (if priority (overlay-put overlay 'priority priority))
+	  (cond ((eq face 'invisible)
+		 (cpp-make-overlay-hidden overlay))
+		((eq face 'default))
+		(t
+		 (overlay-put overlay 'face face)))
+	  (if read-only
+	      (cpp-make-overlay-read-only overlay)
+	    (cpp-make-overlay-sticky overlay)))
+      (cpp-make-unknown-overlay from to))))
+
+(defun cpp-parse-error (error)
+  ;; Error message issued by the cpp parser.
+  (error (concat error " at line %d") (count-lines (point-min) (point))))
+
+(defun cpp-parse-reset ()
+  "Reset display of cpp conditionals to normal."
+  (interactive)
+  (while cpp-overlay-list
+    (delete-overlay (car cpp-overlay-list))
+    (setq cpp-overlay-list (cdr cpp-overlay-list))))
+
+;;;###autoload
+(defun cpp-parse-edit ()
+  "Edit display information for cpp conditionals."
+  (interactive)
+  (or cpp-parse-symbols
+      (cpp-parse-buffer t))
+  (let ((buffer (current-buffer)))
+    (pop-to-buffer "*CPP Edit*")
+    (cpp-edit-mode)
+    (setq cpp-edit-buffer buffer)
+    (cpp-edit-reset)))
+
+;;; Overlays:
+
+(defvar cpp-overlay-list nil)
+;; List of cpp overlays active in the current buffer.
+(make-variable-buffer-local 'cpp-overlay-list)
+
+(defun cpp-make-known-overlay (start end)
+  ;; Create an overlay for a known cpp command from START to END.
+  (let ((overlay (make-overlay start end)))
+    (if (eq cpp-known-face 'invisible)
+	(cpp-make-overlay-hidden overlay)
+      (or (eq cpp-known-face 'default)
+	  (overlay-put overlay 'face cpp-known-face))
+      (if cpp-known-writable
+	  ()
+	(overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
+	(overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))))
+    (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
+
+(defun cpp-make-unknown-overlay (start end)
+  ;; Create an overlay for an unknown cpp command from START to END.
+  (let ((overlay (make-overlay start end)))
+    (cond ((eq cpp-unknown-face 'invisible)
+	   (cpp-make-overlay-hidden overlay))
+	  ((eq cpp-unknown-face 'default))
+	  (t 
+	   (overlay-put overlay 'face cpp-unknown-face)))
+    (if cpp-unknown-writable
+	()
+      (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
+      (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))
+    (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
+
+(defun cpp-make-overlay-hidden (overlay)
+  ;; Make overlay hidden and intangible.
+  (overlay-put overlay 'invisible t)
+  (overlay-put overlay 'intangible t)
+  ;; Unfortunately `intangible' is not implemented for overlays yet,
+  ;; so we make is read-only instead.
+  (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)))
+
+(defun cpp-make-overlay-read-only (overlay)
+  ;; Make overlay read only.
+  (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
+  (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))
+  (overlay-put overlay 'insert-behind-hooks '(cpp-signal-read-only)))
+
+(defun cpp-make-overlay-sticky (overlay)
+  ;; Make OVERLAY grow when you insert text at either end.
+  (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay))
+  (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay)))
+
+(defun cpp-signal-read-only (overlay start end)
+  ;; Only allow deleting the whole overlay.
+  ;; Trying to change a read-only overlay.
+  (if (or (< (overlay-start overlay) start)
+	  (> (overlay-end overlay) end))
+      (error "This text is read only")))
+
+(defun cpp-grow-overlay (overlay start end)
+  ;; Make OVERLAY grow to contain range START to END.
+  (move-overlay overlay
+		(min start (overlay-start overlay))
+		(max end (overlay-end overlay))))
+
+;;; Edit Buffer:
+
+(defvar cpp-edit-list nil
+  "Alist of cpp macros and information about how they should be displayed.
+Each entry is a list with the following elements:
+0. The name of the macro (a string).
+1. Face used for text that is `ifdef' the macro.
+2. Face used for text that is `ifndef' the macro.
+3. `t', `nil', or `both' depending on what text may be edited.")
+
+(defvar cpp-edit-map nil)
+;; Keymap for `cpp-edit-mode'.
+
+(if cpp-edit-map
+    ()
+  (setq cpp-edit-map (make-keymap))
+  (suppress-keymap cpp-edit-map)
+  (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button)
+  (define-key cpp-edit-map [ mouse-2 ] 'ignore)
+  (define-key cpp-edit-map " " 'scroll-up)
+  (define-key cpp-edit-map "\C-?" 'scroll-down)
+  (define-key cpp-edit-map [ delete ] 'scroll-down)
+  (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply)
+  (define-key cpp-edit-map "a" 'cpp-edit-apply)
+  (define-key cpp-edit-map "A" 'cpp-edit-apply)
+  (define-key cpp-edit-map "r" 'cpp-edit-reset)
+  (define-key cpp-edit-map "R" 'cpp-edit-reset)
+  (define-key cpp-edit-map "s" 'cpp-edit-save)
+  (define-key cpp-edit-map "S" 'cpp-edit-save)
+  (define-key cpp-edit-map "l" 'cpp-edit-load)
+  (define-key cpp-edit-map "L" 'cpp-edit-load)
+  (define-key cpp-edit-map "h" 'cpp-edit-home)
+  (define-key cpp-edit-map "H" 'cpp-edit-home)
+  (define-key cpp-edit-map "b" 'cpp-edit-background)
+  (define-key cpp-edit-map "B" 'cpp-edit-background)
+  (define-key cpp-edit-map "k" 'cpp-edit-known)
+  (define-key cpp-edit-map "K" 'cpp-edit-known)
+  (define-key cpp-edit-map "u" 'cpp-edit-unknown)
+  (define-key cpp-edit-map "u" 'cpp-edit-unknown)
+  (define-key cpp-edit-map "t" 'cpp-edit-true)
+  (define-key cpp-edit-map "T" 'cpp-edit-true)
+  (define-key cpp-edit-map "f" 'cpp-edit-false)
+  (define-key cpp-edit-map "F" 'cpp-edit-false)
+  (define-key cpp-edit-map "w" 'cpp-edit-write)
+  (define-key cpp-edit-map "W" 'cpp-edit-write)
+  (define-key cpp-edit-map "X" 'cpp-edit-toggle-known)
+  (define-key cpp-edit-map "x" 'cpp-edit-toggle-known)
+  (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown)
+  (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown)
+  (define-key cpp-edit-map "q" 'bury-buffer)
+  (define-key cpp-edit-map "Q" 'bury-buffer))
+
+(defvar cpp-edit-buffer nil)
+;; Real buffer whose cpp display information we are editing.
+(make-variable-buffer-local 'cpp-edit-buffer)
+
+(defvar cpp-edit-symbols nil)
+;; Symbols defined in the edit buffer.
+(make-variable-buffer-local 'cpp-edit-symbols)
+
+(defun cpp-edit-mode ()
+  "Major mode for editing cpp display information.
+Click on objects to change them.  
+You can also use the keyboard accelerators indicated like this: [K]ey."
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (auto-save-mode -1)
+  (setq buffer-read-only t)
+  (setq major-mode 'cpp-edit-mode)
+  (setq mode-name "CPP Edit")
+  (use-local-map cpp-edit-map))
+
+(defun cpp-edit-apply ()
+  "Apply edited display information to original buffer."
+  (interactive)
+  (cpp-edit-home)
+  (cpp-parse-buffer t))
+
+(defun cpp-edit-reset ()
+  "Reset display information from original buffer."
+  (interactive)
+  (let ((buffer (current-buffer))
+	(buffer-read-only nil)
+	(start (window-start))
+	(pos (point))
+	symbols)
+    (set-buffer cpp-edit-buffer)
+    (setq symbols cpp-parse-symbols)
+    (set-buffer buffer)
+    (setq cpp-edit-symbols symbols)
+    (erase-buffer)
+    (insert "CPP Display Information for `")
+    (cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home)
+    (insert "' ")
+    (cpp-make-button "[H]ome" 'cpp-edit-home)
+    (insert " ")
+    (cpp-make-button "[A]pply" 'cpp-edit-apply)
+    (insert " ")
+    (cpp-make-button "[S]ave" 'cpp-edit-save)
+    (insert " ")
+    (cpp-make-button "[L]oad" 'cpp-edit-load)
+    (insert "\n\nClick mouse-2 on item you want to change or use\n"
+	    "keyboard equivalent indicated with brackets like [T]his.\n\n")
+    (insert "[B]ackground: ")
+    (cpp-make-button (car (rassq cpp-face-type cpp-face-type-list))
+		     'cpp-edit-background)
+    (insert "\n[K]nown conditionals: ")
+    (cpp-make-button (cpp-face-name cpp-known-face)
+		     'cpp-edit-known nil t)
+    (insert " [X] ")
+    (cpp-make-button (car (rassq cpp-known-writable cpp-writable-list))
+		     'cpp-edit-toggle-known)
+    (insert "\n[U]nknown conditionals: ")
+    (cpp-make-button (cpp-face-name cpp-unknown-face)
+		     'cpp-edit-unknown nil t)
+    (insert " [Y] ")
+    (cpp-make-button (car (rassq cpp-unknown-writable cpp-writable-list))
+		     'cpp-edit-toggle-unknown)
+    (insert (format "\n\n\n%39s: %14s %14s %7s\n\n" "Expression"
+		    "[T]rue Face" "[F]alse Face" "[W]rite"))
+    (while symbols
+      (let*  ((symbol (car symbols))
+	      (entry (assoc symbol cpp-edit-list))
+	      (true (nth 1 entry))
+	      (false (nth 2 entry))
+	      (write (if entry (nth 3 entry) 'both)))
+	(setq symbols (cdr symbols))
+
+	(if (and entry			; Make default entries unknown.
+		 (or (null true) (eq true 'default))
+		 (or (null false) (eq false 'default))
+		 (eq write 'both))
+	    (setq cpp-edit-list (delq entry cpp-edit-list)
+		  entry nil))
+	
+	(if (> (length symbol) 29)
+	    (insert (substring symbol 0 39) ": ")
+	  (insert (format "%39s: " symbol)))
+
+	(cpp-make-button (cpp-face-name true)
+			 'cpp-edit-true symbol t 14)
+	(insert " ")
+	(cpp-make-button (cpp-face-name false)
+			 'cpp-edit-false symbol t 14)
+	(insert " ")
+	(cpp-make-button (car (rassq write cpp-branch-list))
+			 'cpp-edit-write symbol nil 6)
+	(insert "\n")))
+    (insert "\n\n")
+    (set-window-start nil start)
+    (goto-char pos)))
+
+(defun cpp-edit-load ()
+  "Load cpp configuration."
+  (interactive)
+  (cond ((file-readable-p ".cpp.el")
+	 (load-file ".cpp.el"))
+	((file-readable-p "~/.cpp.el")
+	 (load-file ".cpp.el")))
+  (cpp-edit-reset))
+
+(defun cpp-edit-save ()
+  "Load cpp configuration."
+  (interactive)
+  (require 'pp)
+  (save-excursion
+    (set-buffer cpp-edit-buffer)
+    (let ((buffer (find-file-noselect ".cpp.el")))
+      (set-buffer buffer)
+      (erase-buffer)
+      (pp (list 'setq 'cpp-known-face
+		(list 'quote cpp-known-face)) buffer)
+      (pp (list 'setq 'cpp-unknown-face
+		(list 'quote cpp-unknown-face)) buffer)
+      (pp (list 'setq 'cpp-face-type
+		(list 'quote cpp-face-type)) buffer)
+      (pp (list 'setq 'cpp-known-writable
+		(list 'quote cpp-known-writable)) buffer)
+      (pp (list 'setq 'cpp-unknown-writable
+		(list 'quote cpp-unknown-writable)) buffer)
+      (pp (list 'setq 'cpp-edit-list
+		(list 'quote cpp-edit-list)) buffer)
+      (write-file ".cpp.el"))))
+
+(defun cpp-edit-home ()
+  "Switch back to original buffer."
+  (interactive)
+  (if cpp-button-event
+      (read-event))
+  (pop-to-buffer cpp-edit-buffer))
+
+(defun cpp-edit-background ()
+  "Change default face collection."
+  (interactive)
+  (call-interactively 'cpp-choose-default-face)
+  (cpp-edit-reset))
+
+(defun cpp-edit-known ()
+  "Select default for known conditionals."
+  (interactive)
+  (setq cpp-known-face (cpp-choose-face "Known face" cpp-known-face))
+  (cpp-edit-reset))
+
+(defun cpp-edit-unknown ()
+  "Select default for unknown conditionals."
+  (interactive)
+  (setq cpp-unknown-face (cpp-choose-face "Unknown face" cpp-unknown-face))
+  (cpp-edit-reset))
+
+(defconst cpp-writable-list
+  ;; Names used for the writable property.
+  '(("writable" . t)
+    ("read-only" . nil)))
+
+(defun cpp-edit-toggle-known (arg)
+  "Toggle writable status for known conditionals.
+With optional argument ARG, make them writable iff ARG is positive."
+  (interactive "@P")
+  (if (or (and (null arg) cpp-known-writable)
+	  (<= (prefix-numeric-value arg) 0))
+      (setq cpp-known-writable nil)
+    (setq cpp-known-writable t))
+  (cpp-edit-reset))
+
+(defun cpp-edit-toggle-unknown (arg)
+  "Toggle writable status for unknown conditionals.
+With optional argument ARG, make them writable iff ARG is positive."
+  (interactive "@P")
+  (if (or (and (null arg) cpp-unknown-writable)
+	  (<= (prefix-numeric-value arg) 0))
+      (setq cpp-unknown-writable nil)
+    (setq cpp-unknown-writable t))
+  (cpp-edit-reset))
+
+(defun cpp-edit-true (symbol face)
+  "Select SYMBOL's true FACE used for highlighting taken conditionals."
+  (interactive
+   (let ((symbol (cpp-choose-symbol)))
+     (list symbol
+	   (cpp-choose-face "True face"
+			    (nth 1 (assoc symbol cpp-edit-list))))))
+  (setcar (nthcdr 1 (cpp-edit-list-entry-get-or-create symbol)) face)
+  (cpp-edit-reset))
+
+(defun cpp-edit-false (symbol face)
+  "Select SYMBOL's false FACE used for highlighting untaken conditionals."
+  (interactive
+   (let ((symbol (cpp-choose-symbol)))
+     (list symbol
+	   (cpp-choose-face "False face" 
+			    (nth 2 (assoc symbol cpp-edit-list))))))
+  (setcar (nthcdr 2 (cpp-edit-list-entry-get-or-create symbol)) face)
+  (cpp-edit-reset))
+
+(defun cpp-edit-write (symbol branch)
+  "Set which branches of SYMBOL should be writable to BRANCH.
+BRANCH should be either nil (false branch), t (true branch) or 'both."
+  (interactive (list (cpp-choose-symbol) (cpp-choose-branch)))
+  (setcar (nthcdr 3 (cpp-edit-list-entry-get-or-create symbol)) branch)
+  (cpp-edit-reset))
+
+(defun cpp-edit-list-entry-get-or-create (symbol)
+  ;; Return the entry for SYMBOL in `cpp-edit-list'.
+  ;; If it does not exist, create it.
+  (let ((entry (assoc symbol cpp-edit-list)))
+    (or entry
+	(setq entry (list symbol nil nil 'both nil)
+	      cpp-edit-list (cons entry cpp-edit-list)))
+    entry))
+
+;;; Prompts:
+
+(defun cpp-choose-symbol ()
+  ;; Choose a symbol if called from keyboard, otherwise use the one clicked on.
+  (if cpp-button-event
+      data
+    (completing-read "Symbol: " (mapcar 'list cpp-edit-symbols) nil t)))
+
+(defconst cpp-branch-list
+  ;; Alist of branches.
+  '(("false" . nil)
+    ("true" . t)
+    ("both" . both)))
+
+(defun cpp-choose-branch ()
+  ;; Choose a branch, either nil, t, or both.
+  (if cpp-button-event
+      (x-popup-menu cpp-button-event
+		    (list "Branch" (cons "Branch" cpp-branch-list)))
+    (cdr (assoc	(completing-read "Branch: " cpp-branch-list nil t)
+		cpp-branch-list))))
+
+(defun cpp-choose-face (prompt default)
+  ;; Choose a face from cpp-face-defalt-list.
+  ;; PROMPT is what to say to the user.
+  ;; DEFAULT is the default face.
+  (or (if cpp-button-event
+	  (x-popup-menu cpp-button-event
+			(list prompt (cons prompt cpp-face-default-list)))
+	(let ((name (car (rassq default cpp-face-default-list))))
+	  (cdr (assoc (completing-read (if name
+					   (concat prompt
+						   " (default " name "): ")
+					 (concat prompt ": "))
+				       cpp-face-default-list nil t)
+		      cpp-face-all-list))))
+      default))
+
+(defconst cpp-face-type-list
+  '(("light color background" . light)
+    ("dark color background" . dark)
+    ("monochrome" . mono)
+    ("tty" . none))
+  "Alist of strings and names of the defined face collections.")
+
+(defun cpp-choose-default-face (type)
+  ;; Choose default face list for screen of TYPE.
+  ;; Type must be one of the types defined in `cpp-face-type-list'.
+  (interactive (list (if cpp-button-event
+			 (x-popup-menu cpp-button-event
+				       (list "Screen type"
+					     (cons "Screen type"
+						   cpp-face-type-list)))
+		       (cdr (assoc (completing-read "Screen type: "
+						    cpp-face-type-list
+						    nil t)
+				   cpp-face-type-list)))))
+  (cond ((null type))
+	((eq type 'light)
+	 (if cpp-face-light-list
+	     ()
+	   (setq cpp-face-light-list
+		 (mapcar 'cpp-create-bg-face cpp-face-light-name-list))
+	   (setq cpp-face-all-list
+		 (append cpp-face-all-list cpp-face-light-list)))
+	 (setq cpp-face-type 'light)
+	 (setq cpp-face-default-list
+	       (append cpp-face-light-list cpp-face-none-list)))
+	((eq type 'dark)
+	 (if cpp-face-dark-list
+	     ()
+	   (setq cpp-face-dark-list
+		 (mapcar 'cpp-create-bg-face cpp-face-dark-name-list))
+	   (setq cpp-face-all-list
+		 (append cpp-face-all-list cpp-face-dark-list)))
+	 (setq cpp-face-type 'dark)
+	 (setq cpp-face-default-list
+	       (append cpp-face-dark-list cpp-face-none-list)))
+	((eq type 'mono)
+	 (setq cpp-face-type 'mono)
+	 (setq cpp-face-default-list
+	       (append cpp-face-mono-list cpp-face-none-list)))
+	(t
+	 (setq cpp-face-type 'none)
+	 (setq cpp-face-default-list cpp-face-none-list))))
+
+;;; Buttons:
+
+(defvar cpp-button-event nil)
+;; This will be t in the callback for `cpp-make-button'.
+
+(defun cpp-make-button (name callback &optional data face padding)
+  ;; Create a button at point.
+  ;; NAME is the name of the button.
+  ;; CALLBACK is the function to call when the button is pushed.
+  ;; DATA will be available to CALLBACK as a free variable.
+  ;; FACE means that NAME is the name of a face in `cpp-face-all-list'.
+  ;; PADDING means NAME will be right justified at that length.
+  (let ((name (format "%s" name))
+	from to)
+    (cond ((null padding)
+	   (setq from (point))
+	   (insert name))
+	  ((> (length name) padding)
+	   (setq from (point))
+	   (insert (substring name 0 padding)))
+	  (t
+	   (insert (make-string (- padding (length name)) ? ))
+	   (setq from (point))
+	   (insert name)))
+    (setq to (point))
+    (setq face
+	  (if face
+	      (let ((check (cdr (assoc name cpp-face-all-list))))
+		(if (memq check '(default invisible))
+		    'bold
+		  check))
+	    'bold))
+    (add-text-properties from to
+			 (append (list 'face face)
+				 '(mouse-face highlight)
+				 (list 'cpp-callback callback)
+				 (if data (list 'cpp-data data))))))
+
+(defun cpp-push-button (event)
+  ;; Pushed a CPP button.
+  (interactive "@e")
+  (set-buffer (window-buffer (posn-window (event-start event))))
+  (let ((pos (posn-point (event-start event))))
+    (let ((data (get-text-property pos 'cpp-data))
+	  (fun (get-text-property pos 'cpp-callback))
+	  (cpp-button-event event))
+      (cond (fun
+	     (call-interactively (get-text-property pos 'cpp-callback)))
+	    ((lookup-key global-map [ down-mouse-2])
+	     (call-interactively (lookup-key global-map [ down-mouse-2])))))))
+
+;;; Faces:
+
+(defvar cpp-face-light-name-list
+  '("light gray" "light blue" "light cyan" "light yellow" "light pink"
+    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
+    "turquoise")
+  "Background colours useful with dark foreground colors.")
+
+(defvar cpp-face-dark-name-list
+  '("dim gray" "blue" "cyan" "yellow" "red"
+    "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple"
+    "dark turquoise")
+  "Background colours useful with light foreground colors.")
+
+(defvar cpp-face-light-list nil
+  "Alist of names and faces to be used for light backgrounds.")
+
+(defvar cpp-face-dark-list nil
+  "Alist of names and faces to be used for dark backgrounds.")
+
+(defvar cpp-face-mono-list
+  '(("bold" . 'bold)
+    ("bold-italic" . 'bold-italic)
+    ("italic" . 'italic)
+    ("underline" . 'underline))
+  "Alist of names and faces to be used for monocrome screens.")
+
+(defvar cpp-face-none-list
+   '(("default" . default)
+     ("invisible" . invisible))
+   "Alist of names and faces available even if you don't use a window system.")
+
+(defvar cpp-face-all-list
+  (append cpp-face-light-list
+	  cpp-face-dark-list
+	  cpp-face-mono-list
+	  cpp-face-none-list)
+  "All faces used for highligting text inside cpp conditionals.")
+
+(defvar cpp-face-default-list nil
+  "List of faces you can choose from for cpp conditionals.")
+
+(defun cpp-create-bg-face (color)
+  ;; Create entry for face with background COLOR.
+  (let ((name (intern (concat "cpp " color))))
+    (make-face name)
+    (set-face-background name color)
+    (cons color name)))
+
+(cpp-choose-default-face (if window-system cpp-face-type 'none))
+
+(defun cpp-face-name (face)
+  ;; Return the name of FACE from `cpp-face-all-list'.
+  (let ((entry (rassq (if face face 'default) cpp-face-all-list)))
+    (if entry
+	(car entry)
+      (format "<%s>" face))))
+
+;;; Utilities:
+
+(defvar cpp-progress-time 0)
+;; Last time we issued a progress message.
+
+(defun cpp-progress-message (&rest args)
+  ;; Report progress at most once a second.  Take same ARGS as `message'.
+  (let ((time (nth 1 (current-time))))
+    (if (= time cpp-progress-time)
+	()
+      (setq cpp-progress-time time)
+      (apply 'message args))))
+
+(provide 'cpp)
+
+;;; cpp.el ends here
+