;;; completion.el --- dynamic word-completion code
+;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
-;; Maintainer: bug-completion@think.com
+;; Maintainer: FSF
;; Keywords: abbrev
+;; Author: Jim Salem <salem@think.com> and Brewster Kahle <brewster@think.com>
+;; of Thinking Machines Inc.
-;;; Commentary:
+;; This file is part of GNU Emacs.
-;;; This file is very badly designed in that it redefines
-;;; standard functions of Emacs. This is bad design, because
-;;; this file cannot be updated to correspond to the latest
-;;; versions of those functions. Therefore, you must expect
-;;; it to produce unpredictable and undesirable results.
-;;; This file needs to be redesigned to work in a modular fashion.
-;;; -- rms.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
-;;; This is a Completion system for GNU Emacs
-;;;
-;;; E-Mail:
-;;; Internet: completion@think.com, bug-completion@think.com
-;;; 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.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
;;;
;;; What to put in .emacs
;;;-----------------------
-;;; (load "completion") ;; If it's not part of the standard band.
+;;; (load "completion")
;;; (initialize-completions)
-;;;
-;;; For best results, be sure to byte-compile the file first.
-;;;
-\f
-;;; Authors
-;;;---------
-;;; Jim Salem {salem@think.com}
-;;; Brewster Kahle {brewster@think.com}
-;;; Thinking Machines Corporation
-;;; 245 First St., Cambridge MA 02142 (617) 876-1111
-;;;
-;;; Mailing Lists
-;;;---------------
-;;;
-;;; Bugs to bug-completion@think.com
-;;; Comments to completion@think.com
-;;; Requests to be added completion-request@think.com
-;;;
-;;; Availability
-;;;--------------
-;;; Anonymous FTP from think.com
-;;;
\f
;;;---------------------------------------------------------------------------
;;; Documentation [Slightly out of date]
;;;---------------------
;;;
;;; A "word" is any string containing characters with either word or symbol
-;;; syntax. [E.G. Any alphanumeric string with hypens, underscores, etc.]
+;;; syntax. [E.G. Any alphanumeric string with hyphens, 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).
+;;; compiled version (because it is noticeably faster).
;;;
;;; M-X completion-mode toggles whether or not new words are added to the
;;; database by changing the value of enable-completion.
;;;
;;;
\f
-;;;-----------------------------------------------
-;;; 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
;;;---------------------------------------------------------------------------
;;; superior to that of the LISPM version.
;;;
;;;-----------------------------------------------
-;;; Acknowlegements
+;;; Acknowledgements
;;;-----------------------------------------------
;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
(mapcar 'eval body)
(cons 'progn body))
+(eval-when-compile
+ (defvar completion-gensym-counter 0)
+ (defun completion-gensym (&optional arg)
+ "Generate a new uninterned symbol.
+The name is made by appending a number to PREFIX, default \"G\"."
+ (let ((prefix (if (stringp arg) arg "G"))
+ (num (if (integerp arg) arg
+ (prog1 completion-gensym-counter
+ (setq completion-gensym-counter (1+ completion-gensym-counter))))))
+ (make-symbol (format "%s%d" prefix num)))))
+
+(defmacro completion-dolist (spec &rest body)
+ "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list.
+Evaluate BODY with VAR bound to each `car' from LIST, in turn.
+Then evaluate RESULT to get return value, default nil."
+ (let ((temp (completion-gensym "--dolist-temp--")))
+ (append (list 'let (list (list temp (nth 1 spec)) (car spec))
+ (append (list 'while temp
+ (list 'setq (car spec) (list 'car temp)))
+ body (list (list 'setq temp
+ (list 'cdr temp)))))
+ (if (cdr (cdr spec))
+ (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
+ '(nil)))))
+
(defun completion-eval-when ()
(eval-when-compile-load-eval
;; These vars. are defined at both compile and load time.
(setq completion-prefix-min-length 3)))
(completion-eval-when)
-
-;; Need this file around too
-(require 'cl)
;;;---------------------------------------------------------------------------
;;; Internal Variables
"Set to t as soon as the first completion has been accepted.
Used to decide whether to save completions.")
+(defvar cmpl-preceding-syntax)
+
+(defvar completion-string)
\f
;;;---------------------------------------------------------------------------
;;; Low level tools
"True iff the current window is the minibuffer."
(window-minibuffer-p (selected-window)))
+;; This used to be `(eval form)'. Eval FORM at run time now.
(defmacro cmpl-read-time-eval (form)
- ;; Like the #. reader macro
- (eval form))
-
+ form)
;;;-----------------------------------------------
;;; String case coercion
\f
(defun cmpl-hours-since-origin ()
(let ((time (current-time)))
- (+ (* (/ (car time) 3600.0) (lsh 1 16))
- (/ (nth 2 time) 3600.0))))
+ (truncate
+ (+ (* (/ (car time) 3600.0) (lsh 1 16))
+ (/ (nth 2 time) 3600.0)))))
\f
;;;---------------------------------------------------------------------------
;;; "Symbol" parsing functions
;;;
;;; C diffs ->
;;; Separator chars :: + * / : %
-;;; A note on the hypen (`-'). Perhaps, the hypen should also be a separator
+;;; A note on the hyphen (`-'). Perhaps the hyphen 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.
(defun cmpl-make-standard-completion-syntax-table ()
(let ((table (make-vector 256 0)) ;; default syntax is whitespace
- )
+ i)
;; alpha chars
- (dotimes (i 26)
+ (setq i 0)
+ (while (< i 26)
(modify-syntax-entry (+ ?a i) "_" table)
- (modify-syntax-entry (+ ?A i) "_" table))
+ (modify-syntax-entry (+ ?A i) "_" table)
+ (setq i (1+ i)))
;; digit chars.
- (dotimes (i 10)
- (modify-syntax-entry (+ ?0 i) "_" table))
+ (setq i 0)
+ (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)
+ (completion-dolist (char symbol-chars)
(modify-syntax-entry char "_" table))
- (dolist (char symbol-chars-ignore)
+ (completion-dolist (char symbol-chars-ignore)
(modify-syntax-entry char "w" table)
)
)
(let ((table (copy-syntax-table cmpl-standard-syntax-table))
(symbol-chars '(?! ?& ?? ?= ?^))
)
- (dolist (char symbol-chars)
+ (completion-dolist (char symbol-chars)
(modify-syntax-entry char "_" table))
table))
(let ((table (copy-syntax-table cmpl-standard-syntax-table))
(separator-chars '(?+ ?* ?/ ?: ?%))
)
- (dolist (char separator-chars)
+ (completion-dolist (char separator-chars)
(modify-syntax-entry char " " table))
table))
(let ((table (copy-syntax-table cmpl-standard-syntax-table))
(separator-chars '(?+ ?- ?* ?/ ?:))
)
- (dolist (char separator-chars)
+ (completion-dolist (char separator-chars)
(modify-syntax-entry char " " table))
table))
(defvar cdabbrev-abbrev-string "")
(defvar cdabbrev-start-point 0)
+(defvar cdabbrev-stop-point)
;;; Test strings for cdabbrev
;;; cdat-upcase ;;same namestring
;; 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 completion-search-distance
- (max (point-min)
- (- cdabbrev-start-point completion-search-distance))
- (point-min))
- cdabbrev-wrapped-p nil)
- )))
+ (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.
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 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)))
- )))
+ (if 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 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))))))
;;; The following must be eval'd in the minibuffer ::
;;; (reset-cdabbrev "cdat")
(defconst cmpl-obarray-length 511)
(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
- "An obarray used to store the downcased completion prefices.
+ "An obarray used to store the downcased completion prefixes.
Each symbol is bound to a list of completion entries.")
(defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
(defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
(list 'setcdr prefix-entry new-tail))
-;;; Contructor
+;;; Constructor
(defun make-cmpl-prefix-entry (completion-entry-list)
"Makes a new prefix entry containing only completion-entry."
(record-clear-all-completions))
)
+(defvar completions-list-return-value)
+
(defun list-all-completions ()
"Returns a list of all the known completion entries."
- (let ((return-completions nil))
+ (let ((completions-list-return-value nil))
(mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
- return-completions))
+ completions-list-return-value))
(defun list-all-completions-1 (prefix-symbol)
(if (boundp prefix-symbol)
- (setq return-completions
+ (setq completions-list-return-value
(append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
- return-completions))))
+ completions-list-return-value))))
(defun list-all-completions-by-hash-bucket ()
"Return list of lists of known completion entries, organized by hash bucket."
- (let ((return-completions nil))
+ (let ((completions-list-return-value nil))
(mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
- return-completions))
+ completions-list-return-value))
(defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
(if (boundp prefix-symbol)
- (setq return-completions
+ (setq completions-list-return-value
(cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
- return-completions))))
+ completions-list-return-value))))
\f
;;;-----------------------------------------------
(cmpl-db-debug-p
;; not found, error if debug mode
(error "Completion entry exists but not on prefix list - %s"
- string))
+ completion-string))
(inside-locate-completion-entry
;; recursive error: really scrod
(locate-completion-db-error))
(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))))
+ (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
;;; 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 approppriate prefix list with
+STRING is added to the end of the appropriate 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.
(set cmpl-db-symbol (car entry))
)))
-(defun add-completion-to-head (string)
- "If STRING is not in the database, add it to prefix list.
-STRING 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'.
+(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.
+COMPLETION-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))
+ (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-ptr (cdr splice-ptr))
)
;; update entry
- (set-completion-string cmpl-db-entry string)
+ (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
cmpl-db-entry)
;; not there
(let (;; create an entry
- (entry (make-completion string))
+ (entry (make-completion completion-string))
;; setup the prefix
(prefix-entry (find-cmpl-prefix-entry
(substring cmpl-db-downcase-string 0
(set cmpl-db-symbol (car entry))
)))
-(defun delete-completion (string)
+(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 string))
+ (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-statistics-block
(note-completion-deleted))
)
- (error "Unknown completion: %s. Couldn't delete it." string)
+ (error "Unknown completion `%s'" completion-string)
))
;;; Tests --
(defun check-completion-length (string)
(if (< (length string) completion-min-length)
- (error "The string \"%s\" is too short to be saved as a completion."
+ (error "The string `%s' is too short to be saved as a completion"
string)
(list string)))
)
(cond (string
(setq entry (add-completion-to-head string))
- (when (and completion-on-separator-character
+ (if (and completion-on-separator-character
(zerop (completion-num-uses entry)))
- (set-completion-num-uses entry 1)
- (setq cmpl-completions-accepted-p t)
- )))
+ (progn
+ (set-completion-num-uses entry 1)
+ (setq cmpl-completions-accepted-p t)))))
))
;;; Tests --
(if completion-to-accept (accept-completion))
(setq cmpl-starting-possibilities
(cmpl-prefix-entry-head
- (find-cmpl-prefix-entry (downcase (substring string 0 3))))
+ (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)
(cond
((= index (setq cmpl-last-index (1+ cmpl-last-index)))
(completion-search-peek t))
- ((minusp index)
+ ((< index 0)
(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 index (1+ index)) 0))
(setq cmpl-next-possibility nil)
)
(cond ((not cmpl-next-possibilities))
(completion-search-reset-1)
(setq cmpl-last-index index)
(while (and (completion-search-peek t)
- (not (minusp (setq index (1- index)))))
+ (not (< (setq index (1- index)) 0)))
(setq cmpl-next-possibility nil)
))
)
(defun complete (&optional arg)
"Fill out a completion of the word before point.
-Point is left at end. Consective calls rotate through all possibilities.
+Point is left at end. Consecutive calls rotate through all possibilities.
Prefix args ::
control-u :: leave the point at the beginning of the completion rather
than at the end.
(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."
+ (error "To complete, 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))
;; Don't accept completions
(setq completion-to-accept nil)
;; print message
- (if (and print-status-p (cmpl19-sit-for 0))
+ ;; This used to call cmpl19-sit-for, an undefined function.
+ ;; I hope that sit-for does the right thing; I don't know -- rms.
+ (if (and print-status-p (sit-for 0))
(message "No %scompletions."
(if (eq this-command last-command) "more " "")))
;; statistics
(let* ((buffer (get-file-buffer file))
(buffer-already-there-p buffer)
)
- (when (not buffer-already-there-p)
- (let ((completions-merging-modes nil))
- (setq buffer (find-file-noselect file))
- ))
+ (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)
)
- (when (not buffer-already-there-p)
- (kill-buffer buffer))
- )))
+ (if (not buffer-already-there-p)
+ (kill-buffer buffer)))))
(defun add-completions-from-buffer ()
(interactive)
(setq mode 'c)
)
(t
- (error "Do not know how to parse completions in %s buffers."
+ (error "Cannot parse completions in %s buffers"
major-mode)
))
(cmpl-statistics-block
)))
))
-(pushnew 'cmpl-find-file-hook find-file-hooks)
+(add-hook 'find-file-hooks 'cmpl-find-file-hook)
;;;-----------------------------------------------
;;; Tags Table Completions
;;; Symbol separator chars (have whitespace syntax) --> , ; * = (
;;; Opening char --> [ {
;;; Closing char --> ] }
-;;; openning and closing must be skipped over
+;;; opening and closing must be skipped over
;;; Whitespace chars (have symbol syntax)
;;; Everything else has word syntax
(defun cmpl-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
+ ;; unfortunately the ?( causes the parens to appear unbalanced
(separator-chars '(?, ?* ?= ?\( ?\;
))
- )
+ i)
;; default syntax is whitespace
- (dotimes (i 256)
- (modify-syntax-entry i "w" table))
- (dolist (char whitespace-chars)
+ (setq i 0)
+ (while (< i 256)
+ (modify-syntax-entry i "w" table)
+ (setq i (1+ i)))
+ (completion-dolist (char whitespace-chars)
(modify-syntax-entry char "_" table))
- (dolist (char separator-chars)
+ (completion-dolist (char separator-chars)
(modify-syntax-entry char " " table))
(modify-syntax-entry ?\[ "(]" table)
(modify-syntax-entry ?\{ "(}" table)
)
(error
;; Check for failure in scan-sexps
- (if (or (string-equal (second e)
+ (if (or (string-equal (nth 1 e)
"Containing expression ends prematurely")
- (string-equal (second e) "Unbalanced parentheses"))
+ (string-equal (nth 1 e) "Unbalanced parentheses"))
;; unbalanced paren., keep going
;;(ding)
(forward-line 1)
- (message "Error parsing C buffer for completions. Please bug report.")
+ (message "Error parsing C buffer for completions--please send bug report")
(throw 'finish-add-completions t)
))
))
;;; The version of save-completions-to-file called at kill-emacs time.
(defun kill-emacs-save-completions ()
- (when (and save-completions-flag enable-completion cmpl-initialized-p)
- (cond
- ((not cmpl-completions-accepted-p)
- (message "Completions database has not changed - not writing."))
- (t
- (save-completions-to-file)
- ))
- ))
+ (if (and save-completions-flag enable-completion cmpl-initialized-p)
+ (cond
+ ((not cmpl-completions-accepted-p)
+ (message "Completions database has not changed - not writing."))
+ (t
+ (save-completions-to-file)))))
+
+;; There is no point bothering to change this again
+;; unless the package changes so much that it matters
+;; for people that have saved completions.
+(defconst completion-version "11")
(defconst saved-cmpl-file-header
";;; Completion Initialization file.
If file name is not specified, use `save-completions-file-name'."
(interactive)
(setq filename (expand-file-name (or filename save-completions-file-name)))
- (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 completions-file-versions-kept)
- 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))
- )
+ (if (file-writable-p filename)
+ (progn
+ (if (not cmpl-initialized-p)
+ (initialize-completions));; make sure everything's loaded
+ (message "Saving completions to file %s" filename)
+
+ (let* ((delete-old-versions t)
+ (kept-old-versions 0)
+ (kept-new-versions completions-file-versions-kept)
+ 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)
-
- (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
- ;; 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")
- )))
+ (save-excursion
+ (get-buffer-create " *completion-save-buffer*")
+ (set-buffer " *completion-save-buffer*")
+ (setq buffer-file-name filename)
+
+ (if (not (verify-visited-file-modtime (current-buffer)))
+ (progn
+ ;; 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))
+ (completion-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 (> (completion-num-uses completion) 0)
+ ;; it's been used
+ (setq last-use-time current-time)
+ ;; or it was saved before and
+ (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)))
- (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!)
+ ;; write the buffer
+ (condition-case e
+ (let ((file-exists-p (file-exists-p filename)))
+ (if file-exists-p
+ (progn
+ ;; 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))
- )))
+ ;; If backup doesn't exit, Rename current to backup
+ ;; {If backup exists the primary file is probably messed up}
+ (or (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)
+ (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 autosave-completions ()
-;;; (when (and save-completions-flag enable-completion cmpl-initialized-p
-;;; *completion-auto-save-period*
-;;; (> cmpl-emacs-idle-time *completion-auto-save-period*)
-;;; cmpl-completions-accepted-p)
-;;; (save-completions-to-file)
-;;; ))
+;;; (if (and save-completions-flag enable-completion 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)
+;;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions)
(defun load-completions-from-file (&optional filename no-message-p)
"Loads a completion init file 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)
+ (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 . . ."
+ (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-origin))
- 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))
+ (let ((insert-okay-p nil)
+ (buffer (current-buffer))
+ (current-time (cmpl-hours-since-origin))
+ 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
+ (if insert-okay-p
+ (progn
+ (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))
))
- ;; 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(")
+ (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.")
+ ))
)))
- (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)))
+ (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.
;;; Patches to self-insert-command.
;;;-----------------------------------------------
-;;; Need 2 versions: generic seperator chars. and space (to get auto fill
+;;; Need 2 versions: generic separator 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).
+;;; symbol before point to the completion list (using ADD-COMPLETION).
(defun completion-separator-self-insert-command (arg)
(interactive "p")
(interactive "p")
(use-completion-before-separator)
(self-insert-command arg)
- (and (> (current-column) fill-column)
- auto-fill-function
+ (and auto-fill-function
(funcall auto-fill-function))
)
(cmpl-statistics-block (record-complete-failed))))
(defun completion-before-command ()
- (funcall (or (get this-command 'completion-function)
+ (funcall (or (and (symbolp this-command)
+ (get this-command 'completion-function))
'use-completion-under-or-before-point)))
-(add-hook 'before-command-hook 'completion-before-command)
+(add-hook 'pre-command-hook 'completion-before-command)
;;;---------------------------------------------------------------------------