X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e9571d2a21b7fd2dc46549382bea5ed4c00ddb07..8bb6fec9b47079940cb27c2bab460ef2b58a20fe:/lisp/completion.el diff --git a/lisp/completion.el b/lisp/completion.el index 8203cbe471..55c65a9201 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -1,70 +1,33 @@ ;;; completion.el --- dynamic word-completion code +;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc. -;; Maintainer: bug-completion@think.com +;; Maintainer: FSF ;; Keywords: abbrev +;; Author: Jim Salem of Thinking Machines Inc. +;; (ideas suggested by Brewster Kahle) -;;; Commentary: +;; This file is part of GNU Emacs. -;;; 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 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. + +;; 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. -;;; - -;;; 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 -;;; ;;;--------------------------------------------------------------------------- ;;; Documentation [Slightly out of date] @@ -103,20 +66,20 @@ ;;;--------------------- ;;; ;;; 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 *completep*. +;;; database by changing the value of enable-completion. ;;; ;;; SAVING/LOADING COMPLETIONS ;;; Completions are automatically saved from one session to another -;;; (unless *save-completions-p* or *completep* is nil). +;;; (unless save-completions-flag or enable-completion is nil). ;;; Loading this file (or calling initialize-completions) causes EMACS ;;; to load a completions database for a saved completions file ;;; (default: ~/.completions). When you exit, EMACS saves a copy of the @@ -132,9 +95,9 @@ ;;; completions have their num-uses slot set to T. Use ;;; add-permanent-completion to do this ;;; -;;; Completions are saved only if *completep* is T. The number of old +;;; Completions are saved only if enable-completion is T. The number of old ;;; versions kept of the saved completions file is controlled by -;;; *completion-file-versions-kept*. +;;; completions-file-versions-kept. ;;; ;;; COMPLETE KEY OPTIONS ;;; The complete function takes a numeric arguments. @@ -185,22 +148,6 @@ ;;; ;;; -;;;----------------------------------------------- -;;; 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 ;;;--------------------------------------------------------------------------- @@ -281,7 +228,7 @@ ;;; 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, @@ -326,77 +273,65 @@ ;;; Code: -;;;----------------------------------------------- -;;; Requires -;;; Version -;;;----------------------------------------------- - -;;(require 'cl) ;; DOTIMES, etc. {actually done after variable defs.} - -(defconst *completion-version* 10 - "Tested for EMACS versions 18.49, 18.52, 18.55 and beyond and 19.0.") - ;;;--------------------------------------------------------------------------- ;;; User changeable parameters ;;;--------------------------------------------------------------------------- -(defvar *completep* t - "*Set to nil to turn off the completion hooks. -(No new words added to the database or saved to the init file).") +(defvar 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.") -(defvar *save-completions-p* t - "*If non-nil, the most useful completions are saved to disk when -exiting EMACS. See *saved-completions-decay-factor*.") +(defvar save-completions-flag t + "*Non-nil means save most-used completions when exiting Emacs. +See also `saved-completions-retention-time'.") -(defvar *saved-completions-filename* "~/.completions" +(defvar save-completions-file-name "~/.completions" "*The filename to save completions to.") -(defvar *saved-completion-retention-time* 336 - "*The maximum amount of time to save a completion for if it has not been used. -In hours. (1 day = 24, 1 week = 168). If this is 0, non-permanent completions +(defvar save-completions-retention-time 336 + "*Discard a completion if unused for this many hours. +\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions will not be saved unless these are used. Default is two weeks.") -(defvar *separator-character-uses-completion-p* nil - "*If non-nil, typing a separator character after a completion symbol that -is not part of the database marks it as used (so it will be saved).") +(defvar completion-on-separator-character nil + "*Non-nil means separator characters mark previous word as used. +This means the word will be saved as a completion.") -(defvar *completion-file-versions-kept* kept-new-versions - "*Set this to the number of versions you want save-completions-to-file -to keep.") +(defvar completions-file-versions-kept kept-new-versions + "*Number of versions to keep for the saved completions file.") -(defvar *print-next-completion-speed-threshold* 4800 - "*The baud rate at or above which to print the next potential completion -after inserting the current one." - ) +(defvar completion-prompt-speed-threshold 4800 + "*Minimum output speed at which to display next potential completion.") -(defvar *print-next-completion-does-cdabbrev-search-p* nil - "*If non-nil, the next completion prompt will also do a cdabbrev search. +(defvar completion-cdabbrev-prompt-flag nil + "*If non-nil, the next completion prompt does a cdabbrev search. This can be time consuming.") -(defvar *cdabbrev-radius* 15000 - "*How far to search for cdabbrevs. In number of characters. If nil, the -whole buffer is searched.") +(defvar completion-search-distance 15000 + "*How far to search in the buffer when looking for completions. +In number of characters. If nil, search the whole buffer.") -(defvar *modes-for-completion-find-file-hook* '(lisp c) - "*A list of modes {either C or Lisp}. Definitions from visited files -of those types are automatically added to the completion database.") +(defvar completions-merging-modes '(lisp c) + "*List of modes {`c' or `lisp'} for automatic completions merging. +Definitions from visited files which have these modes +are automatically added to the completion database.") -(defvar *record-cmpl-statistics-p* nil - "*If non-nil, statistics are automatically recorded.") +;;;(defvar *record-cmpl-statistics-p* nil +;;; "*If non-nil, record completion statistics.") -(defvar *completion-auto-save-period* 1800 - "*The period in seconds to wait for emacs to be idle before autosaving -the completions. Default is a 1/2 hour.") +;;;(defvar *completion-auto-save-period* 1800 +;;; "*The period in seconds to wait for emacs to be idle before autosaving +;;;the completions. Default is a 1/2 hour.") -(defconst *completion-min-length* nil ;; defined below in eval-when +(defconst completion-min-length nil ;; defined below in eval-when "*The minimum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") -(defconst *completion-max-length* nil ;; defined below in eval-when +(defconst completion-max-length nil ;; defined below in eval-when "*The maximum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") -(defconst *completion-prefix-min-length* nil ;; defined below in eval-when +(defconst completion-prefix-min-length nil ;; defined below in eval-when "The minimum length of a completion search string. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") @@ -405,14 +340,37 @@ DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (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-min-length* 6) - (setq *completion-max-length* 200) - (setq *completion-prefix-min-length* 3) - ;; Need this file around too - (require 'cl))) + (setq completion-min-length 6) + (setq completion-max-length 200) + (setq completion-prefix-min-length 3))) (completion-eval-when) @@ -421,13 +379,16 @@ DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") ;;;--------------------------------------------------------------------------- (defvar cmpl-initialized-p nil - "Set to t when the completion system is initialized. Indicates that the -old completion file has been read in.") + "Set to t when the completion system is initialized. +Indicates that the old completion file has been read in.") (defvar cmpl-completions-accepted-p nil - "Set to T as soon as the first completion has been accepted. Used to -decide whether to save completions.") + "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) ;;;--------------------------------------------------------------------------- ;;; Low level tools @@ -437,128 +398,13 @@ decide whether to save completions.") ;;; Misc. ;;;----------------------------------------------- -(defun remove (item list) - (setq list (copy-sequence list)) - (delq item list)) - (defun minibuffer-window-selected-p () "True iff the current window is the minibuffer." - (eq (minibuffer-window) (selected-window))) - -(eval-when-compile-load-eval -(defun function-needs-autoloading-p (symbol) - ;; True iff symbol is represents an autoloaded function and has not yet been - ;; autoloaded. - (and (listp (symbol-function symbol)) - (eq 'autoload (car (symbol-function symbol))) - ))) + (window-minibuffer-p (selected-window))) -(defun function-defined-and-loaded (symbol) - ;; True iff symbol is bound to a loaded function. - (and (fboundp symbol) (not (function-needs-autoloading-p symbol)))) - -(defmacro read-time-eval (form) - ;; Like the #. reader macro - (eval form)) - -;;;----------------------------------------------- -;;; Emacs Version 19 compatibility -;;;----------------------------------------------- - -(defconst emacs-is-version-19 (string= (substring emacs-version 0 2) "19")) - -(defun cmpl19-baud-rate () - (if emacs-is-version-19 - baud-rate - (baud-rate))) - -(defun cmpl19-sit-for (amount) - (if (and emacs-is-version-19 (= amount 0)) - (sit-for 1 t) - (sit-for amount))) - -;;;----------------------------------------------- -;;; Advise -;;;----------------------------------------------- - -(defmacro completion-advise (function-name where &rest body) - "Adds the body code before calling function. This advise is not compiled. -WHERE is either :BEFORE or :AFTER." - (completion-advise-1 function-name where body) - ) - -(defmacro cmpl-apply-as-top-level (function arglist) - "Calls function-name interactively if inside a call-interactively." - (list 'cmpl-apply-as-top-level-1 function arglist - '(let ((executing-macro nil)) (interactive-p))) - ) - -(defun cmpl-apply-as-top-level-1 (function arglist interactive-p) - (if (and interactive-p (commandp function)) - (call-interactively function) - (apply function arglist) - )) - -(eval-when-compile-load-eval - -(defun cmpl-defun-preamble (function-name) - (let ((doc-string - (condition-case e - ;; This condition-case is here to stave - ;; off bizarre load time errors 18.52 gets - ;; on the function c-mode - (documentation function-name) - (error nil))) - (interactivep (commandp function-name)) - ) - (append - (if doc-string (list doc-string)) - (if interactivep '((interactive))) - ))) - -(defun completion-advise-1 (function-name where body &optional new-name) - (unless new-name (setq new-name function-name)) - (let ((quoted-name (list 'quote function-name)) - (quoted-new-name (list 'quote new-name)) - ) - - (cond ((function-needs-autoloading-p function-name) - (list* 'defun function-name '(&rest arglist) - (append - (cmpl-defun-preamble function-name) - (list (list 'load (second (symbol-function function-name))) - (list 'eval - (list 'completion-advise-1 quoted-name - (list 'quote where) (list 'quote body) - quoted-new-name)) - (list 'cmpl-apply-as-top-level quoted-new-name 'arglist) - ))) - ) - (t - (let ((old-def-name - (intern (concat "$$$cmpl-" (symbol-name function-name)))) - ) - - (list 'progn - (list 'defvar old-def-name - (list 'symbol-function quoted-name)) - (list* 'defun new-name '(&rest arglist) - (append - (cmpl-defun-preamble function-name) - (ecase where - (:before - (list (cons 'progn body) - (list 'cmpl-apply-as-top-level - old-def-name 'arglist))) - (:after - (list* (list 'cmpl-apply-as-top-level - old-def-name 'arglist) - body) - ))) - ))) - )))) -) ;; eval-when - +;; This used to be `(eval form)'. Eval FORM at run time now. +(defmacro cmpl-read-time-eval (form) + form) ;;;----------------------------------------------- ;;; String case coercion @@ -620,160 +466,11 @@ WHERE is either :BEFORE or :AFTER." ;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 -;;;----------------------------------------------- -;;; Emacs Idle Time hooks -;;;----------------------------------------------- - -(defvar cmpl-emacs-idle-process nil) - -(defvar cmpl-emacs-idle-interval 150 - "Seconds between running the Emacs idle process.") - -(defun init-cmpl-emacs-idle-process () - "Initialize the emacs idle process." - (let ((live (and cmpl-emacs-idle-process - (eq (process-status cmpl-emacs-idle-process) 'run))) - ;; do not allocate a pty - (process-connection-type nil)) - (if live - (kill-process cmpl-emacs-idle-process)) - (if cmpl-emacs-idle-process - (delete-process cmpl-emacs-idle-process)) - (setq cmpl-emacs-idle-process - (start-process "cmpl-emacs-idle" nil - "loadst" - "-n" (int-to-string cmpl-emacs-idle-interval))) - (process-kill-without-query cmpl-emacs-idle-process) - (set-process-filter cmpl-emacs-idle-process 'cmpl-emacs-idle-filter) - )) - -(defvar cmpl-emacs-buffer nil) -(defvar cmpl-emacs-point 0) -(defvar cmpl-emacs-last-command nil) -(defvar cmpl-emacs-last-command-char nil) -(defun cmpl-emacs-idle-p () - ;; returns T if emacs has been idle - (if (and (eq cmpl-emacs-buffer (current-buffer)) - (= cmpl-emacs-point (point)) - (eq cmpl-emacs-last-command last-command) - (eq last-command-char last-command-char) - ) - t ;; idle - ;; otherwise, update count - (setq cmpl-emacs-buffer (current-buffer)) - (setq cmpl-emacs-point (point)) - (setq cmpl-emacs-last-command last-command) - (setq last-command-char last-command-char) - nil - )) - -(defvar cmpl-emacs-idle-time 0 - "The idle time of Emacs in seconds.") - -(defvar inside-cmpl-emacs-idle-filter nil) -(defvar cmpl-emacs-idle-time-hooks nil) - -(defun cmpl-emacs-idle-filter (proc string) - ;; This gets called every cmpl-emacs-idle-interval seconds - ;; Update idle time clock - (if (cmpl-emacs-idle-p) - (incf cmpl-emacs-idle-time cmpl-emacs-idle-interval) - (setq cmpl-emacs-idle-time 0)) - - (unless inside-cmpl-emacs-idle-filter - ;; Don't reenter if we are hung - - (setq inside-cmpl-emacs-idle-filter t) - - (dolist (function cmpl-emacs-idle-time-hooks) - (condition-case e - (funcall function) - (error nil) - )) - (setq inside-cmpl-emacs-idle-filter nil) - )) - - -;;;----------------------------------------------- -;;; Time -;;;----------------------------------------------- -;;; What a backwards way to get the time! Unfortunately, GNU Emacs -;;; doesn't have an accessible time function. - -(defconst cmpl-hours-per-day 24) -(defconst cmpl-hours-per-year (* 365 cmpl-hours-per-day)) -(defconst cmpl-hours-per-4-years (+ (* 4 cmpl-hours-per-year) - cmpl-hours-per-day)) -(defconst cmpl-days-since-start-of-year - '(0 31 59 90 120 151 181 212 243 273 304 334)) -(defconst cmpl-days-since-start-of-leap-year - '(0 31 60 91 121 152 182 213 244 274 305 335)) -(defconst cmpl-months - '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) - -(defun cmpl-hours-since-1900-internal (month day year hours) - "Month is an integer from 1 to 12. Year is a two digit integer (19XX)" - (+ ;; Year - (* (/ (1- year) 4) cmpl-hours-per-4-years) - (* (1+ (mod (1- year) 4)) cmpl-hours-per-year) - ;; minus two to account for 1968 rather than 1900 - ;; month - (* cmpl-hours-per-day - (nth (1- month) (if (zerop (mod year 4)) - cmpl-days-since-start-of-leap-year - cmpl-days-since-start-of-year))) - (* (1- day) cmpl-hours-per-day) - hours)) - -(defun cmpl-month-from-string (month-string) - "Month string is a three char. month string" - (let ((count 1)) - (do ((list cmpl-months (cdr list)) - ) - ((or (null list) (string-equal month-string (car list)))) - (setq count (1+ count))) - (if (> count 12) - (error "Unknown month - %s" month-string)) - count)) - -(defun cmpl-hours-since-1900 (&optional time-string) - "String is a string in the format of current-time-string (the default)." - (let* ((string (or time-string (current-time-string))) - (month (cmpl-month-from-string (substring string 4 7))) - (day (string-to-int (substring string 8 10))) - (year (string-to-int (substring string 22 24))) - (hour (string-to-int (substring string 11 13))) - ) - (cmpl-hours-since-1900-internal month day year hour))) - -;;; Tests - -;;;(cmpl-hours-since-1900 "Wed Jan 1 00:00:28 1900") --> 35040 -;;;(cmpl-hours-since-1900 "Wed Nov 2 23:00:28 1988") --> 778751 -;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1988") --> 771926 -;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1988") --> 772670 -;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1988") --> 773366 -;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1988") --> 774110 -;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1988") --> 774830 -;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1988") --> 775574 -;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1988") --> 776294 -;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1988") --> 777038 -;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1988") --> 777782 -;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1988") --> 778502 -;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1988") --> 779246 -;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1988") --> 779966 -;;;(cmpl-hours-since-1900 "Wed Jan 23 14:34:28 1957") --> 500198 -;;;(cmpl-hours-since-1900 "Wed Feb 23 14:34:28 1957") --> 500942 -;;;(cmpl-hours-since-1900 "Wed Mar 23 14:34:28 1957") --> 501614 -;;;(cmpl-hours-since-1900 "Wed Apr 23 14:34:28 1957") --> 502358 -;;;(cmpl-hours-since-1900 "Wed May 23 14:34:28 1957") --> 503078 -;;;(cmpl-hours-since-1900 "Wed Jun 23 14:34:28 1957") --> 503822 -;;;(cmpl-hours-since-1900 "Wed Jul 23 14:34:28 1957") --> 504542 -;;;(cmpl-hours-since-1900 "Wed Aug 23 14:34:28 1957") --> 505286 -;;;(cmpl-hours-since-1900 "Wed Sep 23 14:34:28 1957") --> 506030 -;;;(cmpl-hours-since-1900 "Wed Oct 23 14:34:28 1957") --> 506750 -;;;(cmpl-hours-since-1900 "Wed Nov 23 14:34:28 1957") --> 507494 -;;;(cmpl-hours-since-1900 "Wed Dec 23 14:34:28 1957") --> 508214 - +(defun cmpl-hours-since-origin () + (let ((time (current-time))) + (truncate + (+ (* (/ (car time) 3600.0) (lsh 1 16)) + (/ (nth 2 time) 3600.0))))) ;;;--------------------------------------------------------------------------- ;;; "Symbol" parsing functions @@ -810,7 +507,7 @@ WHERE is either :BEFORE or :AFTER." ;;; ;;; 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. @@ -828,57 +525,61 @@ WHERE is either :BEFORE or :AFTER." ;;; Table definitions ;;;----------------------------------------------- -(defun make-standard-completion-syntax-table () - (let ((table (make-vector 256 0)) ;; default syntax is whitespace - ) +(defun cmpl-make-standard-completion-syntax-table () + (let ((table (make-syntax-table)) ;; 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) ) ) table)) -(defconst cmpl-standard-syntax-table (make-standard-completion-syntax-table)) +(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) -(defun make-lisp-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) + (completion-dolist (char symbol-chars) (modify-syntax-entry char "_" table)) table)) -(defun make-c-completion-syntax-table () +(defun cmpl-make-c-completion-syntax-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)) -(defun make-fortran-completion-syntax-table () +(defun cmpl-make-fortran-completion-syntax-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)) -(defconst cmpl-lisp-syntax-table (make-lisp-completion-syntax-table)) -(defconst cmpl-c-syntax-table (make-c-completion-syntax-table)) -(defconst cmpl-fortran-syntax-table (make-fortran-completion-syntax-table)) +(defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) +(defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) +(defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table)) (defvar cmpl-syntax-table cmpl-standard-syntax-table "This variable holds the current completion syntax table.") @@ -888,36 +589,34 @@ WHERE is either :BEFORE or :AFTER." ;;; Installing the appropriate mode tables ;;;----------------------------------------------- -(completion-advise lisp-mode-variables :after - (setq cmpl-syntax-table cmpl-lisp-syntax-table) - ) +(add-hook 'lisp-mode-hook + '(lambda () + (setq cmpl-syntax-table cmpl-lisp-syntax-table))) -(completion-advise c-mode :after - (setq cmpl-syntax-table cmpl-c-syntax-table) - ) +(add-hook 'c-mode-hook + '(lambda () + (setq cmpl-syntax-table cmpl-c-syntax-table))) -(completion-advise fortran-mode :after - (setq cmpl-syntax-table cmpl-fortran-syntax-table) - (completion-setup-fortran-mode) - ) +(add-hook 'fortran-mode-hook + '(lambda () + (setq cmpl-syntax-table cmpl-fortran-syntax-table) + (completion-setup-fortran-mode))) ;;;----------------------------------------------- ;;; Symbol functions ;;;----------------------------------------------- (defvar cmpl-symbol-start nil - "Set to the first character of the symbol after one of the completion -symbol functions is called.") + "Holds first character of symbol, after any completion symbol function.") (defvar cmpl-symbol-end nil - "Set to the last character of the symbol after one of the completion -symbol functions is called.") + "Holds last character of symbol, after any completion symbol function.") ;;; These are temp. vars. we use to avoid using let. ;;; Why ? Small speed improvement. (defvar cmpl-saved-syntax nil) (defvar cmpl-saved-point nil) (defun symbol-under-point () - "Returns the symbol that the point is currently on if it is longer -than *completion-min-length*." + "Returns the symbol that the point is currently on. +But only if it is longer than `completion-min-length'." (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) (cond @@ -943,10 +642,10 @@ than *completion-min-length*." ;; restore state (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable - (if (and (<= (read-time-eval *completion-min-length*) + (if (and (<= (cmpl-read-time-eval completion-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) - (read-time-eval *completion-max-length*))) + (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t @@ -968,8 +667,8 @@ than *completion-min-length*." ;;; (defun symbol-before-point () - "Returns a string of the symbol immediately before point -or nil if there isn't one longer than *completion-min-length*." + "Returns a string of the symbol immediately before point. +Returns nil if there isn't one longer than `completion-min-length'." ;; This is called when a word separator is typed so it must be FAST ! (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) @@ -991,7 +690,7 @@ or nil if there isn't one longer than *completion-min-length*." ;; return value if long enough (if (>= cmpl-symbol-end (+ cmpl-symbol-start - (read-time-eval *completion-min-length*))) + (cmpl-read-time-eval completion-min-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) ((= cmpl-preceding-syntax ?w) @@ -1011,10 +710,10 @@ or nil if there isn't one longer than *completion-min-length*." (goto-char cmpl-saved-point) (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable - (if (and (<= (read-time-eval *completion-min-length*) + (if (and (<= (cmpl-read-time-eval completion-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) - (read-time-eval *completion-max-length*))) + (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t @@ -1075,11 +774,11 @@ or nil if there isn't one longer than *completion-min-length*." ;; restore state (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable - (if (and (<= (read-time-eval - *completion-prefix-min-length*) + (if (and (<= (cmpl-read-time-eval + completion-prefix-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) - (read-time-eval *completion-max-length*))) + (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t @@ -1115,11 +814,11 @@ or nil if there isn't one longer than *completion-min-length*." ;;; Conditionalizing code on *record-cmpl-statistics-p* ;;;----------------------------------------------- ;;; All statistics code outside this block should use this -(defmacro cmpl-statistics-block (&rest body) - "Only executes body if we are recording statistics." - (list 'cond - (list* '*record-cmpl-statistics-p* body) - )) +(defmacro cmpl-statistics-block (&rest body)) +;;; "Only executes body if we are recording statistics." +;;; (list 'cond +;;; (list* '*record-cmpl-statistics-p* body) +;;; )) ;;;----------------------------------------------- ;;; Completion Sources @@ -1166,6 +865,7 @@ or nil if there isn't one longer than *completion-min-length*." (defvar cdabbrev-abbrev-string "") (defvar cdabbrev-start-point 0) +(defvar cdabbrev-stop-point) ;;; Test strings for cdabbrev ;;; cdat-upcase ;;same namestring @@ -1178,7 +878,7 @@ or nil if there isn't one longer than *completion-min-length*." (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) "Resets the cdabbrev search to search for abbrev-string. -initial-completions-tried is a list of downcased strings to ignore +INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore during the search." (setq cdabbrev-abbrev-string abbrev-string cdabbrev-completions-tried @@ -1196,9 +896,7 @@ during the search." (defun reset-cdabbrev-window (&optional initializep) - "Resets the cdabbrev search to search for abbrev-string. -initial-completions-tried is a list of downcased strings to ignore -during the search." + "Resets the cdabbrev search to search for abbrev-string." ;; Set the window (cond (initializep (setq cdabbrev-current-window (selected-window)) @@ -1212,107 +910,107 @@ during the search." ;; No more windows, try other buffer. (setq cdabbrev-current-window t))) ) - (when cdabbrev-current-window - (save-excursion - (set-cdabbrev-buffer) - (setq cdabbrev-current-point (point) - cdabbrev-start-point cdabbrev-current-point - cdabbrev-stop-point - (if *cdabbrev-radius* - (max (point-min) - (- cdabbrev-start-point *cdabbrev-radius*)) - (point-min)) - cdabbrev-wrapped-p nil) - ))) + (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. This is sensitive to case-fold-search." +`reset-cdabbrev' must've been called already. +This is sensitive to `case-fold-search'." ;; note that case-fold-search affects the behavior of this function ;; Bug: won't pick up an expansion that starts at the top of buffer - (when cdabbrev-current-window - (let (saved-point - saved-syntax - (expansion nil) - downcase-expansion tried-list syntax saved-point-2) - (save-excursion - (unwind-protect - (progn - ;; Switch to current completion buffer - (set-cdabbrev-buffer) - ;; Save current buffer state - (setq saved-point (point) - saved-syntax (syntax-table)) - ;; Restore completion state - (set-syntax-table cmpl-syntax-table) - (goto-char cdabbrev-current-point) - ;; Loop looking for completions - (while - ;; This code returns t if it should loop again - (cond - (;; search for the string - (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) - ;; return nil if the completion is valid - (not - (and - ;; does it start with a separator char ? - (or (= (setq syntax (char-syntax (preceding-char))) ? ) - (and (= syntax ?w) - ;; symbol char to ignore at end. Are we at end ? - (progn - (setq saved-point-2 (point)) - (forward-word -1) - (prog1 - (= (char-syntax (preceding-char)) ? ) - (goto-char saved-point-2) - )))) - ;; is the symbol long enough ? - (setq expansion (symbol-under-point)) - ;; have we not tried this one before - (progn - ;; See if we've already used it - (setq tried-list cdabbrev-completions-tried - downcase-expansion (downcase expansion)) - (while (and tried-list - (not (string-equal downcase-expansion - (car tried-list)))) - ;; Already tried, don't choose this one - (setq tried-list (cdr tried-list)) - ) - ;; at this point tried-list will be nil if this - ;; expansion has not yet been tried - (if tried-list - (setq expansion nil) - t) - )))) - ;; search failed - (cdabbrev-wrapped-p - ;; If already wrapped, then we've failed completely - nil) - (t - ;; need to wrap - (goto-char (setq cdabbrev-current-point - (if *cdabbrev-radius* - (min (point-max) (+ cdabbrev-start-point *cdabbrev-radius*)) - (point-max)))) - - (setq cdabbrev-wrapped-p t)) - )) - ;; end of while loop - (cond (expansion - ;; successful - (setq cdabbrev-completions-tried - (cons downcase-expansion cdabbrev-completions-tried) - cdabbrev-current-point (point)))) - ) - (set-syntax-table saved-syntax) - (goto-char saved-point) - )) - ;; If no expansion, go to next window - (cond (expansion) - (t (reset-cdabbrev-window) - (next-cdabbrev))) - ))) + (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") @@ -1346,7 +1044,7 @@ reset-cdabbrev must've been called. This is sensitive to case-fold-search." (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) @@ -1376,7 +1074,7 @@ Each symbol is bound to a single completion entry.") (list 'car (list 'cdr completion-entry))) (defmacro completion-last-use-time (completion-entry) - ;; "The time it was last used. In hours since 1900. Used to decide + ;; "The time it was last used. In hours since origin. Used to decide ;; whether to save it. T if one should always save it." (list 'nth 2 completion-entry)) @@ -1425,7 +1123,7 @@ Each symbol is bound to a single completion entry.") (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." @@ -1444,30 +1142,31 @@ Each symbol is bound to a single 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 () - "Returns a list of lists of all the known completion entries organized by -hash bucket." - (let ((return-completions nil)) + "Return list of lists of known completion entries, organized by hash bucket." + (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)))) ;;;----------------------------------------------- @@ -1495,7 +1194,7 @@ hash bucket." ;;; READS (defun find-exact-completion (string) "Returns the completion entry for string or nil. -Sets up cmpl-db-downcase-string and cmpl-db-symbol." +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))) @@ -1504,9 +1203,9 @@ Sets up cmpl-db-downcase-string and 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." +Sets `cmpl-db-prefix-symbol'. +Prefix-string must be exactly `completion-prefix-min-length' long +and downcased. Sets up `cmpl-db-prefix-symbol'." (and (boundp (setq cmpl-db-prefix-symbol (intern prefix-string cmpl-prefix-obarray))) (symbol-value cmpl-db-prefix-symbol))) @@ -1518,7 +1217,7 @@ and downcased. Sets up cmpl-db-prefix-symbol." "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." +Must be called after `find-exact-completion'." (let ((prefix-list (cmpl-prefix-entry-head prefix-entry)) next-prefix-list ) @@ -1536,7 +1235,7 @@ Must be called after find-exact-completion." (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)) @@ -1552,12 +1251,12 @@ Must be called after find-exact-completion." (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 @@ -1574,9 +1273,9 @@ Must be called after find-exact-completion." ;;; 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*. +longer than `completion-prefix-min-length'. This must be very fast. Returns the completion entry." (or (find-exact-completion string) @@ -1586,8 +1285,8 @@ Returns the completion entry." ;; setup the prefix (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 - (read-time-eval - *completion-prefix-min-length*)))) + (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. @@ -1606,28 +1305,28 @@ Returns the completion entry." (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 - (read-time-eval - *completion-prefix-min-length*)))) + (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 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 @@ -1643,12 +1342,12 @@ Returns the completion entry." 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 - (read-time-eval - *completion-prefix-min-length*)))) + (cmpl-read-time-eval + completion-prefix-min-length)))) ) (cond (prefix-entry ;; Splice in at head @@ -1665,17 +1364,17 @@ Returns the completion entry." (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*." +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 - (read-time-eval - *completion-prefix-min-length*)))) + (cmpl-read-time-eval + completion-prefix-min-length)))) (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) ) ;; delete symbol reference @@ -1697,7 +1396,7 @@ String must be longer than *completion-prefix-min-length*." (cmpl-statistics-block (note-completion-deleted)) ) - (error "Unknown completion: %s. Couldn't delete it." string) + (error "Unknown completion `%s'" completion-string) )) ;;; Tests -- @@ -1762,14 +1461,13 @@ String must be longer than *completion-prefix-min-length*." )) (defun check-completion-length (string) - (if (< (length string) *completion-min-length*) - (error "The string \"%s\" is too short to be saved as a completion." + (if (< (length string) completion-min-length) + (error "The string `%s' is too short to be saved as a completion" string) (list string))) (defun add-completion (string &optional num-uses last-use-time) - "If the string is not there, it is added to the head of the completion list. -Otherwise, it is moved to the head of the list. + "Add STRING to completion list, or move it to head of list. The completion is altered appropriately if num-uses and/or last-use-time is specified." (interactive (interactive-completion-string-reader "Completion to add")) @@ -1785,7 +1483,7 @@ specified." )) (defun add-permanent-completion (string) - "Adds string if it isn't already there and and makes it a permanent 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) @@ -1802,9 +1500,9 @@ specified." ) (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." + "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) @@ -1817,29 +1515,28 @@ completion-search-reset." )) (defun use-completion-under-point () - "Adds the completion symbol underneath the point into the completion buffer." - (let ((string (and *completep* (symbol-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)) (if string (add-completion-to-head string)))) (defun use-completion-before-point () - "Adds the completion symbol before point into -the completion buffer." - (let ((string (and *completep* (symbol-before-point))) + "Add the completion symbol before point into the completion buffer." + (let ((string (and enable-completion (symbol-before-point))) (current-completion-source cmpl-source-cursor-moves)) (if string (add-completion-to-head string)))) (defun use-completion-under-or-before-point () - "Adds the completion symbol before point into the completion buffer." - (let ((string (and *completep* (symbol-under-or-before-point))) + "Add the completion symbol before point into the completion buffer." + (let ((string (and enable-completion (symbol-under-or-before-point))) (current-completion-source cmpl-source-cursor-moves)) (if string (add-completion-to-head string)))) (defun use-completion-before-separator () - "Adds the completion symbol before point into the completion buffer. + "Add the completion symbol before point into the completion buffer. Completions added this way will automatically be saved if -*separator-character-uses-completion-p* is non-nil." - (let ((string (and *completep* (symbol-before-point))) +`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 @@ -1847,11 +1544,11 @@ Completions added this way will automatically be saved if ) (cond (string (setq entry (add-completion-to-head string)) - (when (and *separator-character-uses-completion-p* + (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 -- @@ -1908,12 +1605,13 @@ Completions added this way will automatically be saved if (defun completion-search-reset (string) - "Given a string, sets up the get-completion and completion-search-next functions. -String must be longer than *completion-prefix-min-length*." + "Set up the for completion searching for STRING. +STRING must be longer than `completion-prefix-min-length'." (if completion-to-accept (accept-completion)) (setq cmpl-starting-possibilities (cmpl-prefix-entry-head - (find-cmpl-prefix-entry (downcase (substring string 0 3)))) + (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) @@ -1928,20 +1626,20 @@ String must be longer than *completion-prefix-min-length*." )) (defun completion-search-next (index) - "Returns the next completion entry. -If index is out of sequence it resets and starts from the top. -If there are no more entries it tries cdabbrev and returns only a string." + "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." (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)) @@ -1963,7 +1661,7 @@ If there are no more entries it tries cdabbrev and returns only a string." (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) )) ) @@ -1975,9 +1673,9 @@ If there are no more entries it tries cdabbrev and returns only a string." (defun completion-search-peek (use-cdabbrev) "Returns the next completion entry without actually moving the pointers. -Calling this again or calling completion-search-next will result in the same -string being returned. Depends on case-fold-search. -If there are no more entries it tries cdabbrev and then returns only a string." +Calling this again or calling `completion-search-next' results in the same +string being returned. Depends on `case-fold-search'. +If there are no more entries, try cdabbrev and then return only a string." (cond ;; return the cached value if we have it (cmpl-next-possibility) @@ -2055,10 +1753,10 @@ If there are no more entries it tries cdabbrev and then returns only a string." ;;;----------------------------------------------- (defun completion-mode () - "Toggles whether or not new words are added to the database." + "Toggles whether or not to add new words to the completion database." (interactive) - (setq *completep* (not *completep*)) - (message "Completion mode is now %s." (if *completep* "ON" "OFF")) + (setq enable-completion (not enable-completion)) + (message "Completion mode is now %s." (if enable-completion "ON" "OFF")) ) (defvar cmpl-current-index 0) @@ -2067,15 +1765,14 @@ If there are no more entries it tries cdabbrev and then returns only a string." (defvar cmpl-leave-point-at-start nil) (defun complete (&optional arg) - "Inserts a completion at point. -Point is left at end. Consective calls rotate through all possibilities. + "Fill out a completion of the word before point. +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. a number :: rotate through the possible completions by that amount `-' :: same as -1 (insert previous completion) - {See the comments at the top of completion.el for more info.} -" + {See the comments at the top of `completion.el' for more info.}" (interactive "*p") ;;; Set up variables (cond ((eq last-command this-command) @@ -2098,8 +1795,8 @@ Prefix args :: (setq cmpl-original-string (symbol-before-point-for-complete)) (cond ((not cmpl-original-string) (setq this-command 'failed-complete) - (error "To complete, the point must be after a symbol at least %d character long." - *completion-prefix-min-length*))) + (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)) ;; statistics @@ -2114,7 +1811,7 @@ Prefix args :: ;; point is at the point to insert the new symbol ;; Get the next completion (let* ((print-status-p - (and (>= (cmpl19-baud-rate) *print-next-completion-speed-threshold*) + (and (>= baud-rate completion-prompt-speed-threshold) (not (minibuffer-window-selected-p)))) (insert-point (point)) (entry (completion-search-next cmpl-current-index)) @@ -2149,10 +1846,10 @@ Prefix args :: ((and print-status-p ;; This updates the display and only prints if there ;; is no typeahead - (cmpl19-sit-for 0) + (sit-for 0) (setq entry (completion-search-peek - *print-next-completion-does-cdabbrev-search-p*))) + completion-cdabbrev-prompt-flag))) (setq string (if (stringp entry) entry (completion-string entry))) (setq string (cmpl-merge-string-cases @@ -2165,7 +1862,9 @@ Prefix args :: ;; 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 @@ -2179,20 +1878,9 @@ Prefix args :: ;;; "Complete" Key Keybindings ;;;----------------------------------------------- -;;; Complete key definition -;;; These define c-return and meta-return -;;; In any case you really want to bind this to a single keystroke -(if (fboundp 'key-for-others-chord) - (condition-case e - ;; this can fail if some of the prefix chars. are already used - ;; as commands (this happens on wyses) - (global-set-key (key-for-others-chord "return" '(control)) 'complete) - (error) - )) -(if (fboundp 'gmacs-keycode) - (global-set-key (gmacs-keycode "return" '(control)) 'complete) - ) (global-set-key "\M-\r" 'complete) +(global-set-key [?\C-\r] 'complete) +(define-key function-key-map [C-return] [?\C-\r]) ;;; Tests - ;;; (add-completion "cumberland") @@ -2213,27 +1901,22 @@ Prefix args :: ;;; User interface (defun add-completions-from-file (file) - "Parses all the definition names from a Lisp mode file and adds them to the -completion database." + "Parse possible completions from a file and add them to data base." (interactive "fFile: ") - (setq file (if (fboundp 'expand-file-name-defaulting) - (expand-file-name-defaulting file) - (expand-file-name file))) + (setq file (expand-file-name file)) (let* ((buffer (get-file-buffer file)) (buffer-already-there-p buffer) ) - (when (not buffer-already-there-p) - (let ((*modes-for-completion-find-file-hook* nil)) - (setq buffer (find-file-noselect file)) - )) + (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) @@ -2252,7 +1935,7 @@ completion database." (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 @@ -2264,19 +1947,19 @@ completion database." ;;; Find file hook (defun cmpl-find-file-hook () - (cond (*completep* + (cond (enable-completion (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) - (memq 'lisp *modes-for-completion-find-file-hook*) + (memq 'lisp completions-merging-modes) ) (add-completions-from-buffer)) ((and (memq major-mode '(c-mode)) - (memq 'c *modes-for-completion-find-file-hook*) + (memq 'c completions-merging-modes) ) (add-completions-from-buffer) ))) )) -(pushnew 'cmpl-find-file-hook find-file-hooks) +(add-hook 'find-file-hooks 'cmpl-find-file-hook) ;;;----------------------------------------------- ;;; Tags Table Completions @@ -2284,7 +1967,7 @@ completion database." (defun add-completions-from-tags-table () ;; Inspired by eero@media-lab.media.mit.edu - "Add completions from the current tags-table-buffer." + "Add completions from the current tags table." (interactive) (visit-tags-table-buffer) ;this will prompt if no tags-table (save-excursion @@ -2322,9 +2005,9 @@ completion database." ;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 ;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 +;;; Parses all the definition names from a Lisp mode buffer and adds them to +;;; the completion database. (defun add-completions-from-lisp-buffer () - "Parses all the definition names from a Lisp mode buffer and adds them to -the completion database." ;;; Benchmarks ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second (let (string) @@ -2353,23 +2036,25 @@ the completion database." ;;; 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 make-c-def-completion-syntax-table () - (let ((table (make-vector 256 0)) +(defun cmpl-make-c-def-completion-syntax-table () + (let ((table (make-syntax-table)) (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) @@ -2377,7 +2062,7 @@ the completion database." (modify-syntax-entry ?\} "){" table) table)) -(defconst cmpl-c-def-syntax-table (make-c-def-completion-syntax-table)) +(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) ;;; Regexps (defconst *c-def-regexp* @@ -2417,9 +2102,9 @@ the completion database." ;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 ;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil +;;; Parses all the definition names from a C mode buffer and adds them to the +;;; completion database. (defun add-completions-from-c-buffer () - "Parses all the definition names from a C mode buffer and adds them to the -completion database." ;; Benchmark -- ;; Sun 3/280-- 1250 lines/sec. @@ -2501,13 +2186,13 @@ completion database." ) (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) )) )) @@ -2519,16 +2204,19 @@ completion database." ;;; Init files ;;;--------------------------------------------------------------------------- +;;; The version of save-completions-to-file called at kill-emacs time. (defun kill-emacs-save-completions () - "The version of save-completions-to-file called at kill-emacs time." - (when (and *save-completions-p* *completep* cmpl-initialized-p) - (cond - ((not cmpl-completions-accepted-p) - (message "Completions database has not changed - not writing.")) - (t - (save-completions-to-file) - )) - )) + (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. @@ -2537,231 +2225,231 @@ completion database." ;;; is the completion ;;; is the time the completion was last used ;;; If it is t, the completion will never be pruned from the file. -;;; Otherwise it is in hours since 1900. +;;; Otherwise it is in hours since origin. \n") (defun completion-backup-filename (filename) (concat filename ".BAK")) (defun save-completions-to-file (&optional filename) - "Saves a completion init file. -If file is not specified, then *saved-completions-filename* is used." + "Save completions in init file FILENAME. +If file name is not specified, use `save-completions-file-name'." (interactive) - (setq filename (expand-file-name (or filename *saved-completions-filename*))) - (when (file-writable-p filename) - (if (not cmpl-initialized-p) - (initialize-completions));; make sure everything's loaded - (message "Saving completions to file %s" filename) - - (let* ((trim-versions-without-asking t) - (kept-old-versions 0) - (kept-new-versions *completion-file-versions-kept*) - last-use-time - (current-time (cmpl-hours-since-1900)) - (total-in-db 0) - (total-perm 0) - (total-saved 0) - (backup-filename (completion-backup-filename filename)) - ) + (setq filename (expand-file-name (or filename save-completions-file-name))) + (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 - ;; *saved-completion-retention-time* is nil - (or (not *saved-completion-retention-time*) - ;; or time since last use is < ...retention-time* - (< (- current-time last-use-time) - *saved-completion-retention-time*)) - ))) - ;; write to file - (setq total-saved (1+ total-saved)) - (insert (prin1-to-string (cons (completion-string completion) - last-use-time)) "\n") - ))) + (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-p* *completep* cmpl-initialized-p - *completion-auto-save-period* - (> cmpl-emacs-idle-time *completion-auto-save-period*) - cmpl-completions-accepted-p) - (save-completions-to-file) - )) +;;;(defun autosave-completions () +;;; (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. -If file is not specified, then *saved-completions-filename* is used." + "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 *saved-completions-filename*))) + (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)) ) - (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-1900)) - string num-uses entry last-use-time - cmpl-entry cmpl-last-use-time - (current-completion-source cmpl-source-init-file) - (start-num - (cmpl-statistics-block - (aref completion-add-count-vector cmpl-source-file-parsing))) - (total-in-file 0) (total-perm 0) - ) - ;; insert the file into a buffer - (condition-case e - (progn (insert-file-contents filename t) - (setq insert-okay-p t)) - - (file-error - (message "File error trying to load completion file %s." - filename))) - ;; parse it - (when insert-okay-p - (goto-char (point-min)) - - (condition-case e - (while t - (setq entry (read buffer)) - (setq total-in-file (1+ total-in-file)) - (cond - ((and (consp entry) - (stringp (setq string (car entry))) - (cond - ((eq (setq last-use-time (cdr entry)) 'T) - ;; handle case sensitivity - (setq total-perm (1+ total-perm)) - (setq last-use-time t)) - ((eq last-use-time t) - (setq total-perm (1+ total-perm))) - ((integerp last-use-time)) - )) - ;; Valid entry - ;; add it in - (setq cmpl-last-use-time - (completion-last-use-time - (setq cmpl-entry - (add-completion-to-tail-if-new string)) - )) - (if (or (eq last-use-time t) - (and (> last-use-time 1000);;backcompatibility - (not (eq cmpl-last-use-time t)) - (or (not cmpl-last-use-time) - ;; more recent - (> last-use-time cmpl-last-use-time)) + (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 () - "Loads the default completions file. + "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) )) - (init-cmpl-emacs-idle-process) (setq cmpl-initialized-p t) ) @@ -2770,25 +2458,17 @@ Also sets up so that exiting emacs will automatically save the file." ;;; Kill EMACS patch ;;;----------------------------------------------- -(completion-advise kill-emacs :before - ;; | All completion code should go in here - ;;\ / - (kill-emacs-save-completions) - ;;/ \ - ;; | All completion code should go in here - (cmpl-statistics-block - (record-cmpl-kill-emacs)) - ) - +(add-hook 'kill-emacs-hook + '(lambda () + (kill-emacs-save-completions) + (cmpl-statistics-block + (record-cmpl-kill-emacs)))) ;;;----------------------------------------------- ;;; Kill region patch ;;;----------------------------------------------- -;;; Patched to remove the most recent completion -(defvar $$$cmpl-old-kill-region (symbol-function 'kill-region)) - -(defun kill-region (&optional beg end) +(defun completion-kill-region (&optional beg end) "Kill between point and mark. The text is deleted but saved in the kill ring. The command \\[yank] can retrieve it from there. @@ -2802,34 +2482,30 @@ If the previous command was also a kill command, the text killed this time appends to the text killed last time to make one entry in the kill ring. Patched to remove the most recent completion." - (interactive "*") - (cond ((and (eq last-command 'complete) (eq last-command-char ?\C-w)) + (interactive "r") + (cond ((eq last-command 'complete) (delete-region (point) cmpl-last-insert-location) (insert cmpl-original-string) (setq completion-to-accept nil) (cmpl-statistics-block - (record-complete-failed)) - ) + (record-complete-failed))) (t - (if (not beg) - (setq beg (min (point) (mark)) - end (max (point) (mark))) - ) - (funcall $$$cmpl-old-kill-region beg end) - ))) + (kill-region beg end)))) +(global-set-key "\C-w" 'completion-kill-region) + ;;;----------------------------------------------- ;;; 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") @@ -2841,8 +2517,7 @@ Patched to remove the most recent completion." (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)) ) @@ -2856,33 +2531,48 @@ Patched to remove the most recent completion." (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." - (completion-advise-1 - function-name ':before - (ecase type - (:before '((use-completion-before-point))) - (:separator '((use-completion-before-separator))) - (:under '((use-completion-under-point))) - (:under-or-before - '((use-completion-under-or-before-point))) - (:minibuffer-separator - '((let ((cmpl-syntax-table cmpl-standard-syntax-table)) - (use-completion-before-separator)))) - ) - new-name - )) - -;;;(defun foo (x y z) (+ x y z)) -;;;foo -;;;(macroexpand '(def-completion-wrapper foo :under)) -;;;(progn (defvar $$$cmpl-foo (symbol-function (quote foo))) (defun foo (&rest arglist) (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-foo arglist))) -;;;(defun bar (x y z) "Documentation" (+ x y z)) -;;;bar -;;;(macroexpand '(def-completion-wrapper bar :under)) -;;;(progn (defvar $$$cmpl-bar (symbol-function (quote bar))) (defun bar (&rest arglist) "Documentation" (progn (use-completion-under-point)) (cmpl-apply-as-top-level $$$cmpl-bar arglist))) -;;;(defun quuz (x &optional y z) "Documentation" (interactive "P") (+ x y z)) -;;;quuz -;;;(macroexpand '(def-completion-wrapper quuz :before)) -;;;(progn (defvar $$$cmpl-quuz (symbol-function (quote quuz))) (defun quuz (&rest arglist) "Documentation" (interactive) (progn (use-completion-before-point)) (cmpl-apply-as-top-level $$$cmpl-quuz arglist))) + (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)) + (use-completion-before-separator))) + +(defun use-completion-backward-under () + (use-completion-under-point) + (if (eq last-command 'complete) + ;; probably a failed completion if you have to back up + (cmpl-statistics-block (record-complete-failed)))) + +(defun use-completion-backward () + (if (eq last-command 'complete) + ;; probably a failed completion if you have to back up + (cmpl-statistics-block (record-complete-failed)))) + +(defun completion-before-command () + (funcall (or (and (symbolp this-command) + (get this-command 'completion-function)) + 'use-completion-under-or-before-point))) +(add-hook 'pre-command-hook 'completion-before-command) ;;;--------------------------------------------------------------------------- @@ -2934,10 +2624,15 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (define-key lisp-mode-map "^" 'self-insert-command) ;;; C mode diffs. -(def-completion-wrapper electric-c-semi :separator) -(define-key c-mode-map "+" 'completion-separator-self-insert-command) -(define-key c-mode-map "*" 'completion-separator-self-insert-command) -(define-key c-mode-map "/" 'completion-separator-self-insert-command) +(defun completion-c-mode-hook () + (def-completion-wrapper electric-c-semi :separator) + (define-key c-mode-map "+" 'completion-separator-self-insert-command) + (define-key c-mode-map "*" 'completion-separator-self-insert-command) + (define-key c-mode-map "/" 'completion-separator-self-insert-command)) +;; Do this either now or whenever C mode is loaded. +(if (featurep 'cc-mode) + (completion-c-mode-hook) + (add-hook 'c-mode-hook 'completion-c-mode-hook)) ;;; FORTRAN mode diffs. (these are defined when fortran is called) (defun completion-setup-fortran-mode () @@ -2952,8 +2647,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." ;;;----------------------------------------------- (def-completion-wrapper newline :separator) (def-completion-wrapper newline-and-indent :separator) -(if (function-defined-and-loaded 'shell-send-input) - (def-completion-wrapper shell-send-input :separator)) +(def-completion-wrapper comint-send-input :separator) (def-completion-wrapper exit-minibuffer :minibuffer-separator) (def-completion-wrapper eval-print-last-sexp :separator) (def-completion-wrapper eval-last-sexp :separator) @@ -2967,150 +2661,17 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (def-completion-wrapper previous-line :under-or-before) (def-completion-wrapper beginning-of-buffer :under-or-before) (def-completion-wrapper end-of-buffer :under-or-before) - -;; we patch these explicitly so they byte compile and so we don't have to -;; patch the faster underlying function. - -(defun cmpl-beginning-of-line (&optional n) - "Move point to beginning of current line.\n\ -With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\ -If scan reaches end of buffer, stop there without error." - (interactive "p") - (use-completion-under-or-before-point) - (beginning-of-line n) - ) - -(defun cmpl-end-of-line (&optional n) - "Move point to end of current line.\n\ -With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\ -If scan reaches end of buffer, stop there without error." - (interactive "p") - (use-completion-under-or-before-point) - (end-of-line n) - ) - -(defun cmpl-forward-char (n) - "Move point right ARG characters (left if ARG negative).\n\ -On reaching end of buffer, stop and signal error." - (interactive "p") - (use-completion-under-or-before-point) - (forward-char n) - ) -(defun cmpl-backward-char (n) - "Move point left ARG characters (right if ARG negative).\n\ -On attempt to pass beginning or end of buffer, stop and signal error." - (interactive "p") - (use-completion-under-point) - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed))) - (backward-char n) - ) - -(defun cmpl-forward-word (n) - "Move point forward ARG words (backward if ARG is negative).\n\ -Normally returns t.\n\ -If an edge of the buffer is reached, point is left there\n\ -and nil is returned." - (interactive "p") - (use-completion-under-or-before-point) - (forward-word n) - ) -(defun cmpl-backward-word (n) - "Move backward until encountering the end of a word. -With argument, do this that many times. -In programs, it is faster to call forward-word with negative arg." - (interactive "p") - (use-completion-under-point) - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed))) - (forward-word (- n)) - ) - -(defun cmpl-forward-sexp (n) - "Move forward across one balanced expression. -With argument, do this that many times." - (interactive "p") - (use-completion-under-or-before-point) - (forward-sexp n) - ) -(defun cmpl-backward-sexp (n) - "Move backward across one balanced expression. -With argument, do this that many times." - (interactive "p") - (use-completion-under-point) - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed))) - (backward-sexp n) - ) - -(defun cmpl-delete-backward-char (n killflag) - "Delete the previous ARG characters (following, with negative ARG).\n\ -Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\ -Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\ -ARG was explicitly specified." - (interactive "p\nP") - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed))) - (delete-backward-char n killflag) - ) - -(defvar $$$cmpl-old-backward-delete-char-untabify - (symbol-function 'backward-delete-char-untabify)) - -(defun backward-delete-char-untabify (arg &optional killp) - "Delete characters backward, changing tabs into spaces. -Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. -Interactively, ARG is the prefix arg (default 1) -and KILLP is t if prefix arg is was specified." - (interactive "*p\nP") - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed))) - (funcall $$$cmpl-old-backward-delete-char-untabify arg killp) - ) - - -(global-set-key "\C-?" 'cmpl-delete-backward-char) -(global-set-key "\M-\C-F" 'cmpl-forward-sexp) -(global-set-key "\M-\C-B" 'cmpl-backward-sexp) -(global-set-key "\M-F" 'cmpl-forward-word) -(global-set-key "\M-B" 'cmpl-backward-word) -(global-set-key "\C-F" 'cmpl-forward-char) -(global-set-key "\C-B" 'cmpl-backward-char) -(global-set-key "\C-A" 'cmpl-beginning-of-line) -(global-set-key "\C-E" 'cmpl-end-of-line) - -;;;----------------------------------------------- -;;; Misc. -;;;----------------------------------------------- - -(def-completion-wrapper electric-buffer-list :under-or-before) -(def-completion-wrapper list-buffers :under-or-before) -(def-completion-wrapper scroll-up :under-or-before) -(def-completion-wrapper scroll-down :under-or-before) -(def-completion-wrapper execute-extended-command - :under-or-before) -(def-completion-wrapper other-window :under-or-before) - -;;;----------------------------------------------- -;;; Local Thinking Machines stuff -;;;----------------------------------------------- - -(if (fboundp 'up-ten-lines) - (def-completion-wrapper up-ten-lines :under-or-before)) -(if (fboundp 'down-ten-lines) - (def-completion-wrapper down-ten-lines :under-or-before)) -(if (fboundp 'tmc-scroll-up) - (def-completion-wrapper tmc-scroll-up :under-or-before)) -(if (fboundp 'tmc-scroll-down) - (def-completion-wrapper tmc-scroll-down :under-or-before)) -(if (fboundp 'execute-extended-command-and-check-for-bindings) - (def-completion-wrapper execute-extended-command-and-check-for-bindings - :under-or-before)) +(def-completion-wrapper beginning-of-line :under-or-before) +(def-completion-wrapper end-of-line :under-or-before) +(def-completion-wrapper forward-char :under-or-before) +(def-completion-wrapper forward-word :under-or-before) +(def-completion-wrapper forward-sexp :under-or-before) +(def-completion-wrapper backward-char :backward-under) +(def-completion-wrapper backward-word :backward-under) +(def-completion-wrapper backward-sexp :backward-under) + +(def-completion-wrapper delete-backward-char :backward) +(def-completion-wrapper delete-backward-char-untabify :backward) ;;; Tests -- ;;; foobarbiz