comparison lisp/completion.el @ 29079:3313f117f0ed

Doc fixes. Add to debug-ignored-errors. Don't quote keywords. (cmpl-string-case-type): Use character classes.

29078:2e20146198ce

  :group 'convenience)


(defcustom enable-completion t
  "*Non-nil means enable recording and saving of completions.
If nil, no new words added to the database or saved to the init file."
  :type 'boolean
  :group 'completion)

(defcustom save-completions-flag t
  "*Non-nil means save most-used completions when exiting Emacs.

;;-----------------------------------------------
;; 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

    (while (< i 10)
      (modify-syntax-entry (+ ?0 i) "_" table)
      (setq i (1+ i)))
    ;; 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 (cmpl-make-standard-completion-syntax-table))

(defun cmpl-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 cmpl-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 cmpl-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       (cmpl-make-lisp-completion-syntax-table))

	   ;; 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)
		  ))
	   ;; Return completion if the length is reasonable.
	   (if (and (<= (cmpl-read-time-eval completion-min-length)
			(- cmpl-symbol-end cmpl-symbol-start))
		    (<= (- cmpl-symbol-end cmpl-symbol-start)
			(cmpl-read-time-eval completion-max-length)))

	(set-syntax-table cmpl-syntax-table)
	;; Cursor is on following-char and after preceding-char
	(cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
	       ;; Number of chars to ignore at end.
	       (setq cmpl-symbol-end (point)
		     cmpl-symbol-start (scan-sexps 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)
		      ))
	       ;; Return value if long enough.
	       (if (>= cmpl-symbol-end
		       (+ cmpl-symbol-start
			  (cmpl-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 cmpl-saved-point -1))
	       ;; take off chars. from end

	       (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)
	       ;; Return completion if the length is reasonable
	       (if (and (<= (cmpl-read-time-eval completion-min-length)
			    (- cmpl-symbol-end cmpl-symbol-start))

      (progn
	(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 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)
		      ))
	       ;; Return completion if the length is reasonable.
	       (if (and (<= (cmpl-read-time-eval
			     completion-prefix-min-length)
			    (- cmpl-symbol-end cmpl-symbol-start))
			(<= (- cmpl-symbol-end cmpl-symbol-start)

  "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."
  ;; 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)))
	)
  (if cdabbrev-current-window
      (save-excursion
	(set-cdabbrev-buffer)
	(setq cdabbrev-current-point (point)
	      cdabbrev-start-point cdabbrev-current-point
	      cdabbrev-stop-point
	      (if completion-search-distance
		  (max (point-min)
		       (- cdabbrev-start-point completion-search-distance))
		  (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 already.
This is sensitive to `case-fold-search'."

				  (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

				 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

		       (goto-char (setq cdabbrev-current-point
					(if completion-search-distance
					    (min (point-max) (+ cdabbrev-start-point completion-search-distance))
					    (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))))))

;;-----------------------------------------------
;; 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))
  )

(defvar completions-list-return-value)

(defun list-all-completions ()
  "Returns a list of all the known completion entries."
  (let ((completions-list-return-value nil))
    (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
    completions-list-return-value))

(defun list-all-completions-1 (prefix-symbol)

(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)))

(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

	      (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)

    (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 STRING is not in the database add it to appropriate prefix list.
STRING is added to the end of the appropriate prefix list with

	    (entry (make-completion string))
	    ;; setup the prefix
	    (prefix-entry (find-cmpl-prefix-entry
			    (substring cmpl-db-downcase-string 0
				       (cmpl-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 (completion-string)
  "If COMPLETION-STRING is not in the database, add it to prefix list.
We add COMPLETION-STRING to the head of the appropriate prefix list,
or it to the head of the list.

      (let* ((prefix-entry (find-cmpl-prefix-entry
			     (substring cmpl-db-downcase-string 0
					(cmpl-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 completion-string)
	;; move to head (if necessary)
	(cond (splice-ptr
	       ;; These should all execute atomically but it is not fatal if

	       (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 completion-string))
	  ;; setup the prefix
	  (prefix-entry (find-cmpl-prefix-entry
			  (substring cmpl-db-downcase-string 0
				     (cmpl-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 (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 completion-string))
      ;; found
      (let* ((prefix-entry (find-cmpl-prefix-entry 
			     (substring cmpl-db-downcase-string 0
					(cmpl-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'" completion-string)
      ))

;; Tests --
;;  - Add and Find -
;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
;; (find-exact-completion "banana")      --> ("banana" 0 nil 0)

(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)

					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)
  "Add STRING if it isn't already listed, and mark it permanent."
  (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 ()
  "Add the completion symbol underneath the point into the completion buffer."
  (let ((string (and enable-completion (symbol-under-point)))
	(current-completion-source cmpl-source-cursor-moves))

`completion-on-separator-character' is non-nil."
  (let ((string (and enable-completion (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))
	   (if (and completion-on-separator-character
		      (zerop (completion-num-uses entry)))
	       (progn
		 (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)

	(cmpl-prefix-entry-head
	  (find-cmpl-prefix-entry
	   (downcase (substring string 0 completion-prefix-min-length))))
	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)
  "Return the next completion entry.
If INDEX is out of sequence, reset and start from the top.
If there are no more entries, try cdabbrev and returns only a string."

     ;; reverse the possibilities list
     (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
     ;; do a "normal" search
     (while (and (completion-search-peek nil)
		 (< (setq index (1+ index)) 0))
       (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

	   (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 (< (setq index (1- index)) 0)))
       (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' results in the same 

	  ;; 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 -

;;-----------------------------------------------
;; COMPLETE
;;-----------------------------------------------

(defun completion-mode ()
  "Toggles whether or not to add new words to the completion database."
  (interactive)
  (setq enable-completion (not enable-completion))
  (message "Completion mode is now %s." (if enable-completion "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)

  ;;; 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, point must be after a symbol at least %d character long"

	 (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 (>= baud-rate completion-prompt-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

	   ;; 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

			   completion-cdabbrev-prompt-flag)))
	      (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 (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)
	   ))))

;;---------------------------------------------------------------------------
;; Parsing definitions from files into the database
;;---------------------------------------------------------------------------

;; Top Level functions ::
;;-----------------------------------------------

;; User interface
(defun add-completions-from-file (file)
  "Parse possible completions from a file and add them to data base."
  (interactive "fFile: ")
  (setq file (expand-file-name file))
  (let* ((buffer (get-file-buffer file))
	 (buffer-already-there-p buffer)
	 )
    (if (not buffer-already-there-p)
	(let ((completions-merging-modes nil))
	  (setq buffer (find-file-noselect file))))
    (unwind-protect
	 (save-excursion
	   (set-buffer buffer)
	   (add-completions-from-buffer)
	   )
      (if (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 "Cannot 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 (enable-completion
	 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
		     (memq 'lisp completions-merging-modes)
		     )
		(add-completions-from-buffer))
	       ((and (memq major-mode '(c-mode))
		     (memq 'c completions-merging-modes)
		     )
		(add-completions-from-buffer)
		)))
	))

;;-----------------------------------------------
;; Tags Table Completions
;;-----------------------------------------------

	   (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
;;-----------------------------------------------

;; 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

      (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
;;-----------------------------------------------

(defun cmpl-make-c-def-completion-syntax-table ()
  (let ((table (make-syntax-table))
	(whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))
	;; unfortunately the ?( causes the parens to appear unbalanced
	(separator-chars '(?, ?* ?= ?\( ?\;
			   ))
	i)
    ;; default syntax is whitespace
    (setq i 0)
    (while (< i 256)
      (modify-syntax-entry i "w" table)

  ;;"\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.")
;

(defun add-completions-from-c-buffer ()
  ;; 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

		      (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 (nth 1 e)
					  "Containing expression ends prematurely")
			    (string-equal (nth 1 e) "Unbalanced parentheses"))
			;; unbalanced paren., keep going
			;;(ding)
			(forward-line 1)
			(message "Error parsing C buffer for completions--please send bug report")
			(throw 'finish-add-completions t)
			))
		  ))
	  (set-syntax-table saved-syntax)
	  )))))


;;---------------------------------------------------------------------------
;; Init files
;;---------------------------------------------------------------------------

	       last-use-time
	       (current-time (cmpl-hours-since-origin))
	       (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)

			(and last-use-time
			     ;; save-completions-retention-time is nil
			     (or (not save-completions-retention-time)
				 ;; or time since last use is < ...retention-time*
				 (< (- current-time last-use-time)
				    save-completions-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)))
		  (if file-exists-p

		  (if 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 auto-save-completions ()
;;  (if (and save-completions-flag enable-completion cmpl-initialized-p
;;	      *completion-auto-save-period*
;;	      (> cmpl-emacs-idle-time *completion-auto-save-period*)

;;    (save-completions-to-file)))

;;(add-hook 'cmpl-emacs-idle-time-hooks 'auto-save-completions)

(defun load-completions-from-file (&optional filename no-message-p)
  "Loads a completion init file FILENAME.
If file is not specified, then use `save-completions-file-name'."
  (interactive)
  (setq filename (expand-file-name (or filename save-completions-file-name)))
  (let* ((backup-filename (completion-backup-filename filename))
	 (backup-readable-p (file-readable-p backup-filename))
	 )
    (if backup-readable-p (setq filename backup-filename))
    (if (file-readable-p filename)
	(progn
	  (if (not no-message-p)
	      (message "Loading completions from %sfile %s . . ."

		  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))

				   ;; 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 ()
  "Load the default completions file.
Also sets up so that exiting emacs will automatically save the file."
  (interactive)
  (cond ((not cmpl-initialized-p)
	 (load-completions-from-file)
	 ))
  (setq cmpl-initialized-p t)
  )

;;-----------------------------------------------
;; Kill region patch
;;-----------------------------------------------

;; symbol before 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 auto-fill-function
       (funcall auto-fill-function))
  )

;;-----------------------------------------------
;; Wrapping Macro
;;-----------------------------------------------

;; 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 function execution.
TYPE is the type of the wrapper to be added.  Can be :before or :under."
  (cond ((eq type ':separator)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-before-separator))
	((eq type ':before)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-before-point))
	((eq type ':backward-under)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-backward-under))
	((eq type ':backward)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-backward))
	((eq type ':under)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-under-point))
	((eq type ':under-or-before)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-under-or-before-point))
	((eq type ':minibuffer-separator)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-minibuffer-separator))))

(defun use-completion-minibuffer-separator ()
  (let ((cmpl-syntax-table cmpl-standard-syntax-table))

;; 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)
  )

;;; Enable completion mode.
  
;;;###autoload
(defun dynamic-completion-mode ()

  (cmpl-statistics-block
   (record-completion-file-loaded))

  (initialize-completions))

(provide 'completion)

;;; completion.el ends here

29079:3313f117f0ed

  :group 'convenience)


(defcustom enable-completion t
  "*Non-nil means enable recording and saving of completions.
If nil, no new words are added to the database or saved to the init file."
  :type 'boolean
  :group 'completion)

(defcustom save-completions-flag t
  "*Non-nil means save most-used completions when exiting Emacs.

;;-----------------------------------------------
;; String case coercion
;;-----------------------------------------------

(defun cmpl-string-case-type (string)
  "Return :capitalized, :up, :down, :mixed, or :neither for case of STRING."
  (let ((case-fold-search nil))
    (cond ((string-match "[[:lower:]]" string)
	   (cond ((string-match "[[:upper:]]" string)
		  (cond ((and (> (length string) 1)
			      (null (string-match "[[:upper:]]" string 1)))
			 :capitalized)
			(t
			 :mixed)))
		 (t :down)))
	  (t
	   (cond ((string-match "[[:upper:]]" 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

    (while (< i 10)
      (modify-syntax-entry (+ ?0 i) "_" table)
      (setq i (1+ i)))
    ;; 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 (cmpl-make-standard-completion-syntax-table))

(defun cmpl-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 cmpl-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 cmpl-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       (cmpl-make-lisp-completion-syntax-table))

	   ;; 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)))
	   ;; Return completion if the length is reasonable.
	   (if (and (<= (cmpl-read-time-eval completion-min-length)
			(- cmpl-symbol-end cmpl-symbol-start))
		    (<= (- cmpl-symbol-end cmpl-symbol-start)
			(cmpl-read-time-eval completion-max-length)))

	(set-syntax-table cmpl-syntax-table)
	;; Cursor is on following-char and after preceding-char
	(cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
	       ;; Number of chars to ignore at end.
	       (setq cmpl-symbol-end (point)
		     cmpl-symbol-start (scan-sexps 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)))
	       ;; Return value if long enough.
	       (if (>= cmpl-symbol-end
		       (+ cmpl-symbol-start
			  (cmpl-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 cmpl-saved-point -1))
	       ;; take off chars. from end

	       (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)
	       ;; Return completion if the length is reasonable
	       (if (and (<= (cmpl-read-time-eval completion-min-length)
			    (- cmpl-symbol-end cmpl-symbol-start))

      (progn
	(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 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)))
	       ;; Return completion if the length is reasonable.
	       (if (and (<= (cmpl-read-time-eval
			     completion-prefix-min-length)
			    (- cmpl-symbol-end cmpl-symbol-start))
			(<= (- cmpl-symbol-end cmpl-symbol-start)

  "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."
  ;; 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))))
  (if cdabbrev-current-window
      (save-excursion
	(set-cdabbrev-buffer)
	(setq cdabbrev-current-point (point)
	      cdabbrev-start-point cdabbrev-current-point
	      cdabbrev-stop-point
	      (if completion-search-distance
		  (max (point-min)
		       (- cdabbrev-start-point completion-search-distance))
		  (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 already.
This is sensitive to `case-fold-search'."

				  (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

				 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

		       (goto-char (setq cdabbrev-current-point
					(if completion-search-distance
					    (min (point-max) (+ cdabbrev-start-point completion-search-distance))
					    (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))))))

;;-----------------------------------------------
;; Completion Database - Utilities
;;-----------------------------------------------

(defun clear-all-completions ()
  "Initialize 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)))

(defvar completions-list-return-value)

(defun list-all-completions ()
  "Return a list of all the known completion entries."
  (let ((completions-list-return-value nil))
    (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
    completions-list-return-value))

(defun list-all-completions-1 (prefix-symbol)

(defvar cmpl-db-debug-p nil
  "Set to T if you want to debug the database.")

;; READS
(defun find-exact-completion (string)
  "Return 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)
  "Return 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)))

(defvar inside-locate-completion-entry nil)
;; used to trap lossage in silent error correction

(defun locate-completion-entry (completion-entry prefix-entry)
  "Locate 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

	      (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)

    (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 STRING is not in the database add it to appropriate prefix list.
STRING is added to the end of the appropriate prefix list with

	    (entry (make-completion string))
	    ;; setup the prefix
	    (prefix-entry (find-cmpl-prefix-entry
			    (substring cmpl-db-downcase-string 0
				       (cmpl-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 (completion-string)
  "If COMPLETION-STRING is not in the database, add it to prefix list.
We add COMPLETION-STRING to the head of the appropriate prefix list,
or it to the head of the list.

      (let* ((prefix-entry (find-cmpl-prefix-entry
			     (substring cmpl-db-downcase-string 0
					(cmpl-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 completion-string)
	;; move to head (if necessary)
	(cond (splice-ptr
	       ;; These should all execute atomically but it is not fatal if

	       (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 completion-string))
	  ;; setup the prefix
	  (prefix-entry (find-cmpl-prefix-entry
			  (substring cmpl-db-downcase-string 0
				     (cmpl-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 (completion-string)
  "Delete 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 completion-string))
      ;; found
      (let* ((prefix-entry (find-cmpl-prefix-entry 
			     (substring cmpl-db-downcase-string 0
					(cmpl-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'" completion-string)))

;; Tests --
;;  - Add and Find -
;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
;; (find-exact-completion "banana")      --> ("banana" 0 nil 0)

(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)

					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)
  "Add STRING if it isn't already listed, and mark it permanent."
  (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 ()
  "Add the completion symbol underneath the point into the completion buffer."
  (let ((string (and enable-completion (symbol-under-point)))
	(current-completion-source cmpl-source-cursor-moves))

`completion-on-separator-character' is non-nil."
  (let ((string (and enable-completion (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))
	   (if (and completion-on-separator-character
		      (zerop (completion-num-uses entry)))
	       (progn
		 (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)

	(cmpl-prefix-entry-head
	  (find-cmpl-prefix-entry
	   (downcase (substring string 0 completion-prefix-min-length))))
	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)
  "Return the next completion entry.
If INDEX is out of sequence, reset and start from the top.
If there are no more entries, try cdabbrev and returns only a string."

     ;; reverse the possibilities list
     (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
     ;; do a "normal" search
     (while (and (completion-search-peek nil)
		 (< (setq index (1+ index)) 0))
       (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

	   (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 (< (setq index (1- index)) 0)))
       (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' results in the same 

	  ;; 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 -

;;-----------------------------------------------
;; COMPLETE
;;-----------------------------------------------

(defun completion-mode ()
  "Toggle whether or not to add new words to the completion database."
  (interactive)
  (setq enable-completion (not enable-completion))
  (message "Completion mode is now %s." (if enable-completion "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)

  ;;; 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, point must be after a symbol at least %d character long"

	 (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 (>= baud-rate completion-prompt-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

	   ;; 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

			   completion-cdabbrev-prompt-flag)))
	      (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 (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)))))

;;---------------------------------------------------------------------------
;; Parsing definitions from files into the database
;;---------------------------------------------------------------------------

;; Top Level functions ::
;;-----------------------------------------------

;; User interface
(defun add-completions-from-file (file)
  "Parse possible completions from a FILE and add them to data base."
  (interactive "fFile: ")
  (setq file (expand-file-name file))
  (let* ((buffer (get-file-buffer file))
	 (buffer-already-there-p buffer))
    (if (not buffer-already-there-p)
	(let ((completions-merging-modes nil))
	  (setq buffer (find-file-noselect file))))
    (unwind-protect
	 (save-excursion
	   (set-buffer buffer)
	   (add-completions-from-buffer))
      (if (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 "Cannot 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 (enable-completion
	 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
		     (memq 'lisp completions-merging-modes))
		(add-completions-from-buffer))
	       ((and (memq major-mode '(c-mode))
		     (memq 'c completions-merging-modes))
		(add-completions-from-buffer))))))

;;-----------------------------------------------
;; Tags Table Completions
;;-----------------------------------------------

	   (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
;;-----------------------------------------------

;; 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

      (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
;;-----------------------------------------------

(defun cmpl-make-c-def-completion-syntax-table ()
  (let ((table (make-syntax-table))
	(whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))
	;; unfortunately the ?( causes the parens to appear unbalanced
	(separator-chars '(?, ?* ?= ?\( ?\;))
	i)
    ;; default syntax is whitespace
    (setq i 0)
    (while (< i 256)
      (modify-syntax-entry i "w" table)

  ;;"\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.")
;

(defun add-completions-from-c-buffer ()
  ;; 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

		      (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 (nth 1 e)
					  "Containing expression ends prematurely")
			    (string-equal (nth 1 e) "Unbalanced parentheses"))
			;; unbalanced paren., keep going
			;;(ding)
			(forward-line 1)
			(message "Error parsing C buffer for completions--please send bug report")
			(throw 'finish-add-completions t)))))
	  (set-syntax-table saved-syntax))))))


;;---------------------------------------------------------------------------
;; Init files
;;---------------------------------------------------------------------------

	       last-use-time
	       (current-time (cmpl-hours-since-origin))
	       (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)

			(and last-use-time
			     ;; save-completions-retention-time is nil
			     (or (not save-completions-retention-time)
				 ;; or time since last use is < ...retention-time*
				 (< (- current-time last-use-time)
				    save-completions-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)))
		  (if file-exists-p

		  (if 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 auto-save-completions ()
;;  (if (and save-completions-flag enable-completion cmpl-initialized-p
;;	      *completion-auto-save-period*
;;	      (> cmpl-emacs-idle-time *completion-auto-save-period*)

;;    (save-completions-to-file)))

;;(add-hook 'cmpl-emacs-idle-time-hooks 'auto-save-completions)

(defun load-completions-from-file (&optional filename no-message-p)
  "Load a completion init file FILENAME.
If file is not specified, then use `save-completions-file-name'."
  (interactive)
  (setq filename (expand-file-name (or filename save-completions-file-name)))
  (let* ((backup-filename (completion-backup-filename filename))
	 (backup-readable-p (file-readable-p backup-filename)))
    (if backup-readable-p (setq filename backup-filename))
    (if (file-readable-p filename)
	(progn
	  (if (not no-message-p)
	      (message "Loading completions from %sfile %s . . ."

		  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))

				   ;; 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 ()
  "Load the default completions file.
Also sets up so that exiting emacs will automatically save the file."
  (interactive)
  (cond ((not cmpl-initialized-p)
	 (load-completions-from-file)))
  (setq cmpl-initialized-p t))

;;-----------------------------------------------
;; Kill region patch
;;-----------------------------------------------

;; symbol before 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 auto-fill-function
       (funcall auto-fill-function)))

;;-----------------------------------------------
;; Wrapping Macro
;;-----------------------------------------------

;; 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 function execution.
TYPE is the type of the wrapper to be added.  Can be :before or :under."
  (cond ((eq type :separator)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-before-separator))
	((eq type :before)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-before-point))
	((eq type :backward-under)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-backward-under))
	((eq type :backward)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-backward))
	((eq type :under)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-under-point))
	((eq type :under-or-before)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-under-or-before-point))
	((eq type :minibuffer-separator)
	 (list 'put (list 'quote function-name) ''completion-function
	       ''use-completion-minibuffer-separator))))

(defun use-completion-minibuffer-separator ()
  (let ((cmpl-syntax-table cmpl-standard-syntax-table))

;; 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))

;;; Enable completion mode.
  
;;;###autoload
(defun dynamic-completion-mode ()

  (cmpl-statistics-block
   (record-completion-file-loaded))

  (initialize-completions))

(mapc (lambda (x)
	(add-to-list 'debug-ignored-errors x))
      '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
	"^The string \".*\" is too short to be saved as a completion\\.$"))

(provide 'completion)

;;; completion.el ends here