changeset 56:3146eff78ab1

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/completion.el	Thu Apr 05 21:41:26 1990 +0000
@@ -0,0 +1,3124 @@
+;;; This is a Completion system for GNU Emacs
+;;;
+;;;  E-Mail: 
+;;;   Internet: [e-mail], [e-mail]
+;;;   UUCP: {rutgers,harvard,mit-eddie}!think!completion
+;;;
+;;;    If you are a new user, we'd appreciate knowing your site name and
+;;; any comments you have.
+;;;
+;;;
+;;;				NO WARRANTY
+;;;
+;;; This software is distributed free of charge and is in the public domain.
+;;; Anyone may use, duplicate or modify this program.  Thinking Machines
+;;; Corporation does not restrict in any way the use of this software by
+;;; anyone.
+;;; 
+;;; Thinking Machines Corporation provides absolutely no warranty of any kind.
+;;; The entire risk as to the quality and performance of this program is with
+;;; you.  In no event will Thinking Machines Corporation be liable to you for
+;;; damages, including any lost profits, lost monies, or other special,
+;;; incidental or consequential damages arising out of the use of this program.
+;;;
+;;; You must not restrict the distribution of this software.
+;;;
+;;; Please keep this notice and author information in any copies you make.
+;;;
+;;; 4/90
+;;;
+;;;
+;;; Advertisement
+;;;---------------
+;;;  Try using this.  If you are like most you will be happy you did.
+;;; 
+;;; What to put in .emacs
+;;;-----------------------
+;;; (load "completion") ;; If it's not part of the standard band.
+;;; (initialize-completions)
+;;; 
+;;; For best results, be sure to byte-compile the file first.
+;;;
+
+;;; Authors 
+;;;---------
+;;;     Jim Salem      {[e-mail]}
+;;;     Brewster Kahle {[e-mail]}
+;;;  Thinking Machines Corporation
+;;;  245 First St., Cambridge MA 02142 [phone]
+;;;
+;;; Mailing Lists
+;;;---------------
+;;;
+;;; Bugs to [e-mail]
+;;; Comments to [e-mail]
+;;; Requests to be added [e-mail]
+;;;
+;;; Availability
+;;;--------------
+;;; Anonymous FTP from think.com
+;;;
+
+;;;---------------------------------------------------------------------------
+;;; Documentation [Slightly out of date]
+;;;---------------------------------------------------------------------------
+;;;  (also check the documentation string of the functions)
+;;;
+;;; Introduction
+;;;---------------
+;;;  
+;;;     After you type a few characters, pressing the "complete" key inserts
+;;; the rest of the word you are likely to type.  
+;;;
+;;; This watches all the words that you type and remembers them.  When 
+;;; typing a new word, pressing "complete" (meta-return) "completes" the
+;;; word by inserting the most recently used word that begins with the 
+;;; same characters.  If you press meta-return repeatedly, it cycles
+;;; through all the words it knows about.
+;;;
+;;;  If you like the completion then just continue typing, it is as if you
+;;; entered the text by hand.  If you want the inserted extra characters 
+;;; to go away, type control-w or delete.  More options are described below.
+;;;
+;;;  The guesses are made in the order of the most recently "used".  Typing
+;;; in a word and then typing a separator character (such as a space) "uses" 
+;;; the word.  So does moving a cursor over the word.  If no words are found, 
+;;; it uses an extended version of the dabbrev style completion.
+;;;
+;;;   You automatically save the completions you use to a file between 
+;;; sessions.  
+;;;
+;;;   Completion enables programmers to enter longer, more descriptive 
+;;; variable names while typing fewer keystrokes than they normally would.
+;;;
+;;;
+;;; Full documentation
+;;;---------------------
+;;;
+;;;   A "word" is any string containing characters with either word or symbol 
+;;; syntax.  [E.G. Any alphanumeric string with hypens, underscores, etc.]
+;;; Unless you change the constants, you must type at least three characters
+;;; for the word to be recognized.  Only words longer than 6 characters are
+;;; saved.
+;;;
+;;;   When you load this file, completion will be on.  I suggest you use the
+;;; compiled version (because it is noticibly faster).
+;;;
+;;;  M-X completion-mode toggles whether or not new words are added to the
+;;; database by changing the value of *completep*.
+;;;
+;;;  SAVING/LOADING COMPLETIONS
+;;;   Completions are automatically saved from one session to another
+;;; (unless *save-completions-p* or *completep* is nil).
+;;; Loading this file (or calling initialize-completions) causes EMACS
+;;; to load a completions database for a saved completions file 
+;;; (default: ~/.completions).  When you exit, EMACS saves a copy of the
+;;; completions that you 
+;;; often use.  When you next start, EMACS loads in the saved completion file.
+;;;
+;;;   The number of completions saved depends loosely on 
+;;; *saved-completions-decay-factor*.  Completions that have never been 
+;;; inserted via "complete" are not saved.  You are encouraged to experiment
+;;; with different functions (see compute-completion-min-num-uses).
+;;;
+;;;   Some completions are permanent and are always saved out.  These 
+;;; completions have their num-uses slot set to T.  Use 
+;;; add-permanent-completion to do this
+;;;
+;;;   Completions are saved only if *completep* is T.  The number of old
+;;; versions kept of the saved completions file is controlled by 
+;;; *completion-file-versions-kept*.
+;;;
+;;; COMPLETE KEY OPTIONS
+;;;   The complete function takes a numeric arguments.  
+;;;  control-u :: leave the point at the beginning of the completion rather 
+;;;               than the middle.
+;;;  a number  :: rotate through the possible completions by that amount
+;;;  `-'       :: same as -1 (insert previous completion)
+;;;
+;;; HOW THE DATABASE IS MAINTAINED
+;;;  <write>
+;;;
+;;; UPDATING THE DATABASE MANUALLY
+;;;   m-x kill-completion 
+;;;     kills the completion at point.
+;;;   m-x add-completion
+;;;   m-x add-permanent-completion
+;;;   
+;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
+;;;   m-x add-completions-from-buffer
+;;;     Parses all the definition names from a C or LISP mode buffer and
+;;;     adds them to the completion database.
+;;;
+;;;   m-x add-completions-from-lisp-file 
+;;;     Parses all the definition names from a C or Lisp mode file and
+;;;     adds them to the completion database.
+;;;
+;;; UPDATING THE DATABASE FROM A TAGS TABLE
+;;;   m-x add-completions-from-tags-table
+;;;     Adds completions from the current tags-table-buffer.
+;;;
+;;; HOW A COMPLETION IS FOUND
+;;;  <write>
+;;;
+;;; STRING CASING
+;;;   Completion is string case independent if case-fold-search has its 
+;;;  normal default of T.  Also when the completion is inserted the case of the
+;;;  entry is coerced appropriately.  
+;;;  [E.G.  APP --> APPROPRIATELY     app --> appropriately  
+;;;         App --> Appropriately]
+;;;
+;;; INITIALIZATION
+;;;  The form `(initialize-completions)' initializes the completion system by 
+;;; trying to load in the user's completions.  After the first cal, further 
+;;; calls have no effect so one should be careful not to put the form in a 
+;;; site's standard site-init file.
+;;;
+;;;---------------------------------------------------------------------------
+;;;
+;;;
+
+;;;-----------------------------------------------
+;;; Porting Notes
+;;;-----------------------------------------------
+;;;
+;;;  Should run on 18.49, 18.52, and 19.0
+;;;  Tested on vanilla version.
+;;;  This requires the standard cl.el file.  It could easily rewritten to not 
+;;; require it.  It defines remove which is not in cl.el.
+;;;
+;;;  FUNCTIONS BASHED
+;;; The following functions are bashed but it is done carefully and should not
+;;; cause problems ::
+;;;   kill-region, next-line, previous-line, newline, newline-and-indent,
+;;;   kill-emacs
+;;;
+;;;
+;;;---------------------------------------------------------------------------
+;;; Functions you might like to call
+;;;---------------------------------------------------------------------------
+;;;
+;;;  add-completion  string &optional num-uses
+;;;    Adds a new string to the database
+;;;
+;;;  add-permanent-completion  string
+;;;    Adds a new string to the database with num-uses = T
+;;;
+
+;;;  kill-completion string
+;;;    Kills the completion from the database.
+;;;
+;;;  clear-all-completions
+;;;    Clears the database
+;;;
+;;;  list-all-completions
+;;;    Returns a list of all completions.
+;;;
+;;;
+;;;  next-completion string &optional index
+;;;    Returns a completion entry that starts with string.
+;;;
+;;;  find-exact-completion string
+;;;    Returns a completion entry that exactly matches string.
+;;;
+;;;  complete
+;;;    Inserts a completion at point
+;;;
+;;;  initialize-completions
+;;;    Loads the completions file and sets up so that exiting emacs will 
+;;;  save them.
+;;;
+;;;  save-completions-to-file &optional filename  
+;;;  load-completions-from-file &optional filename
+;;;
+;;;-----------------------------------------------
+;;; Other functions
+;;;-----------------------------------------------
+;;;
+;;;  get-completion-list string
+;;;
+;;; These things are for manipulating the structure
+;;;  make-completion string num-uses
+;;;  completion-num-uses completion 
+;;;  completion-string completion
+;;;  set-completion-num-uses completion num-uses
+;;;  set-completion-string completion string
+;;;  
+;;;
+
+;;;-----------------------------------------------
+;;; To Do :: (anybody ?)
+;;;-----------------------------------------------
+;;;
+;;;   Implement Lookup and keyboard interface in C
+;;;   Add package prefix smarts (for Common Lisp)
+;;;   Add autoprompting of possible completions after every keystroke (fast
+;;;      terminals only !)
+;;;   Add doc. to texinfo
+;;;
+;;;
+;;;-----------------------------------------------
+;;; History ::
+;;;-----------------------------------------------
+;;;    Sometime in '84 Brewster implemented a somewhat buggy version for 
+;;; Symbolics LISPMs.
+;;;    Jan. '85 Jim became enamored of the idea and implemented a faster, 
+;;; more robust version.
+;;;    With input from many users at TMC, (rose, craig, and gls come to mind),
+;;; the current style of interface was developed. 
+;;;    9/87, Jim and Brewster took terminals home.  Yuck.  After 
+;;; complaining for a while Brewester implemented a subset of the current 
+;;; LISPM version for GNU Emacs.  
+;;;    8/88  After complaining for a while (and with sufficient 
+;;; promised rewards), Jim reimplemented a version of GNU completion
+;;; superior to that of the LISPM version.
+;;;
+;;;-----------------------------------------------
+;;; Acknowlegements
+;;;-----------------------------------------------
+;;;  Cliff Lasser ([e-mail]), Kevin Herbert ([e-mail]),
+;;;  eero@media-lab, [e-mail], [e-mail],
+;;;
+;;;-----------------------------------------------
+;;; Change Log
+;;;-----------------------------------------------
+;;; From version 9 to 10
+;;;  - Allowance for non-integral *completion-version* nos.
+;;;  - Fix cmpl-apply-as-top-level for keyboard macros
+;;;  - Fix broken completion merging (in save-completions-to-file)
+;;;  - More misc. fixes for version 19.0 of emacs
+;;;
+;;; From Version 8 to 9
+;;;  - Ported to version 19.0 of emacs (backcompatible with version 18)
+;;;  - Added add-completions-from-tags-table (with thanks to eero@media-lab)
+;;;
+;;; From Version 7 to 8
+;;;  - Misc. changes to comments
+;;;  - new completion key bindings: c-x o, M->, M-<, c-a, c-e
+;;;  - cdabbrev now checks all the visible window buffers and the "other buffer"
+;;;  - `%' is now a symbol character rather than a separator (except in C mode)
+;;;
+;;; From Version 6 to 7
+;;;  - Fixed bug with saving out .completion file the first time
+;;;
+;;; From Version 5 to 6
+;;;  - removed statistics recording
+;;;  - reworked advise to handle autoloads
+;;;  - Fixed fortran mode support
+;;;  - Added new cursor motion triggers
+;;;
+;;; From Version 4 to 5
+;;;  - doesn't bother saving if nothing has changed
+;;;  - auto-save if haven't used for a 1/2 hour
+;;;  - save period extended to two weeks
+;;;  - minor fix to capitalization code
+;;;  - added *completion-auto-save-period* to variables recorded.
+;;;  - added reenter protection to cmpl-record-statistics-filter
+;;;  - added backup protection to save-completions-to-file (prevents 
+;;;    problems with disk full errors)
+
+;;;-----------------------------------------------
+;;; Requires
+;;; Version
+;;;-----------------------------------------------
+
+;;(require 'cl) ;; DOTIMES, etc. {actually done after variable defs.}
+
+(defconst *completion-version*  10
+  "Tested for EMACS versions 18.49, 18.52, 18.55 and beyond and 19.0.")
+
+;;;---------------------------------------------------------------------------
+;;; User changeable parameters
+;;;---------------------------------------------------------------------------
+
+(defvar *completep* t
+  "*Set to nil to turn off the completion hooks.
+(No new words added to the database or saved to the init file)."
+  )
+
+(defvar *save-completions-p* t
+  "*If non-nil, the most useful completions are saved to disk when
+exiting EMACS.  See *saved-completions-decay-factor*.")
+
+(defvar *saved-completions-filename* "~/.completions"
+  "*The filename to save completions to.")
+
+(defvar *saved-completion-retention-time* 336
+  "*The maximum amout of time to save a completion for if it has not been used.
+In hours.  (1 day = 24, 1 week = 168).  If this is 0, non-permanent completions
+will not be saved unless these are used.  Default is two weeks."
+  )
+
+(defvar *separator-character-uses-completion-p* nil
+  "*If non-nil, typing a separator character after a completion symbol that
+is not part of the database marks it as used (so it will be saved).")
+
+(defvar *completion-file-versions-kept* kept-new-versions
+  "*Set this to the number of versions you want save-completions-to-file
+to keep.")
+
+(defvar *print-next-completion-speed-threshold* 4800
+  "*The baud rate at or above which to print the next potential completion
+after inserting the current one."
+  )
+
+(defvar *print-next-completion-does-cdabbrev-search-p* nil
+  "*If non-NIL, the next completion prompt will also do a cdabbrev search.
+This can be time consuming.")
+
+(defvar *cdabbrev-radius* 15000
+  "*How far to search for cdabbrevs.  In number of characters.  If nil, the 
+whole buffer is searched.")
+
+(defvar *modes-for-completion-find-file-hook* '(lisp c)
+  "*A list of modes {either c or lisp}.  Definitions from visited files
+of those types are automatically added to the completion database.")
+
+(defvar *record-cmpl-statistics-p* nil
+  "*If non-nil, statistics are automatically recorded.")
+
+(defvar *completion-auto-save-period* 1800
+  "*The period in seconds to wait for emacs to be idle before autosaving
+the completions.  Default is a 1/2 hour.")
+
+(defconst *completion-min-length* nil ;; defined below in eval-when
+  "*The minimum length of a stored completion.
+DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
+
+(defconst *completion-max-length* nil ;; defined below in eval-when
+  "*The maximum length of a stored completion.
+DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
+
+(defconst *completion-prefix-min-length* nil ;; defined below in eval-when
+  "The minimum length of a completion search string.
+DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
+
+(defmacro eval-when-compile-load-eval (&rest body)
+  ;; eval everything before expanding
+  (mapcar 'eval body)
+  (cons 'progn body)
+  )
+
+(defun completion-eval-when ()
+  (eval-when-compile-load-eval
+   ;; These vars. are defined at both compile and load time.
+   (setq *completion-min-length* 6)
+   (setq *completion-max-length* 200)
+   (setq *completion-prefix-min-length* 3)
+   ;; Need this file around too
+   (require 'cl)
+   )) ;; eval-when
+
+(completion-eval-when)
+ 
+;;;---------------------------------------------------------------------------
+;;; Internal Variables
+;;;---------------------------------------------------------------------------
+
+(defvar cmpl-initialized-p nil
+  "Set to t when the completion system is initialized.  Indicates that the old 
+completion file has been read in.")
+
+(defvar cmpl-completions-accepted-p nil
+  "Set to T as soon as the first completion has been accepted.  Used to
+decide whether to save completions.")
+
+
+;;;---------------------------------------------------------------------------
+;;; Low level tools
+;;;---------------------------------------------------------------------------
+
+;;;-----------------------------------------------
+;;; Misc.
+;;;-----------------------------------------------
+
+(defun remove (item list)
+  (setq list (copy-sequence list))
+  (delq item list)
+  )
+
+(defun minibuffer-window-selected-p ()
+  "True iff the current window is the minibuffer."
+  (eq (minibuffer-window) (selected-window)))
+
+(eval-when-compile-load-eval
+(defun function-needs-autoloading-p (symbol)
+  ;; True iff symbol is represents an autoloaded function and has not yet been
+  ;; autoloaded.
+  (and (listp (symbol-function symbol))
+       (eq 'autoload (car (symbol-function symbol)))
+       ))
+) ;; eval-when
+
+(defun function-defined-and-loaded (symbol)
+  ;; True iff symbol is bound to a loaded function.
+  (and (fboundp symbol) (not (function-needs-autoloading-p symbol)))
+  )
+
+(defmacro read-time-eval (form)
+  ;; Like the #. reader macro
+  (eval form)
+  )
+
+;;;-----------------------------------------------
+;;; Emacs Version 19 compatibility
+;;;-----------------------------------------------
+
+(defconst emacs-is-version-19 (string= (substring emacs-version 0 2) "19"))
+
+(defun cmpl19-baud-rate ()
+  (if emacs-is-version-19
+      baud-rate
+      (baud-rate)))
+
+(defun cmpl19-sit-for (amount)
+  (if (and emacs-is-version-19 (= amount 0))
+      (sit-for 1 t)
+      (sit-for amount)))
+
+;;;-----------------------------------------------
+;;; Advise
+;;;-----------------------------------------------
+
+(defmacro completion-advise (function-name where &rest body)
+  "Adds the body code before calling function.  This advise is not compiled.
+WHERE is either :BEFORE or :AFTER."
+  (completion-advise-1 function-name where body)
+  )
+
+(defmacro cmpl-apply-as-top-level (function arglist)
+  "Calls function-name interactively if inside a call-interactively."
+  (list 'cmpl-apply-as-top-level-1 function arglist
+	'(let ((executing-macro nil)) (interactive-p)))
+  )
+
+(defun cmpl-apply-as-top-level-1 (function arglist interactive-p)
+  (if (and interactive-p (commandp function))
+      (call-interactively function)
+      (apply function arglist)
+      ))
+
+(eval-when-compile-load-eval
+
+(defun cmpl-defun-preamble (function-name)
+  (let ((doc-string
+	 (condition-case e
+	      ;; This condition-case is here to stave
+	      ;; off bizarre load time errors 18.52 gets
+	      ;; on the function c-mode
+	      (documentation function-name)
+	    (error nil)))
+	(interactivep (commandp function-name))
+	)
+    (append
+     (if doc-string (list doc-string))
+     (if interactivep '((interactive)))
+     )))
+
+(defun completion-advise-1 (function-name where body &optional new-name)
+  (unless new-name (setq new-name function-name))
+  (let ((quoted-name (list 'quote function-name))
+	(quoted-new-name (list 'quote new-name))
+	)
+
+  (cond ((function-needs-autoloading-p function-name)
+	 (list* 'defun function-name '(&rest arglist)
+		(append
+		 (cmpl-defun-preamble function-name)
+		 (list (list 'load (second (symbol-function function-name)))
+		       (list 'eval
+			     (list 'completion-advise-1 quoted-name
+				   (list 'quote where) (list 'quote body)
+				   quoted-new-name))
+		       (list 'cmpl-apply-as-top-level quoted-new-name 'arglist)
+		       )))
+	 )
+	(t
+	 (let ((old-def-name
+		(intern (concat "$$$cmpl-" (symbol-name function-name))))
+	       )
+    
+	   (list 'progn
+		 (list 'defvar old-def-name
+		       (list 'symbol-function quoted-name))
+		 (list* 'defun new-name '(&rest arglist)
+			(append
+			 (cmpl-defun-preamble function-name)
+			 (ecase where
+			   (:before
+			    (list (cons 'progn body)
+				  (list 'cmpl-apply-as-top-level
+					old-def-name 'arglist)))
+			   (:after
+			    (list* (list 'cmpl-apply-as-top-level
+					 old-def-name 'arglist)
+				   body)
+			    )))
+			)))
+	 ))))
+) ;; eval-when
+			 
+
+;;;-----------------------------------------------
+;;; String case coercion
+;;;-----------------------------------------------
+
+(defun cmpl-string-case-type (string)
+  "Returns :capitalized, :up, :down, :mixed, or :neither."
+  (let ((case-fold-search nil))
+    (cond ((string-match "[a-z]" string)
+	   (cond ((string-match "[A-Z]" string)
+		  (cond ((and (> (length string) 1)
+			      (null (string-match "[A-Z]" string 1)))
+			 ':capitalized)
+			(t
+			 ':mixed)))
+		 (t ':down)))
+	  (t
+	   (cond ((string-match "[A-Z]" string)
+		  ':up)
+		 (t ':neither))))
+    ))
+
+;;; Tests -
+;;; (cmpl-string-case-type "123ABCDEF456") --> :up
+;;; (cmpl-string-case-type "123abcdef456") --> :down
+;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
+;;; (cmpl-string-case-type "123456")       --> :neither
+;;; (cmpl-string-case-type "Abcde123")     --> :capitalized
+
+(defun cmpl-coerce-string-case (string case-type)
+  (cond ((eq case-type ':down) (downcase string))
+	((eq case-type ':up) (upcase string))
+	((eq case-type ':capitalized)
+	 (setq string (downcase string))
+	 (aset string 0 (logand ?\337 (aref string 0)))
+	 string)
+	(t string)
+	))
+
+(defun cmpl-merge-string-cases (string-to-coerce given-string)
+  (let ((string-case-type (cmpl-string-case-type string-to-coerce))
+	)
+    (cond ((memq string-case-type '(:down :up :capitalized))
+	   ;; Found string is in a standard case.  Coerce to a type based on
+	   ;; the given string
+	   (cmpl-coerce-string-case string-to-coerce
+			       (cmpl-string-case-type given-string))
+	   )
+	  (t
+	   ;; If the found string is in some unusual case, just insert it
+	   ;; as is
+	   string-to-coerce)
+	  )))
+
+;;; Tests -
+;;; (cmpl-merge-string-cases "AbCdEf456" "abc")     --> AbCdEf456
+;;; (cmpl-merge-string-cases "abcdef456" "ABC")     --> ABCDEF456
+;;; (cmpl-merge-string-cases "ABCDEF456" "Abc")     --> Abcdef456
+;;; (cmpl-merge-string-cases "ABCDEF456" "abc")     --> abcdef456
+
+
+;;;-----------------------------------------------
+;;; Emacs Idle Time hooks
+;;;-----------------------------------------------
+
+(defvar cmpl-emacs-idle-process nil)
+
+(defvar cmpl-emacs-idle-interval 150
+  "Seconds between running the emacs idle process.")
+
+(defun init-cmpl-emacs-idle-process ()
+  "Initialize the emacs idle process."
+  (let ((live (and cmpl-emacs-idle-process
+		   (eq (process-status cmpl-emacs-idle-process) 'run)))
+	;; do not allocate a pty
+	(process-connection-type nil))
+    (if live
+	(kill-process cmpl-emacs-idle-process))
+    (if cmpl-emacs-idle-process
+	(delete-process cmpl-emacs-idle-process))
+    (setq cmpl-emacs-idle-process
+	  (start-process "cmpl-emacs-idle" nil
+			 "loadst" 
+			 "-n" (int-to-string cmpl-emacs-idle-interval)))
+    (process-kill-without-query cmpl-emacs-idle-process)
+    (set-process-filter cmpl-emacs-idle-process 'cmpl-emacs-idle-filter)
+    ))
+
+(defvar cmpl-emacs-buffer nil)
+(defvar cmpl-emacs-point 0)
+(defvar cmpl-emacs-last-command nil)
+(defvar cmpl-emacs-last-command-char nil)
+(defun cmpl-emacs-idle-p ()
+  ;; returns T if emacs has been idle
+  (if (and (eq cmpl-emacs-buffer (current-buffer))
+	   (= cmpl-emacs-point (point))
+	   (eq cmpl-emacs-last-command last-command)
+	   (eq last-command-char last-command-char)
+	   )
+      t ;; idle
+      ;; otherwise, update count
+      (setq cmpl-emacs-buffer (current-buffer))
+      (setq cmpl-emacs-point (point))
+      (setq cmpl-emacs-last-command last-command)
+      (setq last-command-char last-command-char)
+      nil
+      ))
+	   
+(defvar cmpl-emacs-idle-time 0
+  "The idle time of emacs in seconds.")
+
+(defvar inside-cmpl-emacs-idle-filter nil)
+(defvar cmpl-emacs-idle-time-hooks nil)
+
+(defun cmpl-emacs-idle-filter (proc string)
+  ;; This gets called every cmpl-emacs-idle-interval seconds
+  ;; Update idle time clock
+  (if (cmpl-emacs-idle-p)
+      (incf cmpl-emacs-idle-time cmpl-emacs-idle-interval)
+      (setq cmpl-emacs-idle-time 0))
+
+  (unless inside-cmpl-emacs-idle-filter
+    ;; Don't reenter if we are hung
+
+    (setq inside-cmpl-emacs-idle-filter t)
+  
+    (dolist (function cmpl-emacs-idle-time-hooks)
+      (condition-case e
+	   (funcall function)
+	 (error nil)
+	 ))
+    (setq inside-cmpl-emacs-idle-filter nil)
+    ))
+
+
+;;;-----------------------------------------------
+;;; Time 
+;;;-----------------------------------------------
+;;; What a backwards way to get the time ! Unfortunately, GNU Emacs
+;;; doesn't have an accessible time function.
+
+(defconst cmpl-hours-per-day  24)
+(defconst cmpl-hours-per-year  (* 365 cmpl-hours-per-day))
+(defconst cmpl-hours-per-4-years  (+ (* 4 cmpl-hours-per-year)
+				    cmpl-hours-per-day))
+(defconst cmpl-days-since-start-of-year
+    '(0 31 59 90 120 151 181 212 243 273 304 334))
+(defconst cmpl-days-since-start-of-leap-year
+    '(0 31 60 91 121 152 182 213 244 274 305 335))
+(defconst cmpl-months
+    '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
+  )
+
+(defun cmpl-hours-since-1900-internal (month day year hours)
+  "Month is an integer from 1 to 12.  Year is a two digit integer (19XX)"
+  (+ ;; Year
+    (* (/ (1- year) 4) cmpl-hours-per-4-years)
+    (* (1+ (mod (1- year) 4)) cmpl-hours-per-year)
+    ;; minus two to account for  1968 rather than 1900
+    ;; month
+    (* cmpl-hours-per-day
+       (nth (1- month) (if (zerop (mod year 4))
+			   cmpl-days-since-start-of-leap-year
+			   cmpl-days-since-start-of-year)))
+    (* (1- day) cmpl-hours-per-day)
+    hours
+    ))
+
+(defun cmpl-month-from-string (month-string)
+  "Month string is a three char. month string"
+  (let ((count 1))
+    (do ((list cmpl-months (cdr list))
+	 )
+	((or (null list) (string-equal month-string (car list))))
+      (setq count (1+ count)))
+    (if (> count 12)
+	(error "Unknown month - %s" month-string))
+    count))
+
+(defun cmpl-hours-since-1900 (&optional time-string)
+  "String is a string in the format of current-time-string (the default)."
+  (let* ((string (or time-string (current-time-string)))
+	 (month (cmpl-month-from-string (substring string 4 7)))
+	 (day (string-to-int (substring string 8 10)))
+	 (year (string-to-int (substring string 22 24)))
+	 (hour (string-to-int (substring string 11 13)))
+	 )
+    (cmpl-hours-since-1900-internal month day year hour)
+    ))
+
+;;; Tests -
+;;;(cmpl-hours-since-1900 "Wed Jan  1 00:00:28 1900") -->  35040
+;;;(cmpl-hours-since-1900 "Wed Nov  2 23:00:28 1988") --> 778751
+;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1988") --> 771926
+;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1988") --> 772670
+;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1988") --> 773366
+;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1988") --> 774110
+;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1988") --> 774830
+;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1988") --> 775574
+;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1988") --> 776294
+;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1988") --> 777038
+;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1988") --> 777782
+;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1988") --> 778502
+;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1988") --> 779246
+;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1988") --> 779966
+;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1957") --> 500198
+;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1957") --> 500942
+;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1957") --> 501614
+;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1957") --> 502358
+;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1957") --> 503078
+;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1957") --> 503822
+;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1957") --> 504542
+;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1957") --> 505286
+;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1957") --> 506030
+;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1957") --> 506750
+;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1957") --> 507494
+;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1957") --> 508214
+
+
+;;;---------------------------------------------------------------------------
+;;; "Symbol" parsing functions
+;;;---------------------------------------------------------------------------
+;;; The functions symbol-before-point, symbol-under-point, etc. quickly return
+;;; an appropriate symbol string.  The strategy is to temporarily change
+;;; the syntax table to enable fast symbol searching.  There are three classes
+;;; of syntax in these "symbol" syntax tables ::
+;;;
+;;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
+;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).  
+;;; syntax (? ) - everything else
+;;;
+;;; Thus by judicious use of scan-sexps and forward-word, we can get
+;;; the word we want relatively fast and without consing.  
+;;;
+;;; Why do we need a separate category for "symbol chars to ignore at ends" ?
+;;; For example, in LISP we want starting :'s trimmed 
+;;; so keyword argument specifiers also define the keyword completion.  And,
+;;; for example, in C we want `.' appearing in a structure ref. to
+;;; be kept intact in order to store the whole structure ref.; however, if 
+;;; it appears at the end of a symbol it should be discarded because it is
+;;; probably used as a period.
+
+;;; Here is the default completion syntax ::
+;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
+;;; Symbol chars to ignore at ends :: _ : . -
+;;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
+;;;                     , ? <Everything else>
+
+;;; Mode specific differences and notes ::
+;;;  LISP diffs ->
+;;;    Symbol chars :: ! & ? = ^
+;;;
+;;; C diffs ->
+;;;   Separator chars :: + * / : %
+;;;  A note on the hypen (`-').  Perhaps, the hypen should also be a separator
+;;; char., however, we wanted to have completion symbols include pointer 
+;;; references.  For example, "foo->bar" is a symbol as far as completion is
+;;; concerned.
+;;;
+;;; FORTRAN diffs ->
+;;;   Separator chars :: + - * / :
+;;;
+;;; Pathname diffs ->
+;;;   Symbol chars :: .
+;;;  Of course there is no pathname "mode" and in fact we have not implemented
+;;; this table.  However, if there was such a mode, this is what it would look
+;;; like.
+
+;;;-----------------------------------------------
+;;; Table definitions
+;;;-----------------------------------------------
+
+(defun make-standard-completion-syntax-table ()
+  (let ((table (make-vector 256 0)) ;; default syntax is whitespace
+	)
+    ;; alpha chars
+    (dotimes (i 26)
+      (modify-syntax-entry (+ ?a i) "_" table)
+      (modify-syntax-entry (+ ?A i) "_" table))
+    ;; digit chars.
+    (dotimes (i 10)
+      (modify-syntax-entry (+ ?0 i) "_" table))
+    ;; Other ones
+    (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%))
+	  (symbol-chars-ignore '(?_ ?- ?: ?.))
+	  )
+      (dolist (char symbol-chars)
+	(modify-syntax-entry char "_" table))
+      (dolist (char symbol-chars-ignore)
+	(modify-syntax-entry char "w" table)
+	)
+      )
+    table))
+
+(defconst cmpl-standard-syntax-table (make-standard-completion-syntax-table))
+
+(defun make-lisp-completion-syntax-table ()
+  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
+	(symbol-chars '(?! ?& ?? ?= ?^))
+	)
+    (dolist (char symbol-chars)
+      (modify-syntax-entry char "_" table))
+    table))
+	   
+(defun make-c-completion-syntax-table ()
+  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
+	(separator-chars '(?+ ?* ?/ ?: ?%))
+	)
+    (dolist (char separator-chars)
+      (modify-syntax-entry char " " table))
+    table))
+
+(defun make-fortran-completion-syntax-table ()
+  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
+	(separator-chars '(?+ ?- ?* ?/ ?:))
+	)
+    (dolist (char separator-chars)
+      (modify-syntax-entry char " " table))
+    table))
+
+(defconst cmpl-lisp-syntax-table       (make-lisp-completion-syntax-table))
+(defconst cmpl-c-syntax-table          (make-c-completion-syntax-table))
+(defconst cmpl-fortran-syntax-table    (make-fortran-completion-syntax-table))
+
+(defvar cmpl-syntax-table cmpl-standard-syntax-table
+  "This variable holds the current completion syntax table.")
+(make-variable-buffer-local 'cmpl-syntax-table)
+
+;;;-----------------------------------------------
+;;; Installing the appropriate mode tables
+;;;-----------------------------------------------
+
+(completion-advise lisp-mode-variables :after
+  (setq cmpl-syntax-table cmpl-lisp-syntax-table)
+  )
+
+(completion-advise c-mode :after
+  (setq cmpl-syntax-table cmpl-c-syntax-table)
+  )
+
+(completion-advise fortran-mode :after
+  (setq cmpl-syntax-table cmpl-fortran-syntax-table)
+  (completion-setup-fortran-mode)
+  )
+
+;;;-----------------------------------------------
+;;; Symbol functions
+;;;-----------------------------------------------
+(defvar cmpl-symbol-start nil
+  "Set to the first character of the symbol after one of the completion
+symbol functions is called.")
+(defvar cmpl-symbol-end nil
+  "Set to the last character of the symbol after one of the completion
+symbol functions is called.")
+;;; These are temp. vars. we use to avoid using let.
+;;;   Why ?  Small speed improvement.
+(defvar cmpl-saved-syntax nil)
+(defvar cmpl-saved-point nil)
+
+(defun symbol-under-point ()
+  "Returns the symbol that the point is currently on if it is longer
+than *completion-min-length*."
+  (setq cmpl-saved-syntax (syntax-table))
+  (set-syntax-table cmpl-syntax-table)
+  (cond 
+  ;; Cursor is on following-char and after preceding-char
+    ((memq (char-syntax (following-char)) '(?w ?_))     
+     (setq cmpl-saved-point (point)
+	   cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)
+	   cmpl-symbol-end (scan-sexps cmpl-saved-point 1))
+     ;; remove chars to ignore at the start
+     (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
+	    (goto-char cmpl-symbol-start)
+	    (forward-word 1)
+	    (setq cmpl-symbol-start (point))
+	    (goto-char cmpl-saved-point)
+	    ))
+     ;; remove chars to ignore at the end
+     (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
+	    (goto-char cmpl-symbol-end)
+	    (forward-word -1)
+	    (setq cmpl-symbol-end (point))
+	    (goto-char cmpl-saved-point)
+	    ))
+     ;; restore state
+     (set-syntax-table cmpl-saved-syntax)
+     ;; Return completion if the length is reasonable
+     (if (and (<= (read-time-eval *completion-min-length*)
+		  (- cmpl-symbol-end cmpl-symbol-start))
+	      (<= (- cmpl-symbol-end cmpl-symbol-start)
+		  (read-time-eval *completion-max-length*)))
+	 (buffer-substring cmpl-symbol-start cmpl-symbol-end))
+     )
+    (t 
+     ;; restore table if no symbol
+     (set-syntax-table cmpl-saved-syntax)
+     nil)
+    ))
+
+;;; tests for symbol-under-point
+;;;  `^' indicates cursor pos. where value is returned
+;;;  simple-word-test
+;;;  ^^^^^^^^^^^^^^^^  --> simple-word-test
+;;;  _harder_word_test_
+;;;  ^^^^^^^^^^^^^^^^^^ --> harder_word_test
+;;;  .___.______.
+;;;  --> nil
+;;;  /foo/bar/quux.hello
+;;;  ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
+;;;
+
+(defun symbol-before-point ()
+  "Returns a string of the symbol immediately before point
+or nil if there isn't one longer than *completion-min-length*."       
+  ;; This is called when a word separator is typed so it must be FAST !
+  (setq cmpl-saved-syntax (syntax-table))
+  (set-syntax-table cmpl-syntax-table)
+  ;; Cursor is on following-char and after preceding-char
+  (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
+	 ;; No chars. to ignore at end
+	 (setq cmpl-symbol-end (point)
+	       cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
+	       )
+	 ;; remove chars to ignore at the start
+	 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
+		(goto-char cmpl-symbol-start)
+		(forward-word 1)
+		(setq cmpl-symbol-start (point))
+		(goto-char cmpl-symbol-end)
+		))
+	 ;; restore state
+	 (set-syntax-table cmpl-saved-syntax)
+	 ;; return value if long enough
+	 (if (>= cmpl-symbol-end
+		 (+ cmpl-symbol-start
+		    (read-time-eval *completion-min-length*)))
+	     (buffer-substring cmpl-symbol-start cmpl-symbol-end))
+	 )
+	((= cmpl-preceding-syntax ?w)
+	 ;; chars to ignore at end
+	 (setq cmpl-saved-point (point)
+	       cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1))
+	 ;; take off chars. from end
+	 (forward-word -1)
+	 (setq cmpl-symbol-end (point))
+	 ;; remove chars to ignore at the start
+	 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
+		(goto-char cmpl-symbol-start)
+		(forward-word 1)
+		(setq cmpl-symbol-start (point))
+		))
+	 ;; restore state
+	 (goto-char cmpl-saved-point)
+	 (set-syntax-table cmpl-saved-syntax)
+	 ;; Return completion if the length is reasonable
+	 (if (and (<= (read-time-eval *completion-min-length*)
+		      (- cmpl-symbol-end cmpl-symbol-start))
+		  (<= (- cmpl-symbol-end cmpl-symbol-start)
+		      (read-time-eval *completion-max-length*)))
+	     (buffer-substring cmpl-symbol-start cmpl-symbol-end))
+	 )
+	(t 
+	 ;; restore table if no symbol
+	 (set-syntax-table cmpl-saved-syntax)
+	 nil)
+	))
+
+;;; tests for symbol-before-point
+;;;  `^' indicates cursor pos. where value is returned
+;;;  simple-word-test
+;;;  ^ --> nil
+;;;   ^ --> nil
+;;;          ^  --> simple-w
+;;;                  ^ --> simple-word-test
+;;;  _harder_word_test_
+;;;                   ^  --> harder_word_test
+;;;                    ^  --> harder_word_test
+;;;          ^ --> harder
+;;;  .___....
+;;;  --> nil
+
+(defun symbol-under-or-before-point ()
+  ;;; This could be made slightly faster but it is better to avoid
+  ;;; copying all the code.
+  ;;; However, it is only used by the completion string prompter.
+  ;;; If it comes into common use, it could be rewritten.
+  (setq cmpl-saved-syntax (syntax-table))
+  (set-syntax-table cmpl-syntax-table)
+  (cond ((memq (char-syntax (following-char)) '(?w ?_))
+	 (set-syntax-table cmpl-saved-syntax)
+	 (symbol-under-point))
+	(t
+	 (set-syntax-table cmpl-saved-syntax)
+	 (symbol-before-point))
+	))
+
+
+(defun symbol-before-point-for-complete ()
+  ;; "Returns a string of the symbol immediately before point
+  ;; or nil if there isn't one.  Like symbol-before-point but doesn't trim the
+  ;; end chars."
+  ;; Cursor is on following-char and after preceding-char
+  (setq cmpl-saved-syntax (syntax-table))
+  (set-syntax-table cmpl-syntax-table)
+  (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
+	       '(?_ ?w))
+	 (setq cmpl-symbol-end (point)
+	       cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1)
+	       )
+	 ;; remove chars to ignore at the start
+	 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
+		(goto-char cmpl-symbol-start)
+		(forward-word 1)
+		(setq cmpl-symbol-start (point))
+		(goto-char cmpl-symbol-end)
+		))
+	 ;; restore state
+	 (set-syntax-table cmpl-saved-syntax)
+	 ;; Return completion if the length is reasonable
+	 (if (and (<= (read-time-eval
+		       *completion-prefix-min-length*)
+		      (- cmpl-symbol-end cmpl-symbol-start))
+		  (<= (- cmpl-symbol-end cmpl-symbol-start)
+		      (read-time-eval *completion-max-length*)))
+	     (buffer-substring cmpl-symbol-start cmpl-symbol-end))
+	 )
+	(t 
+	 ;; restore table if no symbol
+	 (set-syntax-table cmpl-saved-syntax)
+	 nil)
+	))
+
+;;; tests for symbol-before-point-for-complete
+;;;  `^' indicates cursor pos. where value is returned
+;;;  simple-word-test
+;;;  ^ --> nil
+;;;   ^ --> nil
+;;;          ^  --> simple-w
+;;;                  ^ --> simple-word-test
+;;;  _harder_word_test_
+;;;                   ^  --> harder_word_test
+;;;                    ^  --> harder_word_test_
+;;;          ^ --> harder_
+;;;  .___....
+;;;  --> nil
+
+
+
+;;;---------------------------------------------------------------------------
+;;; Statistics Recording
+;;;---------------------------------------------------------------------------
+
+;;; Note that the guts of this has been turned off.  The guts
+;;; are in completion-stats.el.
+
+;;;-----------------------------------------------
+;;; Conditionalizing code on *record-cmpl-statistics-p*
+;;;-----------------------------------------------
+;;; All statistics code outside this block should use this
+(defmacro cmpl-statistics-block (&rest body)
+  "Only executes body if we are recording statistics."
+  (list 'cond
+	(list* '*record-cmpl-statistics-p* body)
+	))		 
+
+;;;-----------------------------------------------
+;;; Completion Sources
+;;;-----------------------------------------------
+
+;; ID numbers
+(defconst cmpl-source-unknown 0)
+(defconst cmpl-source-init-file 1)
+(defconst cmpl-source-file-parsing 2)
+(defconst cmpl-source-separator 3)
+(defconst cmpl-source-cursor-moves 4)
+(defconst cmpl-source-interactive 5)
+(defconst cmpl-source-cdabbrev 6)
+(defconst num-cmpl-sources 7)
+(defvar current-completion-source cmpl-source-unknown)
+
+
+
+;;;---------------------------------------------------------------------------
+;;; Completion Method #2: dabbrev-expand style
+;;;---------------------------------------------------------------------------
+;;;
+;;;   This method is used if there are no useful stored completions.  It is 
+;;; based on dabbrev-expand with these differences :
+;;;   1) Faster (we don't use regexps)
+;;;   2) case coercion handled correctly
+;;; This is called cdabbrev to differentiate it.
+;;;   We simply search backwards through the file looking for words which
+;;; start with the same letters we are trying to complete.
+;;;
+
+(defvar cdabbrev-completions-tried nil)
+;;;  "A list of all the cdabbrev completions since the last reset.")
+
+(defvar cdabbrev-current-point 0)
+;;;  "The current point position the cdabbrev search is at.")
+
+(defvar cdabbrev-current-window nil)
+;;;  "The current window we are looking for cdabbrevs in.  T if looking in
+;;; (other-buffer), NIL if no more  cdabbrevs.")
+
+(defvar cdabbrev-wrapped-p nil)
+;;;  "T if the cdabbrev search has wrapped around the file.")
+
+(defvar cdabbrev-abbrev-string "")
+(defvar cdabbrev-start-point 0)
+
+;;; Test strings for cdabbrev
+;;; cdat-upcase   ;;same namestring
+;;; CDAT-UPCASE   ;;ok
+;;; cdat2         ;;too short
+;;; cdat-1-2-3-4  ;;ok
+;;; a-cdat-1      ;;doesn't start correctly
+;;; cdat-simple   ;;ok
+
+
+(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
+  "Resets the cdabbrev search to search for abbrev-string.
+initial-completions-tried is a list of downcased strings to ignore
+during the search."
+  (setq cdabbrev-abbrev-string abbrev-string
+	cdabbrev-completions-tried
+	(cons (downcase abbrev-string) initial-completions-tried)
+	)
+  (reset-cdabbrev-window t)
+  )
+
+(defun set-cdabbrev-buffer ()
+  ;; cdabbrev-current-window must not be NIL
+  (set-buffer (if (eq cdabbrev-current-window t)
+		  (other-buffer)
+		  (window-buffer cdabbrev-current-window)))
+  )
+
+
+(defun reset-cdabbrev-window (&optional initializep)
+  "Resets the cdabbrev search to search for abbrev-string.
+initial-completions-tried is a list of downcased strings to ignore
+during the search."
+  ;; Set the window
+  (cond (initializep
+	 (setq cdabbrev-current-window (selected-window))
+	 )
+	((eq cdabbrev-current-window t)
+	 ;; Everything has failed
+	 (setq cdabbrev-current-window nil))
+	(cdabbrev-current-window
+	 (setq cdabbrev-current-window (next-window cdabbrev-current-window))
+	 (if (eq cdabbrev-current-window (selected-window))
+	     ;; No more windows, try other buffer.
+	     (setq cdabbrev-current-window t)))
+	)
+  (when cdabbrev-current-window
+    (save-excursion
+      (set-cdabbrev-buffer)
+      (setq cdabbrev-current-point (point)
+	    cdabbrev-start-point cdabbrev-current-point
+	    cdabbrev-stop-point
+	    (if *cdabbrev-radius*
+		(max (point-min)
+		     (- cdabbrev-start-point *cdabbrev-radius*))
+		(point-min))
+	    cdabbrev-wrapped-p nil)
+      )))
+
+(defun next-cdabbrev ()
+  "Return the next possible cdabbrev expansion or nil if there isn't one.
+reset-cdabbrev must've been called.  This is sensitive to case-fold-search."
+  ;; note that case-fold-search affects the behavior of this function
+  ;; Bug: won't pick up an expansion that starts at the top of buffer
+  (when cdabbrev-current-window
+    (let (saved-point 
+	  saved-syntax
+	  (expansion nil)
+	  downcase-expansion tried-list syntax saved-point-2)
+      (save-excursion
+	(unwind-protect
+	    (progn
+	      ;; Switch to current completion buffer
+	      (set-cdabbrev-buffer)
+	      ;; Save current buffer state
+	      (setq saved-point  (point)
+		    saved-syntax (syntax-table))
+	      ;; Restore completion state
+	      (set-syntax-table cmpl-syntax-table)
+	      (goto-char cdabbrev-current-point)
+	      ;; Loop looking for completions
+	      (while
+		  ;; This code returns t if it should loop again
+		  (cond
+		    (;; search for the string
+		     (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t)
+		     ;; return nil if the completion is valid
+		     (not
+		      (and
+		       ;; does it start with a separator char ?
+		       (or (= (setq syntax (char-syntax (preceding-char))) ? )
+			   (and (= syntax ?w)
+				;; symbol char to ignore at end.  Are we at end ?
+				(progn
+				  (setq saved-point-2 (point))
+				  (forward-word -1)
+				  (prog1
+				    (= (char-syntax (preceding-char)) ? )
+				    (goto-char saved-point-2)
+				    ))))
+		       ;; is the symbol long enough ?
+		       (setq expansion (symbol-under-point))
+		       ;; have we not tried this one before
+		       (progn
+			 ;; See if we've already used it
+			 (setq tried-list cdabbrev-completions-tried
+			       downcase-expansion (downcase expansion))
+			 (while (and tried-list
+				     (not (string-equal downcase-expansion
+							(car tried-list))))
+			   ;; Already tried, don't choose this one
+			   (setq tried-list (cdr tried-list))
+			   )
+			 ;; at this point tried-list will be nil if this
+			 ;; expansion has not yet been tried
+			 (if tried-list
+			     (setq expansion nil)
+			     t)
+			 ))))
+		    ;; search failed
+		    (cdabbrev-wrapped-p
+		     ;; If already wrapped, then we've failed completely
+		     nil)
+		    (t
+		     ;; need to wrap
+		     (goto-char (setq cdabbrev-current-point
+				      (if *cdabbrev-radius*
+					  (min (point-max) (+ cdabbrev-start-point *cdabbrev-radius*))
+					  (point-max))))
+		
+		     (setq cdabbrev-wrapped-p t))
+		    ))
+	      ;; end of while loop
+	      (cond (expansion
+		     ;; successful
+		     (setq cdabbrev-completions-tried
+			   (cons downcase-expansion cdabbrev-completions-tried)
+			   cdabbrev-current-point (point))))
+	      )
+	  (set-syntax-table saved-syntax)
+	  (goto-char saved-point)
+	  ))
+      ;; If no expansion, go to next window
+      (cond (expansion)
+	    (t (reset-cdabbrev-window)
+	       (next-cdabbrev)))
+      )))
+
+;;; The following must be eval'd in the minibuffer ::
+;;; (reset-cdabbrev "cdat")
+;;; (next-cdabbrev)  --> "cdat-simple"
+;;; (next-cdabbrev)  --> "cdat-1-2-3-4"
+;;; (next-cdabbrev)  --> "CDAT-UPCASE"
+;;; (next-cdabbrev)  --> "cdat-wrapping"
+;;; (next-cdabbrev)  --> "cdat_start_sym"
+;;; (next-cdabbrev)  --> nil
+;;; (next-cdabbrev)  --> nil
+;;; (next-cdabbrev)  --> nil
+
+;;; _cdat_start_sym
+;;; cdat-wrapping
+
+
+;;;---------------------------------------------------------------------------
+;;; Completion Database
+;;;---------------------------------------------------------------------------
+
+;;; We use two storage modes for the two search types ::
+;;;  1) Prefix {cmpl-prefix-obarray} for looking up possible completions
+;;;      Used by search-completion-next
+;;;      the value of the symbol is nil or a cons of head and tail pointers
+;;;  2) Interning {cmpl-obarray} to see if it's in the database
+;;;      Used by find-exact-completion, completion-in-database-p
+;;;      The value of the symbol is the completion entry
+
+;;; bad things may happen if this length is changed due to the way
+;;; GNU implements obarrays
+(defconst cmpl-obarray-length 511)
+
+(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
+  "An obarray used to store the downcased completion prefices.
+Each symbol is bound to a list of completion entries.")
+
+(defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
+  "An obarray used to store the downcased completions.
+Each symbol is bound to a single completion entry.")
+
+;;;-----------------------------------------------
+;;; Completion Entry Structure Definition
+;;;-----------------------------------------------
+
+;;; A completion entry is a LIST of string, prefix-symbol num-uses, and
+;;; last-use-time (the time the completion was last used)
+;;; last-use-time is T if the string should be kept permanently
+;;; num-uses is incremented everytime the completion is used.
+
+;;; We chose lists because (car foo) is faster than (aref foo 0) and the 
+;;; creation time is about the same.
+
+;;; READER MACROS
+
+(defmacro completion-string (completion-entry)
+  (list 'car completion-entry))
+
+(defmacro completion-num-uses (completion-entry)
+  ;;  "The number of times it has used.  Used to decide whether to save 
+  ;; it."
+  (list 'car (list 'cdr completion-entry)))
+
+(defmacro completion-last-use-time (completion-entry)
+  ;;  "The time it was last used.  In hours since 1900.  Used to decide
+  ;; whether to save it.  T if one should always save it."
+  (list 'nth 2 completion-entry))
+
+(defmacro completion-source (completion-entry)
+  (list 'nth 3 completion-entry))
+
+;;; WRITER MACROS
+(defmacro set-completion-string (completion-entry string)
+  (list 'setcar completion-entry string))
+
+(defmacro set-completion-num-uses (completion-entry num-uses)
+  (list 'setcar (list 'cdr completion-entry) num-uses))
+
+(defmacro set-completion-last-use-time (completion-entry last-use-time)
+  (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
+
+;;; CONSTRUCTOR
+(defun make-completion (string)
+  "Returns a list of a completion entry."
+  (list (list string 0 nil current-completion-source)))
+
+;; Obsolete
+;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
+;;  (list 'car (list 'cdr completion-entry)))
+
+
+
+;;;-----------------------------------------------
+;;; Prefix symbol entry definition
+;;;-----------------------------------------------
+;;; A cons of (head . tail)
+
+;;; READER Macros
+
+(defmacro cmpl-prefix-entry-head (prefix-entry)
+  (list 'car prefix-entry))
+
+(defmacro cmpl-prefix-entry-tail (prefix-entry)
+  (list 'cdr prefix-entry))
+
+;;; WRITER Macros
+
+(defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
+  (list 'setcar prefix-entry new-head))
+
+(defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
+  (list 'setcdr prefix-entry new-tail))
+
+;;; Contructor
+
+(defun make-cmpl-prefix-entry (completion-entry-list)
+  "Makes a new prefix entry containing only completion-entry."
+  (cons completion-entry-list completion-entry-list))
+
+;;;-----------------------------------------------
+;;; Completion Database - Utilities
+;;;-----------------------------------------------
+
+(defun clear-all-completions ()
+  "Initializes the completion storage.  All existing completions are lost."
+  (interactive)
+  (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
+  (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
+  (cmpl-statistics-block
+    (record-clear-all-completions))
+  )
+
+(defun list-all-completions ()
+  "Returns a list of all the known completion entries."
+  (let ((return-completions nil))
+    (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
+    return-completions))
+
+(defun list-all-completions-1 (prefix-symbol)
+  (if (boundp prefix-symbol)
+      (setq return-completions
+	    (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
+		    return-completions))))
+
+(defun list-all-completions-by-hash-bucket ()
+  "Returns a list of lists of all the known completion entries organized by 
+hash bucket."
+  (let ((return-completions nil))
+    (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
+    return-completions))
+
+(defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
+  (if (boundp prefix-symbol)
+      (setq return-completions
+	    (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
+		  return-completions))))
+
+
+;;;-----------------------------------------------
+;;; Updating the database
+;;;-----------------------------------------------
+;;;
+;;;   These are the internal functions used to update the datebase
+;;;
+;;;
+(defvar completion-to-accept nil)
+  ;;"Set to a string that is pending its acceptance."
+  ;; this checked by the top level reading functions
+
+(defvar cmpl-db-downcase-string nil)
+  ;; "Setup by find-exact-completion, etc.  The given string, downcased."
+(defvar cmpl-db-symbol nil)
+  ;; "The interned symbol corresponding to cmpl-db-downcase-string.
+  ;; Set up by cmpl-db-symbol."
+(defvar cmpl-db-prefix-symbol nil)
+  ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
+(defvar cmpl-db-entry nil)
+(defvar cmpl-db-debug-p nil
+  "Set to T if you want to debug the database.")
+
+;;; READS
+(defun find-exact-completion (string)
+  "Returns the completion entry for string or nil.
+Sets up cmpl-db-downcase-string and cmpl-db-symbol."
+  (and (boundp (setq cmpl-db-symbol
+		     (intern (setq cmpl-db-downcase-string (downcase string))
+			     cmpl-obarray)))
+       (symbol-value cmpl-db-symbol)
+       ))
+
+(defun find-cmpl-prefix-entry (prefix-string)
+  "Returns the prefix entry for string. Sets cmpl-db-prefix-symbol.
+Prefix-string must be exactly *completion-prefix-min-length* long
+and downcased.  Sets up cmpl-db-prefix-symbol."
+  (and (boundp (setq cmpl-db-prefix-symbol
+		     (intern prefix-string cmpl-prefix-obarray)))
+       (symbol-value cmpl-db-prefix-symbol)))
+
+(defvar inside-locate-completion-entry nil)
+;; used to trap lossage in silent error correction
+
+(defun locate-completion-entry (completion-entry prefix-entry)
+  "Locates the completion entry.  Returns a pointer to the element
+before the completion entry or nil if the completion entry is at the head.
+Must be called after find-exact-completion."
+  (let ((prefix-list (cmpl-prefix-entry-head prefix-entry))
+	 next-prefix-list
+	 )
+    (cond
+      ((not (eq (car prefix-list) completion-entry))
+       ;; not already at head
+       (while (and prefix-list
+		   (not (eq completion-entry
+			    (car (setq next-prefix-list (cdr prefix-list)))
+			    )))
+	 (setq prefix-list next-prefix-list))
+       (cond (;; found
+	      prefix-list)
+	     ;; Didn't find it.  Database is messed up.
+	     (cmpl-db-debug-p
+	      ;; not found, error if debug mode
+	      (error "Completion entry exists but not on prefix list - %s"
+		     string))
+	     (inside-locate-completion-entry
+	      ;; recursive error: really scrod
+	      (locate-completion-db-error))
+	     (t
+	       ;; Patch out
+	       (set cmpl-db-symbol nil)
+	       ;; Retry
+	       (locate-completion-entry-retry completion-entry)
+	       ))))))
+
+(defun locate-completion-entry-retry (old-entry)
+  (let ((inside-locate-completion-entry t))
+    (add-completion (completion-string old-entry)
+		    (completion-num-uses old-entry)
+		    (completion-last-use-time old-entry))
+    (let ((cmpl-entry (find-exact-completion (completion-string old-entry)))
+	  (pref-entry
+	   (if cmpl-entry
+	       (find-cmpl-prefix-entry
+		 (substring cmpl-db-downcase-string
+			    0 *completion-prefix-min-length*))))
+	  )
+      (if (and cmpl-entry pref-entry)
+	  ;; try again
+	  (locate-completion-entry cmpl-entry pref-entry)
+	  ;; still losing
+	  (locate-completion-db-error))
+      )))
+
+(defun locate-completion-db-error ()
+  ;; recursive error: really scrod
+  (error "Completion database corrupted.  Try M-x clear-all-completions.  Send bug report.")
+  )
+
+;;; WRITES
+(defun add-completion-to-tail-if-new (string)
+  "If the string is not in the database it is added to the end of the
+approppriate prefix list with num-uses = 0.  The database is unchanged if it 
+is there.  string must be longer than *completion-prefix-min-length*.
+This must be very fast.
+Returns the completion entry."
+  (or (find-exact-completion string)
+      ;; not there
+      (let (;; create an entry
+	    (entry (make-completion string))
+	    ;; setup the prefix
+	    (prefix-entry (find-cmpl-prefix-entry
+			    (substring cmpl-db-downcase-string 0
+				       (read-time-eval
+					*completion-prefix-min-length*))))
+	    )
+	;; The next two forms should happen as a unit (atomically) but
+	;; no fatal errors should result if that is not the case.
+	(cond (prefix-entry
+	       ;; These two should be atomic, but nothing fatal will happen
+	       ;; if they're not.
+	       (setcdr (cmpl-prefix-entry-tail prefix-entry) entry)
+	       (set-cmpl-prefix-entry-tail prefix-entry entry))
+	      (t
+	       (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
+	       ))
+	;; statistics
+	(cmpl-statistics-block
+	  (note-added-completion))
+	;; set symbol
+	(set cmpl-db-symbol (car entry))
+	)))
+
+(defun add-completion-to-head (string)
+  "If the string is not in the database it is added to the head of the
+approppriate prefix list.  Otherwise it is moved to the head of the list.
+string must be longer than *completion-prefix-min-length*.
+Updates the saved string with the supplied string.
+This must be very fast.
+Returns the completion entry."
+  ;; Handle pending acceptance
+  (if completion-to-accept (accept-completion))
+  ;; test if already in database
+  (if (setq cmpl-db-entry (find-exact-completion string))
+      ;; found
+      (let* ((prefix-entry (find-cmpl-prefix-entry
+			     (substring cmpl-db-downcase-string 0
+					(read-time-eval
+					 *completion-prefix-min-length*))))
+	     (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
+	     (cmpl-ptr (cdr splice-ptr))
+	     )
+	;; update entry
+	(set-completion-string cmpl-db-entry string)
+	;; move to head (if necessary)
+	(cond (splice-ptr
+	       ;; These should all execute atomically but it is not fatal if
+	       ;; they don't.
+	       ;; splice it out
+	       (or (setcdr splice-ptr (cdr cmpl-ptr))
+		   ;; fix up tail if necessary
+		   (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
+	       ;; splice in at head
+	       (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
+	       (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)
+	       ))
+	cmpl-db-entry)
+    ;; not there
+    (let (;; create an entry
+	  (entry (make-completion string))
+	  ;; setup the prefix
+	  (prefix-entry (find-cmpl-prefix-entry
+			  (substring cmpl-db-downcase-string 0
+				     (read-time-eval
+				      *completion-prefix-min-length*))))
+	  )
+      (cond (prefix-entry
+	     ;; Splice in at head
+	     (setcdr entry (cmpl-prefix-entry-head prefix-entry))
+	     (set-cmpl-prefix-entry-head prefix-entry entry))
+	    (t
+	     ;; Start new prefix entry
+	     (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
+	     ))
+      ;; statistics
+      (cmpl-statistics-block
+	(note-added-completion))
+      ;; Add it to the symbol
+      (set cmpl-db-symbol (car entry))
+      )))
+      
+(defun delete-completion (string)
+  "Deletes the completion from the database.  string must be longer than
+*completion-prefix-min-length*."
+  ;; Handle pending acceptance
+  (if completion-to-accept (accept-completion))
+  (if (setq cmpl-db-entry (find-exact-completion string))
+      ;; found
+      (let* ((prefix-entry (find-cmpl-prefix-entry 
+			     (substring cmpl-db-downcase-string 0
+					(read-time-eval
+					 *completion-prefix-min-length*))))
+	     (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
+	     )
+	 ;; delete symbol reference
+	 (set cmpl-db-symbol nil)
+	 ;; remove from prefix list
+	 (cond (splice-ptr
+		;; not at head
+		(or (setcdr splice-ptr (cdr (cdr splice-ptr)))
+		    ;; fix up tail if necessary
+		    (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
+		)
+	       (t
+		;; at head
+		(or (set-cmpl-prefix-entry-head
+		      prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
+		    ;; List is now empty
+		    (set cmpl-db-prefix-symbol nil))
+		))
+	 (cmpl-statistics-block
+	   (note-completion-deleted))
+	 )
+      (error "Unknown completion: %s.  Couldn't delete it." string)
+      ))
+
+;;; Tests --
+;;;  - Add and Find -
+;;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
+;;; (find-exact-completion "banana")      --> ("banana" 0 nil 0)
+;;; (find-exact-completion "bana")        --> nil
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
+;;; (add-completion-to-head "banish")     --> ("banish" 0 nil 0)
+;;; (find-exact-completion "banish")      --> ("banish" 0 nil 0)
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banish" ...) ("banana" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
+;;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
+;;;
+;;;  - Deleting -
+;;; (add-completion-to-head "banner")     --> ("banner" 0 nil 0)
+;;; (delete-completion "banner")        
+;;; (find-exact-completion "banner")      --> nil
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
+;;; (add-completion-to-head "banner")     --> ("banner" 0 nil 0) 
+;;; (delete-completion "banana")        
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banner" ...) ("banish" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
+;;; (delete-completion "banner")        
+;;; (delete-completion "banish")                 
+;;; (find-cmpl-prefix-entry "ban")        --> nil
+;;; (delete-completion "banner")          --> error
+;;;
+;;; - Tail -
+;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
+;;; (car (find-cmpl-prefix-entry "ban"))     --> (("banana" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))     --> (("banana" ...))
+;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
+;;; (car (find-cmpl-prefix-entry "ban"))     -->(("banana" ...) ("banish" ...))
+;;; (cdr (find-cmpl-prefix-entry "ban"))     -->(("banish" ...))
+;;;
+
+
+;;;---------------------------------------------------------------------------
+;;; Database Update :: Interface level routines
+;;;---------------------------------------------------------------------------
+;;; 
+;;; These lie on top of the database ref. functions but below the standard
+;;; user interface level
+
+
+(defun interactive-completion-string-reader (prompt)
+  (let* ((default (symbol-under-or-before-point))
+	 (new-prompt
+	  (if default
+	      (format "%s: (default: %s) " prompt default)
+	      (format "%s: " prompt))
+	   )
+	 (read (completing-read new-prompt cmpl-obarray))
+	 )
+    (if (zerop (length read)) (setq read (or default "")))
+    (list read)
+    ))
+
+(defun check-completion-length (string)
+  (if (< (length string) *completion-min-length*)
+      (error "The string \"%s\" is too short to be saved as a completion."
+	     string)
+      (list string)))
+
+(defun add-completion (string &optional num-uses last-use-time)
+  "If the string is not there, it is added to the head of the completion list.
+Otherwise, it is moved to the head of the list.
+The completion is altered appropriately if num-uses and/or last-use-time is 
+specified."
+  (interactive (interactive-completion-string-reader "Completion to add"))
+  (check-completion-length string)
+  (let* ((current-completion-source (if (interactive-p)
+					cmpl-source-interactive
+					current-completion-source))
+	 (entry (add-completion-to-head string)))
+    
+    (if num-uses (set-completion-num-uses entry num-uses))
+    (if last-use-time
+	(set-completion-last-use-time entry last-use-time))
+    ))
+
+(defun add-permanent-completion (string)
+  "Adds string if it isn't already there and and makes it a permanent string."
+  (interactive
+    (interactive-completion-string-reader "Completion to add permanently"))
+  (let ((current-completion-source (if (interactive-p)
+				       cmpl-source-interactive
+				       current-completion-source))
+	)
+    (add-completion string nil t)
+    ))
+
+(defun kill-completion (string)
+  (interactive (interactive-completion-string-reader "Completion to kill"))
+  (check-completion-length string)
+  (delete-completion string)
+  )
+
+(defun accept-completion ()
+  "Accepts the pending completion in completion-to-accept.
+This bumps num-uses.  Called by add-completion-to-head and 
+completion-search-reset."
+  (let ((string completion-to-accept)
+	;; if this is added afresh here, then it must be a cdabbrev
+	(current-completion-source cmpl-source-cdabbrev)
+	entry
+	)
+    (setq completion-to-accept nil)
+    (setq entry (add-completion-to-head string))
+    (set-completion-num-uses entry (1+ (completion-num-uses entry)))
+    (setq cmpl-completions-accepted-p t)
+    ))
+
+(defun use-completion-under-point ()
+  "Call this to add the completion symbol underneath the point into
+the completion buffer."
+  (let ((string (and *completep* (symbol-under-point)))
+	(current-completion-source cmpl-source-cursor-moves))
+    (if string (add-completion-to-head string))))
+	
+(defun use-completion-before-point ()
+  "Call this to add the completion symbol before point into
+the completion buffer."
+  (let ((string (and *completep* (symbol-before-point)))
+	(current-completion-source cmpl-source-cursor-moves))
+    (if string (add-completion-to-head string))))
+
+(defun use-completion-under-or-before-point ()
+  "Call this to add the completion symbol before point into
+the completion buffer."
+  (let ((string (and *completep* (symbol-under-or-before-point)))
+	(current-completion-source cmpl-source-cursor-moves))
+    (if string (add-completion-to-head string))))
+
+(defun use-completion-before-separator ()
+  "Call this to add the completion symbol before point into
+the completion buffer.  Completions added this way will automatically be
+saved if *separator-character-uses-completion-p* is non-nil."
+  (let ((string (and *completep* (symbol-before-point)))
+	(current-completion-source cmpl-source-separator)
+	entry)
+    (cmpl-statistics-block
+      (note-separator-character string)
+      )
+    (cond (string
+	   (setq entry (add-completion-to-head string))
+	   (when (and *separator-character-uses-completion-p*
+		      (zerop (completion-num-uses entry)))
+	     (set-completion-num-uses entry 1)
+	     (setq cmpl-completions-accepted-p t)
+	     )))
+    ))
+
+;;; Tests --
+;;;  - Add and Find -
+;;; (add-completion "banana" 5 10)  
+;;; (find-exact-completion "banana")  --> ("banana" 5 10 0)
+;;; (add-completion "banana" 6)     
+;;; (find-exact-completion "banana")  --> ("banana" 6 10 0)
+;;; (add-completion "banish")
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banish" ...) ("banana" ...))
+;;;
+;;;  - Accepting -
+;;; (setq completion-to-accept "banana")
+;;; (accept-completion)                   
+;;; (find-exact-completion "banana")      --> ("banana" 7 10)
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
+;;; (setq completion-to-accept "banish")
+;;; (add-completion "banner")           
+;;; (car (find-cmpl-prefix-entry "ban"))
+;;;        --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
+;;;
+;;;  - Deleting -
+;;; (kill-completion "banish")          
+;;; (car (find-cmpl-prefix-entry "ban"))  --> (("banner" ...) ("banana" ...))
+
+
+;;;---------------------------------------------------------------------------
+;;; Searching the database
+;;;---------------------------------------------------------------------------
+;;; Functions outside this block must call completion-search-reset followed
+;;; by calls to completion-search-next or completion-search-peek
+;;;
+
+;;; Status variables
+;; Commented out to improve loading speed
+(defvar cmpl-test-string "")
+;;  "The current string used by completion-search-next."
+(defvar cmpl-test-regexp "")
+;;  "The current regexp used by completion-search-next. 
+;;   (derived from cmpl-test-string)"
+(defvar cmpl-last-index 0)
+;;  "The last index that completion-search-next was called with."
+(defvar cmpl-cdabbrev-reset-p nil)
+;;  "Set to t when cdabbrevs have been reset."
+(defvar cmpl-next-possibilities nil)
+;;   "A pointer to the element BEFORE the next set of possible completions.
+;;  cadr of this is the cmpl-next-possibility"
+(defvar cmpl-starting-possibilities nil)
+;;  "The initial list of starting possibilities."
+(defvar cmpl-next-possibility nil)
+;;   "The cached next possibility."
+(defvar cmpl-tried-list nil)
+;;   "A downcased list of all the completions we have tried."
+
+
+(defun completion-search-reset (string)
+  "Given a string, sets up the get-completion and completion-search-next functions.
+String must be longer than *completion-prefix-min-length*."
+  (if completion-to-accept (accept-completion))
+  (setq cmpl-starting-possibilities
+	(cmpl-prefix-entry-head
+	  (find-cmpl-prefix-entry (downcase (substring string 0 3))))
+	cmpl-test-string string
+	cmpl-test-regexp (concat (regexp-quote string) "."))
+  (completion-search-reset-1)
+  )
+
+(defun completion-search-reset-1 ()
+  (setq cmpl-next-possibilities cmpl-starting-possibilities
+	cmpl-next-possibility   nil
+	cmpl-cdabbrev-reset-p nil
+	cmpl-last-index -1
+	cmpl-tried-list nil
+	))
+
+(defun completion-search-next (index)
+  "Returns the next completion entry.  If index is out of sequence it resets
+and starts from the top.  If there are no more entries it tries cdabbrev and 
+returns only a string."
+  (cond
+    ((= index (setq cmpl-last-index (1+ cmpl-last-index)))
+     (completion-search-peek t))
+    ((minusp index)
+     (completion-search-reset-1)
+     (setq cmpl-last-index index)
+     ;; reverse the possibilities list
+     (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
+     ;; do a "normal" search
+     (while (and (completion-search-peek nil)
+		 (minusp (setq index (1+ index))))
+       (setq cmpl-next-possibility nil)
+       )
+     (cond ((not cmpl-next-possibilities))
+	    ;; If no more possibilities, leave it that way
+	   ((= -1 cmpl-last-index)
+	    ;; next completion is at index 0.  reset next-possibility list 
+	    ;; to start at beginning
+	    (setq cmpl-next-possibilities cmpl-starting-possibilities))
+	   (t
+	    ;; otherwise point to one before current
+	    (setq cmpl-next-possibilities
+		  (nthcdr (- (length cmpl-starting-possibilities)
+			     (length cmpl-next-possibilities))
+			  cmpl-starting-possibilities))
+	    )))
+    (t
+     ;; non-negative index, reset and search
+     ;;(prin1 'reset)
+     (completion-search-reset-1)
+     (setq cmpl-last-index index)
+     (while (and (completion-search-peek t)
+		 (not (minusp (setq index (1- index)))))
+       (setq cmpl-next-possibility nil)
+       ))
+    )
+  (prog1
+      cmpl-next-possibility
+    (setq cmpl-next-possibility nil)
+    ))
+      
+
+(defun completion-search-peek (use-cdabbrev)
+  "Returns the next completion entry without actually moving the pointers.
+Calling this again or calling completion-search-next will result in the same 
+string being returned.  Depends on case-fold-search.
+If there are no more entries it tries cdabbrev and then returns only a string."
+  (cond
+    ;; return the cached value if we have it
+    (cmpl-next-possibility)
+    ((and cmpl-next-possibilities
+	  ;; still a few possibilities left
+	  (progn
+	    (while
+		(and (not (eq 0 (string-match cmpl-test-regexp
+					      (completion-string (car cmpl-next-possibilities)))))
+		     (setq cmpl-next-possibilities (cdr cmpl-next-possibilities))
+		     ))
+	    cmpl-next-possibilities
+	    ))
+     ;; successful match
+     (setq cmpl-next-possibility (car cmpl-next-possibilities)
+	   cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility))
+				 cmpl-tried-list)
+	   cmpl-next-possibilities (cdr cmpl-next-possibilities)
+	   )
+     cmpl-next-possibility)
+    (use-cdabbrev
+     ;; unsuccessful, use cdabbrev
+     (cond ((not cmpl-cdabbrev-reset-p)
+	    (reset-cdabbrev cmpl-test-string cmpl-tried-list)
+	    (setq cmpl-cdabbrev-reset-p t)
+	    ))
+     (setq cmpl-next-possibility (next-cdabbrev))
+     )
+    ;; Completely unsuccessful, return nil
+    ))
+
+;;; Tests --
+;;;  - Add and Find -
+;;; (add-completion "banana")       
+;;; (completion-search-reset "ban")  
+;;; (completion-search-next 0)        --> "banana"
+;;;
+;;;  - Discrimination -
+;;; (add-completion "cumberland")       
+;;; (add-completion "cumberbund")       
+;;; cumbering   
+;;; (completion-search-reset "cumb")
+;;; (completion-search-peek t)        --> "cumberbund"
+;;; (completion-search-next 0)        --> "cumberbund"
+;;; (completion-search-peek t)        --> "cumberland"
+;;; (completion-search-next 1)        --> "cumberland"
+;;; (completion-search-peek nil)      --> nil
+;;; (completion-search-next 2)        --> "cumbering"  {cdabbrev}
+;;; (completion-search-next 3)        -->  nil or "cumming"{depends on context}
+;;; (completion-search-next 1)        --> "cumberland"
+;;; (completion-search-peek t)        --> "cumbering"  {cdabbrev}
+;;;
+;;;  - Accepting -
+;;; (completion-search-next 1)        --> "cumberland"
+;;; (setq completion-to-accept "cumberland")
+;;; (completion-search-reset "foo")
+;;; (completion-search-reset "cum")
+;;; (completion-search-next 0)        --> "cumberland"
+;;;
+;;;  - Deleting -
+;;; (kill-completion "cumberland")
+;;; cummings    
+;;; (completion-search-reset "cum")
+;;; (completion-search-next 0)        --> "cumberbund"
+;;; (completion-search-next 1)        --> "cummings"
+;;;
+;;;  - Ignoring Capitalization -
+;;; (completion-search-reset "CuMb")
+;;; (completion-search-next 0)            --> "cumberbund"
+
+
+
+;;;-----------------------------------------------
+;;; COMPLETE
+;;;-----------------------------------------------
+
+(defun completion-mode ()
+  "Toggles whether or not new words are added to the database."
+  (interactive)
+  (setq *completep* (not *completep*))
+  (message "Completion mode is now %s." (if *completep* "ON" "OFF"))
+  )
+	
+(defvar cmpl-current-index 0)
+(defvar cmpl-original-string nil)
+(defvar cmpl-last-insert-location -1)
+(defvar cmpl-leave-point-at-start nil)
+
+(defun complete (&optional arg)
+  "Inserts a completion at point.  
+Point is left at end.  Consective calls rotate through all possibilities.
+Prefix args ::
+  control-u :: leave the point at the beginning of the completion rather 
+               than at the end.
+  a number  :: rotate through the possible completions by that amount
+  `-'       :: same as -1 (insert previous completion)
+ {See the comments at the top of completion.el for more info.}
+"
+  (interactive "*p")
+  ;;; Set up variables
+  (cond ((eq last-command this-command)
+	 ;; Undo last one
+	 (delete-region cmpl-last-insert-location (point))
+	 ;; get next completion
+	 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))
+	 )
+	(t
+	 (if (not cmpl-initialized-p)
+	     (initialize-completions)) ;; make sure everything's loaded
+	 (cond ((consp current-prefix-arg) ;; control-u
+		(setq arg 0)
+		(setq cmpl-leave-point-at-start t)
+		)
+	       (t
+		(setq cmpl-leave-point-at-start nil)
+		))
+	 ;; get string
+	 (setq cmpl-original-string (symbol-before-point-for-complete))
+	 (cond ((not cmpl-original-string)
+		(setq this-command 'failed-complete)
+		(error "To complete, the point must be after a symbol at least %d character long."
+		       *completion-prefix-min-length*)))
+	 ;; get index	     
+	 (setq cmpl-current-index (if current-prefix-arg arg 0))
+	 ;; statistics
+	 (cmpl-statistics-block
+	   (note-complete-entered-afresh cmpl-original-string))
+	 ;; reset database
+	 (completion-search-reset cmpl-original-string)
+	 ;; erase what we've got
+	 (delete-region cmpl-symbol-start cmpl-symbol-end)
+	 ))
+
+  ;; point is at the point to insert the new symbol
+  ;; Get the next completion
+  (let* ((print-status-p
+	  (and (>= (cmpl19-baud-rate) *print-next-completion-speed-threshold*)
+	       (not (minibuffer-window-selected-p))))
+	 (insert-point (point))
+	 (entry (completion-search-next cmpl-current-index))
+	 string
+	 )
+    ;; entry is either a completion entry or a string (if cdabbrev)
+
+    ;; If found, insert
+    (cond (entry
+	   ;; Setup for proper case
+	   (setq string (if (stringp entry)
+			    entry (completion-string entry)))
+	   (setq string (cmpl-merge-string-cases
+			  string cmpl-original-string))
+	   ;; insert
+	   (insert string)
+	   ;; accept it
+	   (setq completion-to-accept string)
+	   ;; fixup and cache point
+	   (cond (cmpl-leave-point-at-start
+		  (setq cmpl-last-insert-location (point))
+		  (goto-char insert-point))
+		 (t;; point at end,
+		  (setq cmpl-last-insert-location insert-point))
+		 )
+	   ;; statistics
+	   (cmpl-statistics-block
+	     (note-complete-inserted entry cmpl-current-index))
+	   ;; Done ! cmpl-stat-complete-successful
+	   ;;display the next completion
+	   (cond
+	     ((and print-status-p
+		   ;; This updates the display and only prints if there
+		   ;; is no typeahead
+		   (cmpl19-sit-for 0)
+		   (setq entry
+			 (completion-search-peek
+			   *print-next-completion-does-cdabbrev-search-p*)))
+	      (setq string (if (stringp entry)
+			       entry (completion-string entry)))
+	      (setq string (cmpl-merge-string-cases
+			     string cmpl-original-string))
+	      (message "Next completion: %s" string)
+	      ))
+	   )
+	  (t;; none found, insert old 
+	   (insert cmpl-original-string)
+	   ;; Don't accept completions
+	   (setq completion-to-accept nil)
+	   ;; print message
+	   (if (and print-status-p (cmpl19-sit-for 0))
+	       (message "No %scompletions."
+			(if (eq this-command last-command) "more " "")))
+	   ;; statistics
+	   (cmpl-statistics-block
+	     (record-complete-failed cmpl-current-index))
+	   ;; Pretend that we were never here
+	   (setq this-command 'failed-complete)
+	   ))))
+
+;;;-----------------------------------------------
+;;; "Complete" Key Keybindings
+;;;-----------------------------------------------
+
+;;; Complete key definition
+;;;  These define c-return and meta-return
+;;; In any case you really want to bind this to a single keystroke
+(if (fboundp 'key-for-others-chord)
+    (condition-case e
+	 ;; this can fail if some of the prefix chars. are already used
+	 ;; as commands (this happens on wyses)
+	 (global-set-key (key-for-others-chord "return" '(control)) 'complete)
+      (error)
+      ))
+(if (fboundp 'gmacs-keycode)
+    (global-set-key (gmacs-keycode "return" '(control)) 'complete)
+    )
+(global-set-key "\M-\r" 'complete)
+
+;;; Tests -
+;;; (add-completion "cumberland")
+;;; (add-completion "cumberbund")
+;;; cum
+;;; Cumber
+;;; cumbering
+;;; cumb
+
+
+;;;---------------------------------------------------------------------------
+;;; Parsing definitions from files into the database
+;;;---------------------------------------------------------------------------
+
+;;;-----------------------------------------------
+;;; Top Level functions ::
+;;;-----------------------------------------------
+
+;;; User interface
+(defun add-completions-from-file (file)
+  "Parses all the definition names from a Lisp mode file and adds them to the 
+completion database."
+  (interactive "fFile: ")
+  (setq file (if (fboundp 'expand-file-name-defaulting)
+		 (expand-file-name-defaulting file)
+		 (expand-file-name file)))
+  (let* ((buffer (get-file-buffer file))
+	 (buffer-already-there-p buffer)
+	 )
+    (when (not buffer-already-there-p)
+      (let ((*modes-for-completion-find-file-hook* nil))
+	(setq buffer (find-file-noselect file))
+	))
+    (unwind-protect
+	 (save-excursion
+	   (set-buffer buffer)
+	   (add-completions-from-buffer)
+	   )
+      (when (not buffer-already-there-p)
+	(kill-buffer buffer))
+      )))
+
+(defun add-completions-from-buffer ()
+  (interactive)
+  (let ((current-completion-source cmpl-source-file-parsing)
+	(start-num
+	 (cmpl-statistics-block
+	  (aref completion-add-count-vector cmpl-source-file-parsing)))
+	mode
+	)
+    (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
+	   (add-completions-from-lisp-buffer)
+	   (setq mode 'lisp)
+	   )
+	  ((memq major-mode '(c-mode))
+	   (add-completions-from-c-buffer)
+	   (setq mode 'c)
+	   )
+	  (t
+	   (error "Do not know how to parse completions in %s buffers."
+		  major-mode)
+	   ))
+    (cmpl-statistics-block
+      (record-cmpl-parse-file
+	mode (point-max)
+	(- (aref completion-add-count-vector cmpl-source-file-parsing)
+	   start-num)))
+    ))
+
+;;; Find file hook
+(defun cmpl-find-file-hook ()
+  (cond (*completep*
+	 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
+		     (memq 'lisp *modes-for-completion-find-file-hook*)
+		     )
+		(add-completions-from-buffer))
+	       ((and (memq major-mode '(c-mode))
+		     (memq 'c *modes-for-completion-find-file-hook*)
+		     )
+		(add-completions-from-buffer)
+		)))
+	))
+    
+(pushnew 'cmpl-find-file-hook find-file-hooks)
+
+;;;-----------------------------------------------
+;;; Tags Table Completions
+;;;-----------------------------------------------
+
+(defun add-completions-from-tags-table ()
+  ;; Inspired by [e-mail]
+  "Add completions from the current tags-table-buffer."
+  (interactive)
+  (visit-tags-table-buffer)		;this will prompt if no tags-table
+  (save-excursion
+    (goto-char (point-min))
+    (let (string)
+      (condition-case e
+	   (while t
+	     (search-forward "\177")
+	     (backward-char 3)
+	     (and (setq string (symbol-under-point))
+		  (add-completion-to-tail-if-new string))
+	     (forward-char 3)
+	     )
+	 (search-failed)
+	 ))))
+
+
+;;;-----------------------------------------------
+;;; Lisp File completion parsing
+;;;-----------------------------------------------
+;;;   This merely looks for phrases beginning with (def.... or
+;;; (package:def ... and takes the next word.
+;;;
+;;; We tried using forward-lines and explicit searches but the regexp technique
+;;; was faster.  (About 100K characters per second)
+;;;
+(defconst *lisp-def-regexp*
+  "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
+  "A regexp that searches for lisp definition form."
+  )
+
+;;; Tests -
+;;;  (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
+;;;  (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
+;;;  (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
+;;;  (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
+
+(defun add-completions-from-lisp-buffer ()
+  "Parses all the definition names from a Lisp mode buffer and adds them to 
+the completion database."
+  ;;; Benchmarks
+  ;;;  Sun-3/280 - 1500 to 3000 lines of lisp code per second
+  (let (string)
+    (save-excursion
+      (goto-char (point-min))
+      (condition-case e
+	   (while t
+	     (re-search-forward *lisp-def-regexp*)
+	     (and (setq string (symbol-under-point))
+		  (add-completion-to-tail-if-new string))
+	     )
+	 (search-failed)
+	 ))))
+
+
+;;;-----------------------------------------------
+;;; C file completion parsing
+;;;-----------------------------------------------
+;;; C :
+;;;  Looks for #define or [<storage class>] [<type>] <name>{,<name>}
+;;; or structure, array or pointer defs.
+;;; It gets most of the definition names.
+;;;
+;;; As you might suspect by now, we use some symbol table hackery
+;;;
+;;; Symbol separator chars (have whitespace syntax) --> , ; * = (
+;;; Opening char --> [ {
+;;; Closing char --> ] }
+;;; openning and closing must be skipped over
+;;; Whitespace chars (have symbol syntax)
+;;; Everything else has word syntax
+
+(defun make-c-def-completion-syntax-table ()
+  (let ((table (make-vector 256 0))
+	(whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))
+	;; unforunately the ?( causes the parens to appear unbalanced
+	(separator-chars '(?, ?* ?= ?\( ?\;
+			   ))
+	)
+    ;; default syntax is whitespace
+    (dotimes (i 256)
+      (modify-syntax-entry i "w" table))
+    (dolist (char whitespace-chars)
+      (modify-syntax-entry char "_" table))
+    (dolist (char separator-chars)
+      (modify-syntax-entry char " " table))
+    (modify-syntax-entry ?\[ "(]" table)
+    (modify-syntax-entry ?\{ "(}" table)
+    (modify-syntax-entry ?\] ")[" table)
+    (modify-syntax-entry ?\} "){" table)
+    table))
+
+(defconst cmpl-c-def-syntax-table (make-c-def-completion-syntax-table))
+
+;;; Regexps
+(defconst *c-def-regexp*
+    ;; This stops on lines with possible definitions
+    "\n[_a-zA-Z#]"
+  ;; This stops after the symbol to add.
+  ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
+  ;; This stops before the symbol to add.  {Test cases in parens. below}
+  ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
+  ;; this simple version picks up too much extraneous stuff
+  ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
+  "A regexp that searches for a definition form."
+  )
+;
+;(defconst *c-cont-regexp*
+;  "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
+;  "This regexp should be used in a looking-at to parse for lists of variables.")
+;
+;(defconst *c-struct-regexp*
+;  "\\(*\\|\\s \\)*\\b"
+;  "This regexp should be used to test whether a symbol follows a structure definition.")
+
+;(defun test-c-def-regexp (regexp string)
+;  (and (eq 0 (string-match regexp string)) (match-end 0))
+;  )
+
+;;; Tests -
+;;;  (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
+;;;  (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
+;;;  (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
+;;;  (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
+;;;  (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
+;;;  (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
+;;;  (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
+;;;  (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
+;;;  (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
+;;;  (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
+;;;  (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
+
+(defun add-completions-from-c-buffer ()
+  "Parses all the definition names from a C mode buffer and adds them to the 
+completion database."
+  ;; Benchmark --
+  ;;  Sun 3/280-- 1250 lines/sec.
+
+  (let (string next-point char
+	(saved-syntax (syntax-table))
+	)
+    (save-excursion
+      (goto-char (point-min))
+      (catch 'finish-add-completions
+	(unwind-protect
+	     (while t
+	       ;; we loop here only when scan-sexps fails
+	       ;; (i.e. unbalance exps.)
+	       (set-syntax-table cmpl-c-def-syntax-table)
+	       (condition-case e
+		    (while t
+		      (re-search-forward *c-def-regexp*)
+		      (cond
+			((= (preceding-char) ?#)
+			 ;; preprocessor macro, see if it's one we handle
+			 (setq string (buffer-substring (point) (+ (point) 6)))
+			 (cond ((or (string-equal string "define")
+				    (string-equal string "ifdef ")
+				    )
+				;; skip forward over definition symbol
+				;; and add it to database
+				(and (forward-word 2)
+				     (setq string (symbol-before-point))
+				     ;;(push string foo)
+				     (add-completion-to-tail-if-new string)
+				     ))))
+			(t
+			 ;; C definition
+			 (setq next-point (point))
+			 (while (and
+				  next-point
+				  ;; scan to next separator char.
+				  (setq next-point (scan-sexps next-point 1))
+				  )
+			   ;; position the point on the word we want to add
+			   (goto-char next-point)
+			   (while (= (setq char (following-char)) ?*)
+			     ;; handle pointer ref
+			     ;; move to next separator char.
+			     (goto-char
+			       (setq next-point (scan-sexps (point) 1)))
+			     )
+			   (forward-word -1)
+			   ;; add to database
+			   (if (setq string (symbol-under-point))
+			       ;; (push string foo)
+			       (add-completion-to-tail-if-new string)
+			       ;; Local TMC hack (useful for parsing paris.h)
+			       (if (and (looking-at "_AP") ;; "ansi prototype"
+					(progn
+					  (forward-word -1)
+					  (setq string
+						(symbol-under-point))
+					  ))
+				   (add-completion-to-tail-if-new string)
+				   )
+			       )
+			   ;; go to next
+			   (goto-char next-point)
+			   ;; (push (format "%c" (following-char)) foo)
+			   (if (= (char-syntax char) ?\()
+			       ;; if on an opening delimiter, go to end
+			       (while (= (char-syntax char) ?\()
+				 (setq next-point (scan-sexps next-point 1)
+				       char (char-after next-point))
+				 )
+			       (or (= char ?,)
+				   ;; Current char is an end char.
+				   (setq next-point nil)
+				   ))
+			   ))))
+		  (search-failed ;;done
+		    (throw 'finish-add-completions t)
+		    )
+		  (error
+		    ;; Check for failure in scan-sexps
+		    (if (or (string-equal (second e)
+					  "Containing expression ends prematurely")
+			    (string-equal (second e) "Unbalanced parentheses"))
+			;; unbalanced paren., keep going
+			;;(ding)
+			(forward-line 1)
+			(message "Error parsing C buffer for completions.  Please bug report.")
+			(throw 'finish-add-completions t)
+			))
+		  ))
+	  (set-syntax-table saved-syntax)
+	  )))))
+
+
+;;;---------------------------------------------------------------------------
+;;; Init files
+;;;---------------------------------------------------------------------------
+
+(defun kill-emacs-save-completions ()
+  "The version of save-completions-to-file called at kill-emacs
+time."
+  (when (and *save-completions-p* *completep* cmpl-initialized-p)
+    (cond
+      ((not cmpl-completions-accepted-p)
+       (message "Completions database has not changed - not writing."))
+      (t
+       (save-completions-to-file)
+       ))
+    ))
+
+(defconst saved-cmpl-file-header
+    ";;; Completion Initialization file.
+;;; Version = %s
+;;; Format is (<string> . <last-use-time>)
+;;;  <string> is the completion
+;;;  <last-use-time> is the time the completion was last used
+;;;    If it is t, the completion will never be pruned from the file.
+;;;    Otherwise it is in hours since 1900.
+\n")
+
+(defun completion-backup-filename (filename)
+  (concat filename ".BAK"))
+
+(defun save-completions-to-file (&optional filename)
+  "Saves a completion init file.  If file is not specified,
+   then *saved-completions-filename* is used."
+  (interactive)
+  (setq filename (expand-file-name (or filename *saved-completions-filename*)))
+  (when (file-writable-p filename)
+    (if (not cmpl-initialized-p)
+	(initialize-completions));; make sure everything's loaded
+    (message "Saving completions to file %s" filename)
+
+    (let* ((trim-versions-without-asking t)
+	   (kept-old-versions 0)
+	   (kept-new-versions *completion-file-versions-kept*)
+	   last-use-time
+	   (current-time (cmpl-hours-since-1900))
+	   (total-in-db 0)
+	   (total-perm 0)
+	   (total-saved 0)
+	   (backup-filename (completion-backup-filename filename))
+	   )
+    
+      (save-excursion
+	(get-buffer-create " *completion-save-buffer*")
+	(set-buffer  " *completion-save-buffer*")
+	(setq buffer-file-name filename)
+
+	(when (not (verify-visited-file-modtime (current-buffer)))
+	  ;; file has changed on disk.  Bring us up-to-date
+	  (message "Completion file has changed.  Merging. . .")
+	  (load-completions-from-file filename t)
+	  (message "Merging finished.  Saving completions to file %s" filename)
+	  )
+
+	;; prepare the buffer to be modified
+	(clear-visited-file-modtime)
+	(erase-buffer)
+	;; (/ 1 0)
+	(insert (format saved-cmpl-file-header *completion-version*))
+	(dolist (completion (list-all-completions))
+	  (setq total-in-db (1+ total-in-db))
+	  (setq last-use-time (completion-last-use-time completion))
+	  ;; Update num uses and maybe write completion to a file
+	  (cond ((or;; Write to file if
+		  ;; permanent
+		  (and (eq last-use-time t)
+		       (setq total-perm (1+ total-perm)))
+		  ;; or if
+		  (if (plusp (completion-num-uses completion))
+		      ;; it's been used
+		      (setq last-use-time current-time)
+		      ;; or it was saved before and
+		      (and last-use-time
+			   ;; *saved-completion-retention-time* is nil
+			   (or (not *saved-completion-retention-time*)
+			       ;; or time since last use is < ...retention-time*
+			       (< (- current-time last-use-time)
+				  *saved-completion-retention-time*))
+			   )))
+		 ;; write to file
+		 (setq total-saved (1+ total-saved))
+		 (insert (prin1-to-string (cons (completion-string completion)
+						last-use-time)) "\n")
+		 )))
+	
+	;; write the buffer
+	(condition-case e
+	     (let ((file-exists-p (file-exists-p filename)))
+	       (when file-exists-p
+		 ;; If file exists . . .
+		 ;; Save a backup(so GNU doesn't screw us when we're out of disk)
+		 ;; (GNU leaves a 0 length file if it gets a disk full error!)
+	       
+		 ;; If backup doesn't exit, Rename current to backup
+		 ;;  {If backup exists the primary file is probably messed up}
+		 (unless (file-exists-p backup-filename)
+		   (rename-file filename backup-filename))
+		 ;; Copy the backup back to the current name
+		 ;; (so versioning works)
+		 (copy-file backup-filename filename t)
+		 )
+	       ;; Save it
+	       (save-buffer)
+	       (when file-exists-p
+		 ;; If successful, remove backup
+		 (delete-file backup-filename)
+		 ))
+	   (error
+	    (set-buffer-modified-p nil)
+	    (message "Couldn't save completion file %s." filename)
+	    ))
+	;; Reset accepted-p flag
+	(setq cmpl-completions-accepted-p nil) 
+	)
+      (cmpl-statistics-block
+       (record-save-completions total-in-db total-perm total-saved))
+      )))
+
+(defun autosave-completions ()
+  (when (and *save-completions-p* *completep* cmpl-initialized-p
+	     *completion-auto-save-period*
+	     (> cmpl-emacs-idle-time *completion-auto-save-period*)
+	     cmpl-completions-accepted-p)
+    (save-completions-to-file)
+    ))
+
+(pushnew 'autosave-completions cmpl-emacs-idle-time-hooks)
+
+(defun load-completions-from-file (&optional filename no-message-p)
+  "loads a completion init file.  If file is not specified,
+   then *saved-completions-filename* is used"
+  (interactive)
+  (setq filename (expand-file-name (or filename *saved-completions-filename*)))
+  (let* ((backup-filename (completion-backup-filename filename))
+	 (backup-readable-p (file-readable-p backup-filename))
+	 )
+    (when backup-readable-p (setq filename backup-filename))
+    (when (file-readable-p filename)
+      (if (not no-message-p)
+	  (message "Loading completions from %sfile %s . . ."
+		   (if backup-readable-p "backup " "") filename))
+      (save-excursion
+	(get-buffer-create " *completion-save-buffer*")
+	(set-buffer  " *completion-save-buffer*")
+	(setq buffer-file-name filename)
+	;; prepare the buffer to be modified
+	(clear-visited-file-modtime)
+	(erase-buffer)
+  
+	(let ((insert-okay-p nil)
+	      (buffer (current-buffer))
+	      (current-time (cmpl-hours-since-1900))
+	      string num-uses entry last-use-time
+	      cmpl-entry cmpl-last-use-time
+	      (current-completion-source cmpl-source-init-file)
+	      (start-num
+	       (cmpl-statistics-block
+		(aref completion-add-count-vector cmpl-source-file-parsing)))
+	      (total-in-file 0) (total-perm 0)
+	      )
+	  ;; insert the file into a buffer
+	  (condition-case e
+	       (progn (insert-file-contents filename t)
+		      (setq insert-okay-p t))
+
+	     (file-error 
+	      (message "File error trying to load completion file %s."
+		       filename)))
+	  ;; parse it 
+	  (when insert-okay-p
+	    (goto-char (point-min))
+
+	    (condition-case e
+		 (while t
+		   (setq entry (read buffer))
+		   (setq total-in-file (1+ total-in-file))
+		   (cond
+		     ((and (consp entry)
+			   (stringp (setq string (car entry)))
+			   (cond
+			     ((eq (setq last-use-time (cdr entry)) 'T)
+			      ;; handle case sensitivity
+			      (setq total-perm (1+ total-perm))
+			      (setq last-use-time t))
+			     ((eq last-use-time t)
+			      (setq total-perm (1+ total-perm)))
+			     ((integerp last-use-time))
+			     ))
+		      ;; Valid entry
+		      ;; add it in
+		      (setq cmpl-last-use-time
+			    (completion-last-use-time
+			     (setq cmpl-entry
+				   (add-completion-to-tail-if-new string))
+			     ))
+		      (if (or (eq last-use-time t) 
+			      (and (> last-use-time 1000);;backcompatibility
+				   (not (eq cmpl-last-use-time t))
+				   (or (not cmpl-last-use-time)
+				       ;; more recent
+				       (> last-use-time  cmpl-last-use-time))
+				   ))
+			  ;; update last-use-time
+			  (set-completion-last-use-time cmpl-entry last-use-time)
+			  ))
+		     (t
+		      ;; Bad format
+		      (message "Error: invalid saved completion - %s"
+			       (prin1-to-string entry))
+		      ;; try to get back in sync
+		      (search-forward "\n(")
+		      )))
+	       (search-failed
+		(message "End of file while reading completions.")
+		)
+	       (end-of-file
+		(if (= (point) (point-max))
+		    (if (not no-message-p)
+			(message "Loading completions from file %s . . . Done."
+				 filename))
+		    (message "End of file while reading completions.")
+		    ))
+	       ))
+
+	  (cmpl-statistics-block
+	   (record-load-completions
+	    total-in-file total-perm
+	    (- (aref completion-add-count-vector cmpl-source-init-file)
+	       start-num)))
+
+	  )))))
+
+(defun initialize-completions ()
+  "Loads the default completions file and sets up so that exiting emacs will
+automatically save the file."
+  (interactive)
+  (cond ((not cmpl-initialized-p)
+	 (load-completions-from-file)
+	 ))
+  (init-cmpl-emacs-idle-process)
+  (setq cmpl-initialized-p t)
+  )
+
+
+;;;-----------------------------------------------
+;;; Kill EMACS patch
+;;;-----------------------------------------------
+
+(completion-advise kill-emacs :before
+    ;; | All completion code should go in here
+    ;;\ /
+    (kill-emacs-save-completions)
+    ;;/ \
+    ;; | All completion code should go in here
+    (cmpl-statistics-block
+      (record-cmpl-kill-emacs))
+    )
+
+
+;;;-----------------------------------------------
+;;; Kill region patch
+;;;-----------------------------------------------
+
+;;; Patched to remove the most recent completion
+(defvar $$$cmpl-old-kill-region (symbol-function 'kill-region))
+
+(defun kill-region (&optional beg end)
+  "Kill between point and mark.
+The text is deleted but saved in the kill ring.
+The command \\[yank] can retrieve it from there.
+/(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
+
+This is the primitive for programs to kill text (as opposed to deleting it).
+Supply two arguments, character numbers indicating the stretch of text
+ to be killed.
+Any command that calls this function is a \"kill command\".
+If the previous command was also a kill command,
+the text killed this time appends to the text killed last time
+to make one entry in the kill ring.
+Patched to remove the most recent completion."
+  (interactive "*")  
+  (cond ((and (eq last-command 'complete) (eq last-command-char ?\C-w))
+	 (delete-region (point) cmpl-last-insert-location)
+	 (insert cmpl-original-string)
+	 (setq completion-to-accept nil)
+	 (cmpl-statistics-block
+	   (record-complete-failed))
+	 )
+	(t
+	  (if (not beg)
+	      (setq beg (min (point) (mark))
+		    end (max (point) (mark)))
+	    )
+	 (funcall $$$cmpl-old-kill-region beg end)
+	 )))
+
+;;;-----------------------------------------------
+;;; Patches to self-insert-command.
+;;;-----------------------------------------------
+
+;;; Need 2 versions: generic seperator chars. and space (to get auto fill
+;;; to work)
+
+;;; All common separators (eg. space "(" ")" """) characters go through a
+;;; function to add new words to the list of words to complete from:
+;;;  COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
+;;; If the character before this was an alpha-numeric then this adds the 
+;;; symbol befoe point to the completion list (using ADD-COMPLETION).
+
+(defun completion-separator-self-insert-command (arg)
+  (interactive "p")
+  (use-completion-before-separator)
+  (self-insert-command arg)
+  )
+
+(defun completion-separator-self-insert-autofilling (arg)
+  (interactive "p")
+  (use-completion-before-separator)
+  (self-insert-command arg)
+  (and (> (current-column) fill-column)
+       auto-fill-hook
+       (funcall auto-fill-hook))
+  )
+
+;;;-----------------------------------------------
+;;; Wrapping Macro
+;;;-----------------------------------------------
+
+;;; Note that because of the way byte compiling works, none of 
+;;; the functions defined with this macro get byte compiled.
+
+(defmacro def-completion-wrapper (function-name type &optional new-name)
+  "Add a call to update the completion database before the function is
+executed.  TYPE is the type of the wrapper to be added.  Can be :before or
+:under."
+  (completion-advise-1
+   function-name ':before
+   (ecase type
+     (:before '((use-completion-before-point)))
+     (:separator '((use-completion-before-separator)))
+     (:under '((use-completion-under-point)))
+     (:under-or-before
+      '((use-completion-under-or-before-point)))
+     (:minibuffer-separator
+      '((let ((cmpl-syntax-table cmpl-standard-syntax-table))
+	  (use-completion-before-separator))))
+     )
+   new-name
+   ))
+
+;;;(defun foo (x y z) (+ x y z))
+;;;foo
+;;;(macroexpand '(def-completion-wrapper foo :under))
+;;;(progn (defvar $$$cmpl-foo (symbol-function (quote foo))) (defun foo (&rest arglist) (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-foo arglist)))
+;;;(defun bar (x y z) "Documentation" (+ x y z))
+;;;bar
+;;;(macroexpand '(def-completion-wrapper bar :under))
+;;;(progn (defvar $$$cmpl-bar (symbol-function (quote bar))) (defun bar (&rest arglist) "Documentation" (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-bar arglist)))
+;;;(defun quuz (x &optional y z) "Documentation" (interactive "P") (+ x y z))
+;;;quuz
+;;;(macroexpand '(def-completion-wrapper quuz :before))
+;;;(progn (defvar $$$cmpl-quuz (symbol-function (quote quuz))) (defun quuz (&rest arglist) "Documentation" (interactive) (progn (use-completion-before-point)) (cmpl-apply-as-top-level $$$cmpl-quuz arglist)))
+
+
+;;;---------------------------------------------------------------------------
+;;; Patches to standard keymaps insert completions
+;;;---------------------------------------------------------------------------
+
+;;;-----------------------------------------------
+;;; Separators
+;;;-----------------------------------------------
+;;; We've used the completion syntax table given  as a guide.
+;;;
+;;; Global separator chars.
+;;;  We left out <tab> because there are too many special cases for it.  Also,
+;;; in normal coding it's rarely typed after a word.
+(global-set-key " " 'completion-separator-self-insert-autofilling)
+(global-set-key "!" 'completion-separator-self-insert-command)
+(global-set-key "%" 'completion-separator-self-insert-command)
+(global-set-key "^" 'completion-separator-self-insert-command)
+(global-set-key "&" 'completion-separator-self-insert-command)
+(global-set-key "(" 'completion-separator-self-insert-command)
+(global-set-key ")" 'completion-separator-self-insert-command)
+(global-set-key "=" 'completion-separator-self-insert-command)
+(global-set-key "`" 'completion-separator-self-insert-command)
+(global-set-key "|" 'completion-separator-self-insert-command)
+(global-set-key "{" 'completion-separator-self-insert-command)
+(global-set-key "}" 'completion-separator-self-insert-command)
+(global-set-key "[" 'completion-separator-self-insert-command)
+(global-set-key "]" 'completion-separator-self-insert-command)
+(global-set-key ";" 'completion-separator-self-insert-command)
+(global-set-key "\"" 'completion-separator-self-insert-command)
+(global-set-key "'" 'completion-separator-self-insert-command)
+(global-set-key "#" 'completion-separator-self-insert-command)
+(global-set-key "," 'completion-separator-self-insert-command)
+(global-set-key "?" 'completion-separator-self-insert-command)
+
+;;; We include period and colon even though they are symbol chars because :
+;;;  - in text we want to pick up the last word in a sentence.
+;;;  - in C pointer refs. we want to pick up the first symbol
+;;;  - it won't make a difference for lisp mode (package names are short)
+(global-set-key "." 'completion-separator-self-insert-command)
+(global-set-key ":" 'completion-separator-self-insert-command)
+
+;;; Lisp Mode diffs
+(define-key lisp-mode-map "!" 'self-insert-command)
+(define-key lisp-mode-map "&" 'self-insert-command)
+(define-key lisp-mode-map "%" 'self-insert-command)
+(define-key lisp-mode-map "?" 'self-insert-command)
+(define-key lisp-mode-map "=" 'self-insert-command)
+(define-key lisp-mode-map "^" 'self-insert-command)
+
+;;; C mode diffs.
+(def-completion-wrapper electric-c-semi :separator)
+(define-key c-mode-map "+" 'completion-separator-self-insert-command)
+(define-key c-mode-map "*" 'completion-separator-self-insert-command)
+(define-key c-mode-map "/" 'completion-separator-self-insert-command)
+
+;;; FORTRAN mode diffs. (these are defined when fortran is called)
+(defun completion-setup-fortran-mode ()
+  (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)
+  (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)
+  (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)
+  (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)
+  )
+
+;;;-----------------------------------------------
+;;; End of line chars.
+;;;-----------------------------------------------
+(def-completion-wrapper newline :separator)
+(def-completion-wrapper newline-and-indent :separator)
+(if (function-defined-and-loaded 'shell-send-input)
+    (def-completion-wrapper shell-send-input :separator))
+(def-completion-wrapper exit-minibuffer :minibuffer-separator)
+(def-completion-wrapper eval-print-last-sexp :separator)
+(def-completion-wrapper eval-last-sexp :separator)
+;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
+
+;;;-----------------------------------------------
+;;; Cursor movement
+;;;-----------------------------------------------
+
+(def-completion-wrapper next-line :under-or-before)
+(def-completion-wrapper previous-line :under-or-before)
+(def-completion-wrapper beginning-of-buffer :under-or-before)
+(def-completion-wrapper end-of-buffer :under-or-before)
+
+;; we patch these explicitly so they byte compile and so we don't have to
+;; patch the faster underlying function.
+
+(defun cmpl-beginning-of-line (&optional n)
+  "Move point to beginning of current line.\n\
+With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (use-completion-under-or-before-point)
+  (beginning-of-line n)
+  )
+
+(defun cmpl-end-of-line (&optional n)
+  "Move point to end of current line.\n\
+With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (use-completion-under-or-before-point)
+  (end-of-line n)
+  )
+
+(defun cmpl-forward-char (n)
+  "Move point right ARG characters (left if ARG negative).\n\
+On reaching end of buffer, stop and signal error."
+  (interactive "p")
+  (use-completion-under-or-before-point)
+  (forward-char n)
+  )
+(defun cmpl-backward-char (n)
+  "Move point left ARG characters (right if ARG negative).\n\
+On attempt to pass beginning or end of buffer, stop and signal error."
+  (interactive "p")
+  (use-completion-under-point)
+  (if (eq last-command 'complete)
+      ;; probably a failed completion if you have to back up
+      (cmpl-statistics-block (record-complete-failed)))
+  (backward-char n)
+  )
+
+(defun cmpl-forward-word (n)
+  "Move point forward ARG words (backward if ARG is negative).\n\
+Normally returns t.\n\
+If an edge of the buffer is reached, point is left there\n\
+and nil is returned."
+  (interactive "p")
+  (use-completion-under-or-before-point)
+  (forward-word n)
+  )
+(defun cmpl-backward-word (n)
+  "Move backward until encountering the end of a word.
+With argument, do this that many times.
+In programs, it is faster to call forward-word with negative arg."
+  (interactive "p")
+  (use-completion-under-point)
+  (if (eq last-command 'complete)
+      ;; probably a failed completion if you have to back up
+      (cmpl-statistics-block (record-complete-failed)))
+  (forward-word (- n))
+  )
+
+(defun cmpl-forward-sexp (n)
+  "Move forward across one balanced expression.
+With argument, do this that many times."
+  (interactive "p")
+  (use-completion-under-or-before-point)
+  (forward-sexp n)
+  )
+(defun cmpl-backward-sexp (n)
+  "Move backward across one balanced expression.
+With argument, do this that many times."
+  (interactive "p")
+  (use-completion-under-point)
+  (if (eq last-command 'complete)
+      ;; probably a failed completion if you have to back up
+      (cmpl-statistics-block (record-complete-failed)))
+  (backward-sexp n)
+  )
+
+(defun cmpl-delete-backward-char (n killflag)
+  "Delete the previous ARG characters (following, with negative ARG).\n\
+Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
+Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
+ARG was explicitly specified."
+  (interactive "p\nP")
+  (if (eq last-command 'complete)
+      ;; probably a failed completion if you have to back up
+      (cmpl-statistics-block (record-complete-failed)))
+  (delete-backward-char n killflag)
+  )
+
+(defvar $$$cmpl-old-backward-delete-char-untabify
+  (symbol-function 'backward-delete-char-untabify))
+
+(defun backward-delete-char-untabify (arg &optional killp)
+  "Delete characters backward, changing tabs into spaces.
+Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+Interactively, ARG is the prefix arg (default 1)
+and KILLP is t if prefix arg is was specified."
+  (interactive "*p\nP")
+  (if (eq last-command 'complete)
+      ;; probably a failed completion if you have to back up
+      (cmpl-statistics-block (record-complete-failed)))
+  (funcall $$$cmpl-old-backward-delete-char-untabify arg killp)
+  )
+
+
+(global-set-key "\C-?" 'cmpl-delete-backward-char)
+(global-set-key "\M-\C-F" 'cmpl-forward-sexp)
+(global-set-key "\M-\C-B" 'cmpl-backward-sexp)
+(global-set-key "\M-F" 'cmpl-forward-word)
+(global-set-key "\M-B" 'cmpl-backward-word)
+(global-set-key "\C-F" 'cmpl-forward-char)
+(global-set-key "\C-B" 'cmpl-backward-char)
+(global-set-key "\C-A" 'cmpl-beginning-of-line)
+(global-set-key "\C-E" 'cmpl-end-of-line)
+
+;;;-----------------------------------------------
+;;; Misc.
+;;;-----------------------------------------------
+
+(def-completion-wrapper electric-buffer-list :under-or-before)
+(def-completion-wrapper list-buffers :under-or-before)
+(def-completion-wrapper scroll-up :under-or-before)
+(def-completion-wrapper scroll-down :under-or-before)
+(def-completion-wrapper execute-extended-command
+    :under-or-before)
+(def-completion-wrapper other-window :under-or-before)
+
+;;;-----------------------------------------------
+;;; Local Thinking Machines stuff
+;;;-----------------------------------------------
+
+(if (fboundp 'up-ten-lines)
+    (def-completion-wrapper up-ten-lines :under-or-before))
+(if (fboundp 'down-ten-lines)
+    (def-completion-wrapper down-ten-lines :under-or-before))
+(if (fboundp 'tmc-scroll-up)
+    (def-completion-wrapper tmc-scroll-up :under-or-before))
+(if (fboundp 'tmc-scroll-down)
+    (def-completion-wrapper tmc-scroll-down :under-or-before))
+(if (fboundp 'execute-extended-command-and-check-for-bindings)
+    (def-completion-wrapper execute-extended-command-and-check-for-bindings
+	:under-or-before))
+
+;;; Tests --
+;;; foobarbiz
+;;; foobar 
+;;; fooquux 
+;;; fooper
+
+(cmpl-statistics-block
+  (record-completion-file-loaded))