X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/32cbe528134c463bbcaba89cb362f00e57b1e0c9..5180cc015e2cca6f8cb635044ac4643cf83276cb:/lisp/completion.el diff --git a/lisp/completion.el b/lisp/completion.el index eabc2f0b85..152f72cab3 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -1,10 +1,11 @@ ;;; completion.el --- dynamic word-completion code -;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. + +;; Copyright (C) 1990, 1993, 1995, 1997 Free Software Foundation, Inc. ;; Maintainer: FSF -;; Keywords: abbrev -;; Author: Jim Salem and Brewster Kahle -;; of Thinking Machines Inc. +;; Keywords: abbrev convenience +;; Author: Jim Salem of Thinking Machines Inc. +;; (ideas suggested by Brewster Kahle) ;; This file is part of GNU Emacs. @@ -19,309 +20,335 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: -;;; -;;; What to put in .emacs -;;;----------------------- -;;; (load "completion") -;;; (initialize-completions) + +;; What to put in .emacs +;;----------------------- +;; (dynamic-completion-mode) -;;;--------------------------------------------------------------------------- -;;; Documentation [Slightly out of date] -;;;--------------------------------------------------------------------------- -;;; (also check the documentation string of the functions) -;;; -;;; Introduction -;;;--------------- -;;; -;;; After you type a few characters, pressing the "complete" key inserts -;;; the rest of the word you are likely to type. -;;; -;;; This watches all the words that you type and remembers them. When -;;; typing a new word, pressing "complete" (meta-return) "completes" the -;;; word by inserting the most recently used word that begins with the -;;; same characters. If you press meta-return repeatedly, it cycles -;;; through all the words it knows about. -;;; -;;; If you like the completion then just continue typing, it is as if you -;;; entered the text by hand. If you want the inserted extra characters -;;; to go away, type control-w or delete. More options are described below. -;;; -;;; The guesses are made in the order of the most recently "used". Typing -;;; in a word and then typing a separator character (such as a space) "uses" -;;; the word. So does moving a cursor over the word. If no words are found, -;;; it uses an extended version of the dabbrev style completion. -;;; -;;; You automatically save the completions you use to a file between -;;; sessions. -;;; -;;; Completion enables programmers to enter longer, more descriptive -;;; variable names while typing fewer keystrokes than they normally would. -;;; -;;; -;;; Full documentation -;;;--------------------- -;;; -;;; A "word" is any string containing characters with either word or symbol -;;; syntax. [E.G. Any alphanumeric string with 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 noticeably faster). -;;; -;;; M-X completion-mode toggles whether or not new words are added to the -;;; database by changing the value of enable-completion. -;;; -;;; SAVING/LOADING COMPLETIONS -;;; Completions are automatically saved from one session to another -;;; (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 -;;; completions that you -;;; often use. When you next start, EMACS loads in the saved completion file. -;;; -;;; The number of completions saved depends loosely on -;;; *saved-completions-decay-factor*. Completions that have never been -;;; inserted via "complete" are not saved. You are encouraged to experiment -;;; with different functions (see compute-completion-min-num-uses). -;;; -;;; Some completions are permanent and are always saved out. These -;;; completions have their num-uses slot set to T. Use -;;; add-permanent-completion to do this -;;; -;;; Completions are saved only if enable-completion is T. The number of old -;;; versions kept of the saved completions file is controlled by -;;; completions-file-versions-kept. -;;; -;;; COMPLETE KEY OPTIONS -;;; The complete function takes a numeric arguments. -;;; control-u :: leave the point at the beginning of the completion rather -;;; than the middle. -;;; a number :: rotate through the possible completions by that amount -;;; `-' :: same as -1 (insert previous completion) -;;; -;;; HOW THE DATABASE IS MAINTAINED -;;; -;;; -;;; UPDATING THE DATABASE MANUALLY -;;; m-x kill-completion -;;; kills the completion at point. -;;; m-x add-completion -;;; m-x add-permanent-completion -;;; -;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE -;;; m-x add-completions-from-buffer -;;; Parses all the definition names from a C or LISP mode buffer and -;;; adds them to the completion database. -;;; -;;; m-x add-completions-from-lisp-file -;;; Parses all the definition names from a C or Lisp mode file and -;;; adds them to the completion database. -;;; -;;; UPDATING THE DATABASE FROM A TAGS TABLE -;;; m-x add-completions-from-tags-table -;;; Adds completions from the current tags-table-buffer. -;;; -;;; HOW A COMPLETION IS FOUND -;;; -;;; -;;; STRING CASING -;;; Completion is string case independent if case-fold-search has its -;;; normal default of T. Also when the completion is inserted the case of the -;;; entry is coerced appropriately. -;;; [E.G. APP --> APPROPRIATELY app --> appropriately -;;; App --> Appropriately] -;;; -;;; INITIALIZATION -;;; The form `(initialize-completions)' initializes the completion system by -;;; trying to load in the user's completions. After the first cal, further -;;; calls have no effect so one should be careful not to put the form in a -;;; site's standard site-init file. -;;; -;;;--------------------------------------------------------------------------- -;;; -;;; +;;--------------------------------------------------------------------------- +;; Documentation [Slightly out of date] +;;--------------------------------------------------------------------------- +;; (also check the documentation string of the functions) +;; +;; Introduction +;;--------------- +;; +;; After you type a few characters, pressing the "complete" key inserts +;; the rest of the word you are likely to type. +;; +;; This watches all the words that you type and remembers them. When +;; typing a new word, pressing "complete" (meta-return) "completes" the +;; word by inserting the most recently used word that begins with the +;; same characters. If you press meta-return repeatedly, it cycles +;; through all the words it knows about. +;; +;; If you like the completion then just continue typing, it is as if you +;; entered the text by hand. If you want the inserted extra characters +;; to go away, type control-w or delete. More options are described below. +;; +;; The guesses are made in the order of the most recently "used". Typing +;; in a word and then typing a separator character (such as a space) "uses" +;; the word. So does moving a cursor over the word. If no words are found, +;; it uses an extended version of the dabbrev style completion. +;; +;; You automatically save the completions you use to a file between +;; sessions. +;; +;; Completion enables programmers to enter longer, more descriptive +;; variable names while typing fewer keystrokes than they normally would. +;; +;; +;; Full documentation +;;--------------------- +;; +;; A "word" is any string containing characters with either word or symbol +;; syntax. [E.G. Any alphanumeric string with 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 noticeably faster). +;; +;; M-X completion-mode toggles whether or not new words are added to the +;; database by changing the value of enable-completion. +;; +;; SAVING/LOADING COMPLETIONS +;; Completions are automatically saved from one session to another +;; (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 +;; completions that you +;; often use. When you next start, EMACS loads in the saved completion file. +;; +;; The number of completions saved depends loosely on +;; *saved-completions-decay-factor*. Completions that have never been +;; inserted via "complete" are not saved. You are encouraged to experiment +;; with different functions (see compute-completion-min-num-uses). +;; +;; Some completions are permanent and are always saved out. These +;; completions have their num-uses slot set to T. Use +;; add-permanent-completion to do this +;; +;; Completions are saved only if enable-completion is T. The number of old +;; versions kept of the saved completions file is controlled by +;; completions-file-versions-kept. +;; +;; COMPLETE KEY OPTIONS +;; The complete function takes a numeric arguments. +;; control-u :: leave the point at the beginning of the completion rather +;; than the middle. +;; a number :: rotate through the possible completions by that amount +;; `-' :: same as -1 (insert previous completion) +;; +;; HOW THE DATABASE IS MAINTAINED +;; +;; +;; UPDATING THE DATABASE MANUALLY +;; m-x kill-completion +;; kills the completion at point. +;; m-x add-completion +;; m-x add-permanent-completion +;; +;; UPDATING THE DATABASE FROM A SOURCE CODE FILE +;; m-x add-completions-from-buffer +;; Parses all the definition names from a C or LISP mode buffer and +;; adds them to the completion database. +;; +;; m-x add-completions-from-lisp-file +;; Parses all the definition names from a C or Lisp mode file and +;; adds them to the completion database. +;; +;; UPDATING THE DATABASE FROM A TAGS TABLE +;; m-x add-completions-from-tags-table +;; Adds completions from the current tags-table-buffer. +;; +;; HOW A COMPLETION IS FOUND +;; +;; +;; STRING CASING +;; Completion is string case independent if case-fold-search has its +;; normal default of T. Also when the completion is inserted the case of the +;; entry is coerced appropriately. +;; [E.G. APP --> APPROPRIATELY app --> appropriately +;; App --> Appropriately] +;; +;; INITIALIZATION +;; The form `(initialize-completions)' initializes the completion system by +;; trying to load in the user's completions. After the first cal, further +;; calls have no effect so one should be careful not to put the form in a +;; site's standard site-init file. +;; +;;--------------------------------------------------------------------------- +;; +;; -;;;--------------------------------------------------------------------------- -;;; Functions you might like to call -;;;--------------------------------------------------------------------------- -;;; -;;; add-completion string &optional num-uses -;;; Adds a new string to the database -;;; -;;; add-permanent-completion string -;;; Adds a new string to the database with num-uses = T -;;; - -;;; kill-completion string -;;; Kills the completion from the database. -;;; -;;; clear-all-completions -;;; Clears the database -;;; -;;; list-all-completions -;;; Returns a list of all completions. -;;; -;;; -;;; next-completion string &optional index -;;; Returns a completion entry that starts with string. -;;; -;;; find-exact-completion string -;;; Returns a completion entry that exactly matches string. -;;; -;;; complete -;;; Inserts a completion at point -;;; -;;; initialize-completions -;;; Loads the completions file and sets up so that exiting emacs will -;;; save them. -;;; -;;; save-completions-to-file &optional filename -;;; load-completions-from-file &optional filename -;;; -;;;----------------------------------------------- -;;; Other functions -;;;----------------------------------------------- -;;; -;;; get-completion-list string -;;; -;;; These things are for manipulating the structure -;;; make-completion string num-uses -;;; completion-num-uses completion -;;; completion-string completion -;;; set-completion-num-uses completion num-uses -;;; set-completion-string completion string -;;; -;;; +;;--------------------------------------------------------------------------- +;; Functions you might like to call +;;--------------------------------------------------------------------------- +;; +;; add-completion string &optional num-uses +;; Adds a new string to the database +;; +;; add-permanent-completion string +;; Adds a new string to the database with num-uses = T +;; + +;; kill-completion string +;; Kills the completion from the database. +;; +;; clear-all-completions +;; Clears the database +;; +;; list-all-completions +;; Returns a list of all completions. +;; +;; +;; next-completion string &optional index +;; Returns a completion entry that starts with string. +;; +;; find-exact-completion string +;; Returns a completion entry that exactly matches string. +;; +;; complete +;; Inserts a completion at point +;; +;; initialize-completions +;; Loads the completions file and sets up so that exiting emacs will +;; save them. +;; +;; save-completions-to-file &optional filename +;; load-completions-from-file &optional filename +;; +;;----------------------------------------------- +;; Other functions +;;----------------------------------------------- +;; +;; get-completion-list string +;; +;; These things are for manipulating the structure +;; make-completion string num-uses +;; completion-num-uses completion +;; completion-string completion +;; set-completion-num-uses completion num-uses +;; set-completion-string completion string +;; +;; -;;;----------------------------------------------- -;;; To Do :: (anybody ?) -;;;----------------------------------------------- -;;; -;;; Implement Lookup and keyboard interface in C -;;; Add package prefix smarts (for Common Lisp) -;;; Add autoprompting of possible completions after every keystroke (fast -;;; terminals only !) -;;; Add doc. to texinfo -;;; -;;; -;;;----------------------------------------------- +;;----------------------------------------------- +;; To Do :: (anybody ?) +;;----------------------------------------------- +;; +;; Implement Lookup and keyboard interface in C +;; Add package prefix smarts (for Common Lisp) +;; Add autoprompting of possible completions after every keystroke (fast +;; terminals only !) +;; Add doc. to texinfo +;; +;; +;;----------------------------------------------- ;;; Change Log: -;;;----------------------------------------------- -;;; Sometime in '84 Brewster implemented a somewhat buggy version for -;;; Symbolics LISPMs. -;;; Jan. '85 Jim became enamored of the idea and implemented a faster, -;;; more robust version. -;;; With input from many users at TMC, (rose, craig, and gls come to mind), -;;; the current style of interface was developed. -;;; 9/87, Jim and Brewster took terminals home. Yuck. After -;;; complaining for a while Brewester implemented a subset of the current -;;; LISPM version for GNU Emacs. -;;; 8/88 After complaining for a while (and with sufficient -;;; promised rewards), Jim reimplemented a version of GNU completion -;;; superior to that of the LISPM version. -;;; -;;;----------------------------------------------- -;;; Acknowledgements -;;;----------------------------------------------- -;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), -;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, -;;; -;;;----------------------------------------------- -;;; Change Log -;;;----------------------------------------------- -;;; From version 9 to 10 -;;; - Allowance for non-integral *completion-version* nos. -;;; - Fix cmpl-apply-as-top-level for keyboard macros -;;; - Fix broken completion merging (in save-completions-to-file) -;;; - More misc. fixes for version 19.0 of emacs -;;; -;;; From Version 8 to 9 -;;; - Ported to version 19.0 of emacs (backcompatible with version 18) -;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) -;;; -;;; From Version 7 to 8 -;;; - Misc. changes to comments -;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e -;;; - cdabbrev now checks all the visible window buffers and the "other buffer" -;;; - `%' is now a symbol character rather than a separator (except in C mode) -;;; -;;; From Version 6 to 7 -;;; - Fixed bug with saving out .completion file the first time -;;; -;;; From Version 5 to 6 -;;; - removed statistics recording -;;; - reworked advise to handle autoloads -;;; - Fixed fortran mode support -;;; - Added new cursor motion triggers -;;; -;;; From Version 4 to 5 -;;; - doesn't bother saving if nothing has changed -;;; - auto-save if haven't used for a 1/2 hour -;;; - save period extended to two weeks -;;; - minor fix to capitalization code -;;; - added *completion-auto-save-period* to variables recorded. -;;; - added reenter protection to cmpl-record-statistics-filter -;;; - added backup protection to save-completions-to-file (prevents -;;; problems with disk full errors) +;;----------------------------------------------- +;; Sometime in '84 Brewster implemented a somewhat buggy version for +;; Symbolics LISPMs. +;; Jan. '85 Jim became enamored of the idea and implemented a faster, +;; more robust version. +;; With input from many users at TMC, (rose, craig, and gls come to mind), +;; the current style of interface was developed. +;; 9/87, Jim and Brewster took terminals home. Yuck. After +;; complaining for a while Brewster implemented a subset of the current +;; LISPM version for GNU Emacs. +;; 8/88 After complaining for a while (and with sufficient +;; promised rewards), Jim reimplemented a version of GNU completion +;; superior to that of the LISPM version. +;; +;;----------------------------------------------- +;; Acknowledgements +;;----------------------------------------------- +;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), +;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, +;; +;;----------------------------------------------- +;; Change Log +;;----------------------------------------------- +;; From version 9 to 10 +;; - Allowance for non-integral *completion-version* nos. +;; - Fix cmpl-apply-as-top-level for keyboard macros +;; - Fix broken completion merging (in save-completions-to-file) +;; - More misc. fixes for version 19.0 of emacs +;; +;; From Version 8 to 9 +;; - Ported to version 19.0 of emacs (backcompatible with version 18) +;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) +;; +;; From Version 7 to 8 +;; - Misc. changes to comments +;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e +;; - cdabbrev now checks all the visible window buffers and the "other buffer" +;; - `%' is now a symbol character rather than a separator (except in C mode) +;; +;; From Version 6 to 7 +;; - Fixed bug with saving out .completion file the first time +;; +;; From Version 5 to 6 +;; - removed statistics recording +;; - reworked advise to handle autoloads +;; - Fixed fortran mode support +;; - Added new cursor motion triggers +;; +;; From Version 4 to 5 +;; - doesn't bother saving if nothing has changed +;; - auto-save if haven't used for a 1/2 hour +;; - save period extended to two weeks +;; - minor fix to capitalization code +;; - added *completion-auto-save-period* to variables recorded. +;; - added reenter protection to cmpl-record-statistics-filter +;; - added backup protection to save-completions-to-file (prevents +;; problems with disk full errors) ;;; Code: -;;;--------------------------------------------------------------------------- -;;; User changeable parameters -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; User changeable parameters +;;--------------------------------------------------------------------------- + +(defgroup completion nil + "Dynamic word-completion code." + :group 'matching + :group 'convenience) -(defvar enable-completion t + +(defcustom enable-completion t "*Non-nil means enable recording and saving of completions. -If nil, no new words added to the database or saved to the init file.") +If nil, no new words are added to the database or saved to the init file." + :type 'boolean + :group 'completion) -(defvar save-completions-flag t +(defcustom save-completions-flag t "*Non-nil means save most-used completions when exiting Emacs. -See also `saved-completions-retention-time'.") +See also `save-completions-retention-time'." + :type 'boolean + :group 'completion) -(defvar save-completions-file-name "~/.completions" - "*The filename to save completions to.") +(defcustom save-completions-file-name (convert-standard-filename "~/.completions") + "*The filename to save completions to." + :type 'file + :group 'completion) -(defvar save-completions-retention-time 336 +(defcustom 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.") +will not be saved unless these are used. Default is two weeks." + :type 'integer + :group 'completion) -(defvar completion-on-separator-character nil +(defcustom 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.") +This means the word will be saved as a completion." + :type 'boolean + :group 'completion) -(defvar completions-file-versions-kept kept-new-versions - "*Number of versions to keep for the saved completions file.") +(defcustom completions-file-versions-kept kept-new-versions + "*Number of versions to keep for the saved completions file." + :type 'integer + :group 'completion) -(defvar completion-prompt-speed-threshold 4800 - "*Minimum output speed at which to display next potential completion.") +(defcustom completion-prompt-speed-threshold 4800 + "*Minimum output speed at which to display next potential completion." + :type 'integer + :group 'completion) -(defvar completion-cdabbrev-prompt-flag nil +(defcustom completion-cdabbrev-prompt-flag nil "*If non-nil, the next completion prompt does a cdabbrev search. -This can be time consuming.") +This can be time consuming." + :type 'boolean + :group 'completion) -(defvar completion-search-distance 15000 +(defcustom 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.") +In number of characters. If nil, search the whole buffer." + :type 'integer + :group 'completion) -(defvar completions-merging-modes '(lisp c) +(defcustom 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.") +are automatically added to the completion database." + :type '(set (const lisp) (const c)) + :group 'completion) -;;;(defvar *record-cmpl-statistics-p* nil -;;; "*If non-nil, record completion statistics.") +;;(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 "*The minimum length of a stored completion. @@ -348,13 +375,10 @@ DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (setq completion-prefix-min-length 3))) (completion-eval-when) - -;; Need this file around too -(require 'cl) -;;;--------------------------------------------------------------------------- -;;; Internal Variables -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; Internal Variables +;;--------------------------------------------------------------------------- (defvar cmpl-initialized-p nil "Set to t when the completion system is initialized. @@ -364,14 +388,17 @@ Indicates that the old completion file has been read in.") "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 -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; Low level tools +;;--------------------------------------------------------------------------- -;;;----------------------------------------------- -;;; Misc. -;;;----------------------------------------------- +;;----------------------------------------------- +;; Misc. +;;----------------------------------------------- (defun minibuffer-window-selected-p () "True iff the current window is the minibuffer." @@ -381,169 +408,165 @@ Used to decide whether to save completions.") (defmacro cmpl-read-time-eval (form) form) -;;;----------------------------------------------- -;;; String case coercion -;;;----------------------------------------------- +;;----------------------------------------------- +;; String case coercion +;;----------------------------------------------- (defun cmpl-string-case-type (string) - "Returns :capitalized, :up, :down, :mixed, or :neither." + "Return :capitalized, :up, :down, :mixed, or :neither for case of STRING." (let ((case-fold-search nil)) - (cond ((string-match "[a-z]" string) - (cond ((string-match "[A-Z]" string) + (cond ((string-match "[[:lower:]]" string) + (cond ((string-match "[[:upper:]]" string) (cond ((and (> (length string) 1) - (null (string-match "[A-Z]" string 1))) - ':capitalized) + (null (string-match "[[:upper:]]" string 1))) + :capitalized) (t - ':mixed))) - (t ':down))) + :mixed))) + (t :down))) (t - (cond ((string-match "[A-Z]" string) - ':up) - (t ':neither)))) - )) + (cond ((string-match "[[:upper:]]" string) + :up) + (t :neither)))))) -;;; Tests - -;;; (cmpl-string-case-type "123ABCDEF456") --> :up -;;; (cmpl-string-case-type "123abcdef456") --> :down -;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed -;;; (cmpl-string-case-type "123456") --> :neither -;;; (cmpl-string-case-type "Abcde123") --> :capitalized +;; Tests - +;; (cmpl-string-case-type "123ABCDEF456") --> :up +;; (cmpl-string-case-type "123abcdef456") --> :down +;; (cmpl-string-case-type "123aBcDeF456") --> :mixed +;; (cmpl-string-case-type "123456") --> :neither +;; (cmpl-string-case-type "Abcde123") --> :capitalized (defun cmpl-coerce-string-case (string case-type) - (cond ((eq case-type ':down) (downcase string)) - ((eq case-type ':up) (upcase string)) - ((eq case-type ':capitalized) + (cond ((eq case-type :down) (downcase string)) + ((eq case-type :up) (upcase string)) + ((eq case-type :capitalized) (setq string (downcase string)) (aset string 0 (logand ?\337 (aref string 0))) string) - (t string) - )) + (t string))) (defun cmpl-merge-string-cases (string-to-coerce given-string) - (let ((string-case-type (cmpl-string-case-type string-to-coerce)) - ) + (let ((string-case-type (cmpl-string-case-type string-to-coerce))) (cond ((memq string-case-type '(:down :up :capitalized)) ;; Found string is in a standard case. Coerce to a type based on ;; the given string (cmpl-coerce-string-case string-to-coerce - (cmpl-string-case-type given-string)) - ) + (cmpl-string-case-type given-string))) (t ;; If the found string is in some unusual case, just insert it ;; as is - string-to-coerce) - ))) + string-to-coerce)))) -;;; Tests - -;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 -;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 -;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 -;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 +;; Tests - +;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 +;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 +;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 +;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 (defun cmpl-hours-since-origin () (let ((time (current-time))) - (truncate - (+ (* (/ (car time) 3600.0) (lsh 1 16)) - (/ (nth 2 time) 3600.0))))) + (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600))) -;;;--------------------------------------------------------------------------- -;;; "Symbol" parsing functions -;;;--------------------------------------------------------------------------- -;;; The functions symbol-before-point, symbol-under-point, etc. quickly return -;;; an appropriate symbol string. The strategy is to temporarily change -;;; the syntax table to enable fast symbol searching. There are three classes -;;; of syntax in these "symbol" syntax tables :: -;;; -;;; syntax (?_) - "symbol" chars (e.g. alphanumerics) -;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). -;;; syntax (? ) - everything else -;;; -;;; Thus by judicious use of scan-sexps and forward-word, we can get -;;; the word we want relatively fast and without consing. -;;; -;;; Why do we need a separate category for "symbol chars to ignore at ends" ? -;;; For example, in LISP we want starting :'s trimmed -;;; so keyword argument specifiers also define the keyword completion. And, -;;; for example, in C we want `.' appearing in a structure ref. to -;;; be kept intact in order to store the whole structure ref.; however, if -;;; it appears at the end of a symbol it should be discarded because it is -;;; probably used as a period. - -;;; Here is the default completion syntax :: -;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % -;;; Symbol chars to ignore at ends :: _ : . - -;;; Separator chars. :: ! ^ & ( ) = ` | { } [ ] ; " ' # -;;; , ? - -;;; Mode specific differences and notes :: -;;; LISP diffs -> -;;; Symbol chars :: ! & ? = ^ -;;; -;;; C diffs -> -;;; Separator chars :: + * / : % -;;; 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. -;;; -;;; FORTRAN diffs -> -;;; Separator chars :: + - * / : -;;; -;;; Pathname diffs -> -;;; Symbol chars :: . -;;; Of course there is no pathname "mode" and in fact we have not implemented -;;; this table. However, if there was such a mode, this is what it would look -;;; like. - -;;;----------------------------------------------- -;;; Table definitions -;;;----------------------------------------------- +;;--------------------------------------------------------------------------- +;; "Symbol" parsing functions +;;--------------------------------------------------------------------------- +;; The functions symbol-before-point, symbol-under-point, etc. quickly return +;; an appropriate symbol string. The strategy is to temporarily change +;; the syntax table to enable fast symbol searching. There are three classes +;; of syntax in these "symbol" syntax tables :: +;; +;; syntax (?_) - "symbol" chars (e.g. alphanumerics) +;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). +;; syntax (? ) - everything else +;; +;; Thus by judicious use of scan-sexps and forward-word, we can get +;; the word we want relatively fast and without consing. +;; +;; Why do we need a separate category for "symbol chars to ignore at ends" ? +;; For example, in LISP we want starting :'s trimmed +;; so keyword argument specifiers also define the keyword completion. And, +;; for example, in C we want `.' appearing in a structure ref. to +;; be kept intact in order to store the whole structure ref.; however, if +;; it appears at the end of a symbol it should be discarded because it is +;; probably used as a period. + +;; Here is the default completion syntax :: +;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % +;; Symbol chars to ignore at ends :: _ : . - +;; Separator chars. :: ! ^ & ( ) = ` | { } [ ] ; " ' # +;; , ? + +;; Mode specific differences and notes :: +;; LISP diffs -> +;; Symbol chars :: ! & ? = ^ +;; +;; C diffs -> +;; Separator chars :: + * / : % +;; 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. +;; +;; FORTRAN diffs -> +;; Separator chars :: + - * / : +;; +;; Pathname diffs -> +;; Symbol chars :: . +;; Of course there is no pathname "mode" and in fact we have not implemented +;; this table. However, if there was such a mode, this is what it would look +;; like. + +;;----------------------------------------------- +;; Table definitions +;;----------------------------------------------- (defun cmpl-make-standard-completion-syntax-table () - (let ((table (make-vector 256 0)) ;; default syntax is whitespace - ) + (let ((table (make-syntax-table)) + i) + ;; Default syntax is whitespace. + (setq i 0) + (while (< i 256) + (modify-syntax-entry i " " table) + (setq i (1+ 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 '(?_ ?- ?: ?.)) - ) + (symbol-chars-ignore '(?_ ?- ?: ?.))) (dolist (char symbol-chars) (modify-syntax-entry char "_" table)) (dolist (char symbol-chars-ignore) - (modify-syntax-entry char "w" table) - ) - ) + (modify-syntax-entry char "w" table))) table)) (defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) (defun cmpl-make-lisp-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (symbol-chars '(?! ?& ?? ?= ?^)) - ) + (symbol-chars '(?! ?& ?? ?= ?^))) (dolist (char symbol-chars) (modify-syntax-entry char "_" table)) table)) (defun cmpl-make-c-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?* ?/ ?: ?%)) - ) + (separator-chars '(?+ ?* ?/ ?: ?%))) (dolist (char separator-chars) (modify-syntax-entry char " " table)) table)) (defun cmpl-make-fortran-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?- ?* ?/ ?:)) - ) + (separator-chars '(?+ ?- ?* ?/ ?:))) (dolist (char separator-chars) (modify-syntax-entry char " " table)) table)) @@ -556,32 +579,15 @@ Used to decide whether to save completions.") "This variable holds the current completion syntax table.") (make-variable-buffer-local 'cmpl-syntax-table) -;;;----------------------------------------------- -;;; Installing the appropriate mode tables -;;;----------------------------------------------- - -(add-hook 'lisp-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-lisp-syntax-table))) - -(add-hook 'c-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-c-syntax-table))) - -(add-hook 'fortran-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-fortran-syntax-table) - (completion-setup-fortran-mode))) - -;;;----------------------------------------------- -;;; Symbol functions -;;;----------------------------------------------- +;;----------------------------------------------- +;; Symbol functions +;;----------------------------------------------- (defvar cmpl-symbol-start nil "Holds first character of symbol, after any completion symbol function.") (defvar cmpl-symbol-end nil "Holds last character of symbol, after any completion symbol function.") -;;; These are temp. vars. we use to avoid using let. -;;; Why ? Small speed improvement. +;; These are temp. vars. we use to avoid using let. +;; Why ? Small speed improvement. (defvar cmpl-saved-syntax nil) (defvar cmpl-saved-point nil) @@ -589,138 +595,123 @@ Used to decide whether to save completions.") "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 - ;; Cursor is on following-char and after preceding-char - ((memq (char-syntax (following-char)) '(?w ?_)) - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) - cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-saved-point) - )) - ;; remove chars to ignore at the end - (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) - (goto-char cmpl-symbol-end) - (forward-word -1) - (setq cmpl-symbol-end (point)) - (goto-char cmpl-saved-point) - )) - ;; restore state - (set-syntax-table cmpl-saved-syntax) - ;; Return completion if the length is reasonable - (if (and (<= (cmpl-read-time-eval completion-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)) - ) - (t - ;; restore table if no symbol - (set-syntax-table cmpl-saved-syntax) - nil) - )) - -;;; tests for symbol-under-point -;;; `^' indicates cursor pos. where value is returned -;;; simple-word-test -;;; ^^^^^^^^^^^^^^^^ --> simple-word-test -;;; _harder_word_test_ -;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test -;;; .___.______. -;;; --> nil -;;; /foo/bar/quux.hello -;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello -;;; + (unwind-protect + (progn + (set-syntax-table cmpl-syntax-table) + (cond + ;; Cursor is on following-char and after preceding-char + ((memq (char-syntax (following-char)) '(?w ?_)) + (setq cmpl-saved-point (point) + cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) + cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char cmpl-saved-point))) + ;; Remove chars to ignore at the end. + (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) + (goto-char cmpl-symbol-end) + (forward-word -1) + (setq cmpl-symbol-end (point)) + (goto-char cmpl-saved-point))) + ;; Return completion if the length is reasonable. + (if (and (<= (cmpl-read-time-eval completion-min-length) + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + (cmpl-read-time-eval completion-max-length))) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) + (set-syntax-table cmpl-saved-syntax))) + +;; tests for symbol-under-point +;; `^' indicates cursor pos. where value is returned +;; simple-word-test +;; ^^^^^^^^^^^^^^^^ --> simple-word-test +;; _harder_word_test_ +;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test +;; .___.______. +;; --> nil +;; /foo/bar/quux.hello +;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello +;; (defun symbol-before-point () "Returns a string of the symbol immediately before point. 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) - ;; Cursor is on following-char and after preceding-char - (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) - ;; No chars. to ignore at end - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) - ) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end) - )) - ;; restore state - (set-syntax-table cmpl-saved-syntax) - ;; return value if long enough - (if (>= cmpl-symbol-end - (+ cmpl-symbol-start - (cmpl-read-time-eval completion-min-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)) - ) - ((= cmpl-preceding-syntax ?w) - ;; chars to ignore at end - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)) - ;; take off chars. from end - (forward-word -1) - (setq cmpl-symbol-end (point)) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - )) - ;; restore state - (goto-char cmpl-saved-point) - (set-syntax-table cmpl-saved-syntax) - ;; Return completion if the length is reasonable - (if (and (<= (cmpl-read-time-eval completion-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)) - ) - (t - ;; restore table if no symbol - (set-syntax-table cmpl-saved-syntax) - nil) - )) - -;;; tests for symbol-before-point -;;; `^' indicates cursor pos. where value is returned -;;; simple-word-test -;;; ^ --> nil -;;; ^ --> nil -;;; ^ --> simple-w -;;; ^ --> simple-word-test -;;; _harder_word_test_ -;;; ^ --> harder_word_test -;;; ^ --> harder_word_test -;;; ^ --> harder -;;; .___.... -;;; --> nil + (unwind-protect + (progn + (set-syntax-table cmpl-syntax-table) + ;; Cursor is on following-char and after preceding-char + (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) + ;; Number of chars to ignore at end. + (setq cmpl-symbol-end (point) + cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char cmpl-symbol-end))) + ;; Return value if long enough. + (if (>= cmpl-symbol-end + (+ cmpl-symbol-start + (cmpl-read-time-eval completion-min-length))) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))) + ((= cmpl-preceding-syntax ?w) + ;; chars to ignore at end + (setq cmpl-saved-point (point) + cmpl-symbol-start (scan-sexps cmpl-saved-point -1)) + ;; take off chars. from end + (forward-word -1) + (setq cmpl-symbol-end (point)) + ;; remove chars to ignore at the start + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)))) + ;; Restore state. + (goto-char cmpl-saved-point) + ;; Return completion if the length is reasonable + (if (and (<= (cmpl-read-time-eval completion-min-length) + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + (cmpl-read-time-eval completion-max-length))) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) + (set-syntax-table cmpl-saved-syntax))) + +;; tests for symbol-before-point +;; `^' indicates cursor pos. where value is returned +;; simple-word-test +;; ^ --> nil +;; ^ --> nil +;; ^ --> simple-w +;; ^ --> simple-word-test +;; _harder_word_test_ +;; ^ --> harder_word_test +;; ^ --> harder_word_test +;; ^ --> harder +;; .___.... +;; --> nil (defun symbol-under-or-before-point () - ;;; This could be made slightly faster but it is better to avoid - ;;; copying all the code. - ;;; However, it is only used by the completion string prompter. - ;;; If it comes into common use, it could be rewritten. - (setq cmpl-saved-syntax (syntax-table)) - (set-syntax-table cmpl-syntax-table) - (cond ((memq (char-syntax (following-char)) '(?w ?_)) - (set-syntax-table cmpl-saved-syntax) + ;; This could be made slightly faster but it is better to avoid + ;; copying all the code. + ;; However, it is only used by the completion string prompter. + ;; If it comes into common use, it could be rewritten. + (cond ((memq (progn + (setq cmpl-saved-syntax (syntax-table)) + (unwind-protect + (progn + (set-syntax-table cmpl-syntax-table) + (char-syntax (following-char))) + (set-syntax-table cmpl-saved-syntax))) + '(?w ?_)) (symbol-under-point)) (t - (set-syntax-table cmpl-saved-syntax) - (symbol-before-point)) - )) + (symbol-before-point)))) (defun symbol-before-point-for-complete () @@ -729,71 +720,65 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; end chars." ;; Cursor is on following-char and after preceding-char (setq cmpl-saved-syntax (syntax-table)) - (set-syntax-table cmpl-syntax-table) - (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) - '(?_ ?w)) - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) - ) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end) - )) - ;; restore state - (set-syntax-table cmpl-saved-syntax) - ;; Return completion if the length is reasonable - (if (and (<= (cmpl-read-time-eval - completion-prefix-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)) - ) - (t - ;; restore table if no symbol - (set-syntax-table cmpl-saved-syntax) - nil) - )) - -;;; tests for symbol-before-point-for-complete -;;; `^' indicates cursor pos. where value is returned -;;; simple-word-test -;;; ^ --> nil -;;; ^ --> nil -;;; ^ --> simple-w -;;; ^ --> simple-word-test -;;; _harder_word_test_ -;;; ^ --> harder_word_test -;;; ^ --> harder_word_test_ -;;; ^ --> harder_ -;;; .___.... -;;; --> nil + (unwind-protect + (progn + (set-syntax-table cmpl-syntax-table) + (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) + '(?_ ?w)) + (setq cmpl-symbol-end (point) + cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char cmpl-symbol-end))) + ;; Return completion if the length is reasonable. + (if (and (<= (cmpl-read-time-eval + completion-prefix-min-length) + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + (cmpl-read-time-eval completion-max-length))) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) + ;; Restore syntax table. + (set-syntax-table cmpl-saved-syntax))) + +;; tests for symbol-before-point-for-complete +;; `^' indicates cursor pos. where value is returned +;; simple-word-test +;; ^ --> nil +;; ^ --> nil +;; ^ --> simple-w +;; ^ --> simple-word-test +;; _harder_word_test_ +;; ^ --> harder_word_test +;; ^ --> harder_word_test_ +;; ^ --> harder_ +;; .___.... +;; --> nil -;;;--------------------------------------------------------------------------- -;;; Statistics Recording -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; Statistics Recording +;;--------------------------------------------------------------------------- -;;; Note that the guts of this has been turned off. The guts -;;; are in completion-stats.el. +;; Note that the guts of this has been turned off. The guts +;; are in completion-stats.el. -;;;----------------------------------------------- -;;; Conditionalizing code on *record-cmpl-statistics-p* -;;;----------------------------------------------- -;;; All statistics code outside this block should use this +;;----------------------------------------------- +;; 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) -;;; )) +;; "Only executes body if we are recording statistics." +;; (list 'cond +;; (list* '*record-cmpl-statistics-p* body) +;; )) -;;;----------------------------------------------- -;;; Completion Sources -;;;----------------------------------------------- +;;----------------------------------------------- +;; Completion Sources +;;----------------------------------------------- ;; ID numbers (defconst cmpl-source-unknown 0) @@ -808,42 +793,43 @@ Returns nil if there isn't one longer than `completion-min-length'." -;;;--------------------------------------------------------------------------- -;;; Completion Method #2: dabbrev-expand style -;;;--------------------------------------------------------------------------- -;;; -;;; This method is used if there are no useful stored completions. It is -;;; based on dabbrev-expand with these differences : -;;; 1) Faster (we don't use regexps) -;;; 2) case coercion handled correctly -;;; This is called cdabbrev to differentiate it. -;;; We simply search backwards through the file looking for words which -;;; start with the same letters we are trying to complete. -;;; +;;--------------------------------------------------------------------------- +;; Completion Method #2: dabbrev-expand style +;;--------------------------------------------------------------------------- +;; +;; This method is used if there are no useful stored completions. It is +;; based on dabbrev-expand with these differences : +;; 1) Faster (we don't use regexps) +;; 2) case coercion handled correctly +;; This is called cdabbrev to differentiate it. +;; We simply search backwards through the file looking for words which +;; start with the same letters we are trying to complete. +;; (defvar cdabbrev-completions-tried nil) -;;; "A list of all the cdabbrev completions since the last reset.") +;; "A list of all the cdabbrev completions since the last reset.") (defvar cdabbrev-current-point 0) -;;; "The current point position the cdabbrev search is at.") +;; "The current point position the cdabbrev search is at.") (defvar cdabbrev-current-window nil) -;;; "The current window we are looking for cdabbrevs in. T if looking in -;;; (other-buffer), NIL if no more cdabbrevs.") +;; "The current window we are looking for cdabbrevs in. +;; Return t if looking in (other-buffer), nil if no more cdabbrevs.") (defvar cdabbrev-wrapped-p nil) -;;; "T if the cdabbrev search has wrapped around the file.") +;; "Return t if the cdabbrev search has wrapped around the file.") (defvar cdabbrev-abbrev-string "") (defvar cdabbrev-start-point 0) +(defvar cdabbrev-stop-point) -;;; Test strings for cdabbrev -;;; cdat-upcase ;;same namestring -;;; CDAT-UPCASE ;;ok -;;; cdat2 ;;too short -;;; cdat-1-2-3-4 ;;ok -;;; a-cdat-1 ;;doesn't start correctly -;;; cdat-simple ;;ok +;; Test strings for cdabbrev +;; cdat-upcase ;;same namestring +;; CDAT-UPCASE ;;ok +;; cdat2 ;;too short +;; cdat-1-2-3-4 ;;ok +;; a-cdat-1 ;;doesn't start correctly +;; cdat-simple ;;ok (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) @@ -852,25 +838,21 @@ INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore during the search." (setq cdabbrev-abbrev-string abbrev-string cdabbrev-completions-tried - (cons (downcase abbrev-string) initial-completions-tried) - ) - (reset-cdabbrev-window t) - ) + (cons (downcase abbrev-string) initial-completions-tried)) + (reset-cdabbrev-window t)) (defun set-cdabbrev-buffer () ;; cdabbrev-current-window must not be NIL (set-buffer (if (eq cdabbrev-current-window t) (other-buffer) - (window-buffer cdabbrev-current-window))) - ) + (window-buffer cdabbrev-current-window)))) (defun reset-cdabbrev-window (&optional initializep) "Resets the cdabbrev search to search for abbrev-string." ;; Set the window (cond (initializep - (setq cdabbrev-current-window (selected-window)) - ) + (setq cdabbrev-current-window (selected-window))) ((eq cdabbrev-current-window t) ;; Everything has failed (setq cdabbrev-current-window nil)) @@ -878,20 +860,18 @@ during the search." (setq cdabbrev-current-window (next-window cdabbrev-current-window)) (if (eq cdabbrev-current-window (selected-window)) ;; No more windows, try other buffer. - (setq cdabbrev-current-window t))) - ) - (when cdabbrev-current-window - (save-excursion - (set-cdabbrev-buffer) - (setq cdabbrev-current-point (point) - cdabbrev-start-point cdabbrev-current-point - cdabbrev-stop-point - (if completion-search-distance - (max (point-min) - (- cdabbrev-start-point completion-search-distance)) - (point-min)) - cdabbrev-wrapped-p nil) - ))) + (setq cdabbrev-current-window t)))) + (if cdabbrev-current-window + (save-excursion + (set-cdabbrev-buffer) + (setq cdabbrev-current-point (point) + cdabbrev-start-point cdabbrev-current-point + cdabbrev-stop-point + (if completion-search-distance + (max (point-min) + (- cdabbrev-start-point completion-search-distance)) + (point-min)) + cdabbrev-wrapped-p nil)))) (defun next-cdabbrev () "Return the next possible cdabbrev expansion or nil if there isn't one. @@ -899,119 +879,112 @@ during the search." 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))) - ))) - -;;; The following must be eval'd in the minibuffer :: -;;; (reset-cdabbrev "cdat") -;;; (next-cdabbrev) --> "cdat-simple" -;;; (next-cdabbrev) --> "cdat-1-2-3-4" -;;; (next-cdabbrev) --> "CDAT-UPCASE" -;;; (next-cdabbrev) --> "cdat-wrapping" -;;; (next-cdabbrev) --> "cdat_start_sym" -;;; (next-cdabbrev) --> nil -;;; (next-cdabbrev) --> nil -;;; (next-cdabbrev) --> nil - -;;; _cdat_start_sym -;;; cdat-wrapping + (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") +;; (next-cdabbrev) --> "cdat-simple" +;; (next-cdabbrev) --> "cdat-1-2-3-4" +;; (next-cdabbrev) --> "CDAT-UPCASE" +;; (next-cdabbrev) --> "cdat-wrapping" +;; (next-cdabbrev) --> "cdat_start_sym" +;; (next-cdabbrev) --> nil +;; (next-cdabbrev) --> nil +;; (next-cdabbrev) --> nil + +;; _cdat_start_sym +;; cdat-wrapping -;;;--------------------------------------------------------------------------- -;;; Completion Database -;;;--------------------------------------------------------------------------- - -;;; We use two storage modes for the two search types :: -;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions -;;; Used by search-completion-next -;;; the value of the symbol is nil or a cons of head and tail pointers -;;; 2) Interning {cmpl-obarray} to see if it's in the database -;;; Used by find-exact-completion, completion-in-database-p -;;; The value of the symbol is the completion entry - -;;; bad things may happen if this length is changed due to the way -;;; GNU implements obarrays +;;--------------------------------------------------------------------------- +;; Completion Database +;;--------------------------------------------------------------------------- + +;; We use two storage modes for the two search types :: +;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions +;; Used by search-completion-next +;; the value of the symbol is nil or a cons of head and tail pointers +;; 2) Interning {cmpl-obarray} to see if it's in the database +;; Used by find-exact-completion, completion-in-database-p +;; The value of the symbol is the completion entry + +;; bad things may happen if this length is changed due to the way +;; GNU implements obarrays (defconst cmpl-obarray-length 511) (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) @@ -1022,19 +995,19 @@ Each symbol is bound to a list of completion entries.") "An obarray used to store the downcased completions. Each symbol is bound to a single completion entry.") -;;;----------------------------------------------- -;;; Completion Entry Structure Definition -;;;----------------------------------------------- +;;----------------------------------------------- +;; Completion Entry Structure Definition +;;----------------------------------------------- -;;; A completion entry is a LIST of string, prefix-symbol num-uses, and -;;; last-use-time (the time the completion was last used) -;;; last-use-time is T if the string should be kept permanently -;;; num-uses is incremented everytime the completion is used. +;; A completion entry is a LIST of string, prefix-symbol num-uses, and +;; last-use-time (the time the completion was last used) +;; last-use-time is T if the string should be kept permanently +;; num-uses is incremented every time the completion is used. -;;; We chose lists because (car foo) is faster than (aref foo 0) and the -;;; creation time is about the same. +;; We chose lists because (car foo) is faster than (aref foo 0) and the +;; creation time is about the same. -;;; READER MACROS +;; READER MACROS (defmacro completion-string (completion-entry) (list 'car completion-entry)) @@ -1052,7 +1025,7 @@ Each symbol is bound to a single completion entry.") (defmacro completion-source (completion-entry) (list 'nth 3 completion-entry)) -;;; WRITER MACROS +;; WRITER MACROS (defmacro set-completion-string (completion-entry string) (list 'setcar completion-entry string)) @@ -1062,7 +1035,7 @@ Each symbol is bound to a single completion entry.") (defmacro set-completion-last-use-time (completion-entry last-use-time) (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time)) -;;; CONSTRUCTOR +;; CONSTRUCTOR (defun make-completion (string) "Returns a list of a completion entry." (list (list string 0 nil current-completion-source))) @@ -1073,12 +1046,12 @@ Each symbol is bound to a single completion entry.") -;;;----------------------------------------------- -;;; Prefix symbol entry definition -;;;----------------------------------------------- -;;; A cons of (head . tail) +;;----------------------------------------------- +;; Prefix symbol entry definition +;;----------------------------------------------- +;; A cons of (head . tail) -;;; READER Macros +;; READER Macros (defmacro cmpl-prefix-entry-head (prefix-entry) (list 'car prefix-entry)) @@ -1086,7 +1059,7 @@ Each symbol is bound to a single completion entry.") (defmacro cmpl-prefix-entry-tail (prefix-entry) (list 'cdr prefix-entry)) -;;; WRITER Macros +;; WRITER Macros (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head) (list 'setcar prefix-entry new-head)) @@ -1094,57 +1067,58 @@ 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)) -;;; Constructor +;; Constructor (defun make-cmpl-prefix-entry (completion-entry-list) "Makes a new prefix entry containing only completion-entry." (cons completion-entry-list completion-entry-list)) -;;;----------------------------------------------- -;;; Completion Database - Utilities -;;;----------------------------------------------- +;;----------------------------------------------- +;; Completion Database - Utilities +;;----------------------------------------------- (defun clear-all-completions () - "Initializes the completion storage. All existing completions are lost." + "Initialize the completion storage. All existing completions are lost." (interactive) (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) (cmpl-statistics-block - (record-clear-all-completions)) - ) + (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)) + "Return a list of all the known completion entries." + (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)))) -;;;----------------------------------------------- -;;; Updating the database -;;;----------------------------------------------- -;;; -;;; These are the internal functions used to update the datebase -;;; -;;; +;;----------------------------------------------- +;; Updating the database +;;----------------------------------------------- +;; +;; These are the internal functions used to update the datebase +;; +;; (defvar completion-to-accept nil) ;;"Set to a string that is pending its acceptance." ;; this checked by the top level reading functions @@ -1160,18 +1134,17 @@ Each symbol is bound to a single completion entry.") (defvar cmpl-db-debug-p nil "Set to T if you want to debug the database.") -;;; READS +;; READS (defun find-exact-completion (string) - "Returns the completion entry for string or nil. + "Return the completion entry for STRING or nil. Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'." (and (boundp (setq cmpl-db-symbol (intern (setq cmpl-db-downcase-string (downcase string)) cmpl-obarray))) - (symbol-value cmpl-db-symbol) - )) + (symbol-value cmpl-db-symbol))) (defun find-cmpl-prefix-entry (prefix-string) - "Returns the prefix entry for string. + "Return the prefix entry for string. Sets `cmpl-db-prefix-symbol'. Prefix-string must be exactly `completion-prefix-min-length' long and downcased. Sets up `cmpl-db-prefix-symbol'." @@ -1183,20 +1156,18 @@ and downcased. Sets up `cmpl-db-prefix-symbol'." ;; used to trap lossage in silent error correction (defun locate-completion-entry (completion-entry prefix-entry) - "Locates the completion entry. + "Locate the completion entry. Returns a pointer to the element before the completion entry or nil if the completion entry is at the head. Must be called after `find-exact-completion'." (let ((prefix-list (cmpl-prefix-entry-head prefix-entry)) - next-prefix-list - ) + next-prefix-list) (cond ((not (eq (car prefix-list) completion-entry)) ;; not already at head (while (and prefix-list (not (eq completion-entry - (car (setq next-prefix-list (cdr prefix-list))) - ))) + (car (setq next-prefix-list (cdr prefix-list)))))) (setq prefix-list next-prefix-list)) (cond (;; found prefix-list) @@ -1204,7 +1175,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)) @@ -1212,34 +1183,30 @@ Must be called after `find-exact-completion'." ;; Patch out (set cmpl-db-symbol nil) ;; Retry - (locate-completion-entry-retry completion-entry) - )))))) + (locate-completion-entry-retry completion-entry))))))) (defun locate-completion-entry-retry (old-entry) (let ((inside-locate-completion-entry t)) (add-completion (completion-string old-entry) (completion-num-uses old-entry) (completion-last-use-time old-entry)) - (let ((cmpl-entry (find-exact-completion (completion-string old-entry))) - (pref-entry - (if cmpl-entry - (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string - 0 completion-prefix-min-length)))) - ) + (let* ((cmpl-entry (find-exact-completion (completion-string old-entry))) + (pref-entry + (if cmpl-entry + (find-cmpl-prefix-entry + (substring cmpl-db-downcase-string + 0 completion-prefix-min-length))))) (if (and cmpl-entry pref-entry) ;; try again (locate-completion-entry cmpl-entry pref-entry) ;; still losing - (locate-completion-db-error)) - ))) + (locate-completion-db-error))))) (defun locate-completion-db-error () ;; recursive error: really scrod - (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.") - ) + (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report")) -;;; WRITES +;; WRITES (defun add-completion-to-tail-if-new (string) "If STRING is not in the database add it to appropriate prefix list. STRING is added to the end of the appropriate prefix list with @@ -1255,8 +1222,7 @@ Returns the completion entry." (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 (cmpl-read-time-eval - completion-prefix-min-length)))) - ) + completion-prefix-min-length))))) ;; The next two forms should happen as a unit (atomically) but ;; no fatal errors should result if that is not the case. (cond (prefix-entry @@ -1265,37 +1231,34 @@ Returns the completion entry." (setcdr (cmpl-prefix-entry-tail prefix-entry) entry) (set-cmpl-prefix-entry-tail prefix-entry entry)) (t - (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) - )) + (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)))) ;; statistics (cmpl-statistics-block (note-added-completion)) ;; set symbol - (set cmpl-db-symbol (car entry)) - ))) - -(defun add-completion-to-head (string) - "If STRING is not in the database, add it to prefix list. -STRING is added to the head of the appropriate prefix list. Otherwise -it is moved to the head of the list. -STRING must be longer than `completion-prefix-min-length'. + (set cmpl-db-symbol (car entry))))) + +(defun add-completion-to-head (completion-string) + "If COMPLETION-STRING is not in the database, add it to prefix list. +We add COMPLETION-STRING to the head of the appropriate prefix list, +or it to the head of the list. +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-read-time-eval completion-prefix-min-length)))) (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) - (cmpl-ptr (cdr splice-ptr)) - ) + (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 @@ -1306,46 +1269,41 @@ Returns the completion entry." (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) ;; splice in at head (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) - (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) - )) + (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr))) 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 (cmpl-read-time-eval - completion-prefix-min-length)))) - ) + completion-prefix-min-length))))) (cond (prefix-entry ;; Splice in at head (setcdr entry (cmpl-prefix-entry-head prefix-entry)) (set-cmpl-prefix-entry-head prefix-entry entry)) (t ;; Start new prefix entry - (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) - )) + (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)))) ;; statistics (cmpl-statistics-block (note-added-completion)) ;; Add it to the symbol - (set cmpl-db-symbol (car entry)) - ))) + (set cmpl-db-symbol (car entry))))) -(defun delete-completion (string) - "Deletes the completion from the database. +(defun delete-completion (completion-string) + "Delete the completion from the database. String must be longer than `completion-prefix-min-length'." ;; Handle pending acceptance (if completion-to-accept (accept-completion)) - (if (setq cmpl-db-entry (find-exact-completion 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-read-time-eval completion-prefix-min-length)))) - (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) - ) + (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))) ;; delete symbol reference (set cmpl-db-symbol nil) ;; remove from prefix list @@ -1353,67 +1311,63 @@ String must be longer than `completion-prefix-min-length'." ;; not at head (or (setcdr splice-ptr (cdr (cdr splice-ptr))) ;; fix up tail if necessary - (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) - ) + (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))) (t ;; at head (or (set-cmpl-prefix-entry-head prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry))) ;; List is now empty - (set cmpl-db-prefix-symbol nil)) - )) + (set cmpl-db-prefix-symbol nil)))) (cmpl-statistics-block - (note-completion-deleted)) - ) - (error "Unknown completion: %s. Couldn't delete it." string) - )) - -;;; Tests -- -;;; - Add and Find - -;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;;; (find-exact-completion "banana") --> ("banana" 0 nil 0) -;;; (find-exact-completion "bana") --> nil -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) -;;; (find-exact-completion "banish") --> ("banish" 0 nil 0) -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;;; -;;; - Deleting - -;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;;; (delete-completion "banner") -;;; (find-exact-completion "banner") --> nil -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;;; (delete-completion "banana") -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;;; (delete-completion "banner") -;;; (delete-completion "banish") -;;; (find-cmpl-prefix-entry "ban") --> nil -;;; (delete-completion "banner") --> error -;;; -;;; - Tail - -;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) -;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) -;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) -;;; + (note-completion-deleted))) + (error "Unknown completion `%s'" completion-string))) + +;; Tests -- +;; - Add and Find - +;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) +;; (find-exact-completion "banana") --> ("banana" 0 nil 0) +;; (find-exact-completion "bana") --> nil +;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) +;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) +;; (find-exact-completion "banish") --> ("banish" 0 nil 0) +;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) +;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) +;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) +;; +;; - Deleting - +;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) +;; (delete-completion "banner") +;; (find-exact-completion "banner") --> nil +;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) +;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) +;; (delete-completion "banana") +;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) +;; (delete-completion "banner") +;; (delete-completion "banish") +;; (find-cmpl-prefix-entry "ban") --> nil +;; (delete-completion "banner") --> error +;; +;; - Tail - +;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) +;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) +;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) +;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) +;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) +;; -;;;--------------------------------------------------------------------------- -;;; Database Update :: Interface level routines -;;;--------------------------------------------------------------------------- -;;; -;;; These lie on top of the database ref. functions but below the standard -;;; user interface level +;;--------------------------------------------------------------------------- +;; Database Update :: Interface level routines +;;--------------------------------------------------------------------------- +;; +;; These lie on top of the database ref. functions but below the standard +;; user interface level (defun interactive-completion-string-reader (prompt) @@ -1421,17 +1375,14 @@ String must be longer than `completion-prefix-min-length'." (new-prompt (if default (format "%s: (default: %s) " prompt default) - (format "%s: " prompt)) - ) - (read (completing-read new-prompt cmpl-obarray)) - ) + (format "%s: " prompt))) + (read (completing-read new-prompt cmpl-obarray))) (if (zerop (length read)) (setq read (or default ""))) - (list read) - )) + (list read))) (defun check-completion-length (string) (if (< (length string) completion-min-length) - (error "The string \"%s\" is too short to be saved as a completion." + (error "The string `%s' is too short to be saved as a completion" string) (list string))) @@ -1448,8 +1399,7 @@ specified." (if num-uses (set-completion-num-uses entry num-uses)) (if last-use-time - (set-completion-last-use-time entry last-use-time)) - )) + (set-completion-last-use-time entry last-use-time)))) (defun add-permanent-completion (string) "Add STRING if it isn't already listed, and mark it permanent." @@ -1457,16 +1407,13 @@ specified." (interactive-completion-string-reader "Completion to add permanently")) (let ((current-completion-source (if (interactive-p) cmpl-source-interactive - current-completion-source)) - ) - (add-completion string nil t) - )) + current-completion-source))) + (add-completion string nil t))) (defun kill-completion (string) (interactive (interactive-completion-string-reader "Completion to kill")) (check-completion-length string) - (delete-completion string) - ) + (delete-completion string)) (defun accept-completion () "Accepts the pending completion in `completion-to-accept'. @@ -1475,13 +1422,11 @@ This bumps num-uses. Called by `add-completion-to-head' and (let ((string completion-to-accept) ;; if this is added afresh here, then it must be a cdabbrev (current-completion-source cmpl-source-cdabbrev) - entry - ) + entry) (setq completion-to-accept nil) (setq entry (add-completion-to-head string)) (set-completion-num-uses entry (1+ (completion-num-uses entry))) - (setq cmpl-completions-accepted-p t) - )) + (setq cmpl-completions-accepted-p t))) (defun use-completion-under-point () "Add the completion symbol underneath the point into the completion buffer." @@ -1509,49 +1454,47 @@ Completions added this way will automatically be saved if (current-completion-source cmpl-source-separator) entry) (cmpl-statistics-block - (note-separator-character string) - ) + (note-separator-character 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) - ))) - )) - -;;; Tests -- -;;; - Add and Find - -;;; (add-completion "banana" 5 10) -;;; (find-exact-completion "banana") --> ("banana" 5 10 0) -;;; (add-completion "banana" 6) -;;; (find-exact-completion "banana") --> ("banana" 6 10 0) -;;; (add-completion "banish") -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;;; -;;; - Accepting - -;;; (setq completion-to-accept "banana") -;;; (accept-completion) -;;; (find-exact-completion "banana") --> ("banana" 7 10) -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;;; (setq completion-to-accept "banish") -;;; (add-completion "banner") -;;; (car (find-cmpl-prefix-entry "ban")) -;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) -;;; -;;; - Deleting - -;;; (kill-completion "banish") -;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) + (progn + (set-completion-num-uses entry 1) + (setq cmpl-completions-accepted-p t))))))) + +;; Tests -- +;; - Add and Find - +;; (add-completion "banana" 5 10) +;; (find-exact-completion "banana") --> ("banana" 5 10 0) +;; (add-completion "banana" 6) +;; (find-exact-completion "banana") --> ("banana" 6 10 0) +;; (add-completion "banish") +;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) +;; +;; - Accepting - +;; (setq completion-to-accept "banana") +;; (accept-completion) +;; (find-exact-completion "banana") --> ("banana" 7 10) +;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) +;; (setq completion-to-accept "banish") +;; (add-completion "banner") +;; (car (find-cmpl-prefix-entry "ban")) +;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) +;; +;; - Deleting - +;; (kill-completion "banish") +;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) -;;;--------------------------------------------------------------------------- -;;; Searching the database -;;;--------------------------------------------------------------------------- -;;; Functions outside this block must call completion-search-reset followed -;;; by calls to completion-search-next or completion-search-peek -;;; - -;;; Status variables +;;--------------------------------------------------------------------------- +;; Searching the database +;;--------------------------------------------------------------------------- +;; Functions outside this block must call completion-search-reset followed +;; by calls to completion-search-next or completion-search-peek +;; + +;; Status variables ;; Commented out to improve loading speed (defvar cmpl-test-string "") ;; "The current string used by completion-search-next." @@ -1583,16 +1526,14 @@ STRING must be longer than `completion-prefix-min-length'." (downcase (substring string 0 completion-prefix-min-length)))) cmpl-test-string string cmpl-test-regexp (concat (regexp-quote string) ".")) - (completion-search-reset-1) - ) + (completion-search-reset-1)) (defun completion-search-reset-1 () (setq cmpl-next-possibilities cmpl-starting-possibilities cmpl-next-possibility nil cmpl-cdabbrev-reset-p nil cmpl-last-index -1 - cmpl-tried-list nil - )) + cmpl-tried-list nil)) (defun completion-search-next (index) "Return the next completion entry. @@ -1601,16 +1542,15 @@ 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 cmpl-next-possibility nil) - ) + (< (setq index (1+ index)) 0)) + (setq cmpl-next-possibility nil)) (cond ((not cmpl-next-possibilities)) ;; If no more possibilities, leave it that way ((= -1 cmpl-last-index) @@ -1622,22 +1562,18 @@ If there are no more entries, try cdabbrev and returns only a string." (setq cmpl-next-possibilities (nthcdr (- (length cmpl-starting-possibilities) (length cmpl-next-possibilities)) - cmpl-starting-possibilities)) - ))) + cmpl-starting-possibilities))))) (t ;; non-negative index, reset and search ;;(prin1 'reset) (completion-search-reset-1) (setq cmpl-last-index index) (while (and (completion-search-peek t) - (not (minusp (setq index (1- index))))) - (setq cmpl-next-possibility nil) - )) - ) + (not (< (setq index (1- index)) 0))) + (setq cmpl-next-possibility nil)))) (prog1 cmpl-next-possibility - (setq cmpl-next-possibility nil) - )) + (setq cmpl-next-possibility nil))) (defun completion-search-peek (use-cdabbrev) @@ -1654,79 +1590,73 @@ If there are no more entries, try cdabbrev and then return only a string." (while (and (not (eq 0 (string-match cmpl-test-regexp (completion-string (car cmpl-next-possibilities))))) - (setq cmpl-next-possibilities (cdr cmpl-next-possibilities)) - )) - cmpl-next-possibilities - )) + (setq cmpl-next-possibilities (cdr cmpl-next-possibilities)))) + cmpl-next-possibilities)) ;; successful match (setq cmpl-next-possibility (car cmpl-next-possibilities) cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility)) cmpl-tried-list) - cmpl-next-possibilities (cdr cmpl-next-possibilities) - ) + cmpl-next-possibilities (cdr cmpl-next-possibilities)) cmpl-next-possibility) (use-cdabbrev ;; unsuccessful, use cdabbrev (cond ((not cmpl-cdabbrev-reset-p) (reset-cdabbrev cmpl-test-string cmpl-tried-list) - (setq cmpl-cdabbrev-reset-p t) - )) - (setq cmpl-next-possibility (next-cdabbrev)) - ) + (setq cmpl-cdabbrev-reset-p t))) + (setq cmpl-next-possibility (next-cdabbrev))) ;; Completely unsuccessful, return nil )) -;;; Tests -- -;;; - Add and Find - -;;; (add-completion "banana") -;;; (completion-search-reset "ban") -;;; (completion-search-next 0) --> "banana" -;;; -;;; - Discrimination - -;;; (add-completion "cumberland") -;;; (add-completion "cumberbund") -;;; cumbering -;;; (completion-search-reset "cumb") -;;; (completion-search-peek t) --> "cumberbund" -;;; (completion-search-next 0) --> "cumberbund" -;;; (completion-search-peek t) --> "cumberland" -;;; (completion-search-next 1) --> "cumberland" -;;; (completion-search-peek nil) --> nil -;;; (completion-search-next 2) --> "cumbering" {cdabbrev} -;;; (completion-search-next 3) --> nil or "cumming"{depends on context} -;;; (completion-search-next 1) --> "cumberland" -;;; (completion-search-peek t) --> "cumbering" {cdabbrev} -;;; -;;; - Accepting - -;;; (completion-search-next 1) --> "cumberland" -;;; (setq completion-to-accept "cumberland") -;;; (completion-search-reset "foo") -;;; (completion-search-reset "cum") -;;; (completion-search-next 0) --> "cumberland" -;;; -;;; - Deleting - -;;; (kill-completion "cumberland") -;;; cummings -;;; (completion-search-reset "cum") -;;; (completion-search-next 0) --> "cumberbund" -;;; (completion-search-next 1) --> "cummings" -;;; -;;; - Ignoring Capitalization - -;;; (completion-search-reset "CuMb") -;;; (completion-search-next 0) --> "cumberbund" +;; Tests -- +;; - Add and Find - +;; (add-completion "banana") +;; (completion-search-reset "ban") +;; (completion-search-next 0) --> "banana" +;; +;; - Discrimination - +;; (add-completion "cumberland") +;; (add-completion "cumberbund") +;; cumbering +;; (completion-search-reset "cumb") +;; (completion-search-peek t) --> "cumberbund" +;; (completion-search-next 0) --> "cumberbund" +;; (completion-search-peek t) --> "cumberland" +;; (completion-search-next 1) --> "cumberland" +;; (completion-search-peek nil) --> nil +;; (completion-search-next 2) --> "cumbering" {cdabbrev} +;; (completion-search-next 3) --> nil or "cumming"{depends on context} +;; (completion-search-next 1) --> "cumberland" +;; (completion-search-peek t) --> "cumbering" {cdabbrev} +;; +;; - Accepting - +;; (completion-search-next 1) --> "cumberland" +;; (setq completion-to-accept "cumberland") +;; (completion-search-reset "foo") +;; (completion-search-reset "cum") +;; (completion-search-next 0) --> "cumberland" +;; +;; - Deleting - +;; (kill-completion "cumberland") +;; cummings +;; (completion-search-reset "cum") +;; (completion-search-next 0) --> "cumberbund" +;; (completion-search-next 1) --> "cummings" +;; +;; - Ignoring Capitalization - +;; (completion-search-reset "CuMb") +;; (completion-search-next 0) --> "cumberbund" -;;;----------------------------------------------- -;;; COMPLETE -;;;----------------------------------------------- +;;----------------------------------------------- +;; COMPLETE +;;----------------------------------------------- (defun completion-mode () - "Toggles whether or not to add new words to the completion database." + "Toggle whether or not to add new words to the completion database." (interactive) (setq enable-completion (not enable-completion)) - (message "Completion mode is now %s." (if enable-completion "ON" "OFF")) - ) + (message "Completion mode is now %s." (if enable-completion "ON" "OFF"))) (defvar cmpl-current-index 0) (defvar cmpl-original-string nil) @@ -1748,23 +1678,20 @@ Prefix args :: ;; Undo last one (delete-region cmpl-last-insert-location (point)) ;; get next completion - (setq cmpl-current-index (+ cmpl-current-index (or arg 1))) - ) + (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))) (t (if (not cmpl-initialized-p) (initialize-completions)) ;; make sure everything's loaded (cond ((consp current-prefix-arg) ;; control-u (setq arg 0) - (setq cmpl-leave-point-at-start t) - ) + (setq cmpl-leave-point-at-start t)) (t - (setq cmpl-leave-point-at-start nil) - )) + (setq cmpl-leave-point-at-start nil))) ;; get string (setq cmpl-original-string (symbol-before-point-for-complete)) (cond ((not cmpl-original-string) (setq this-command 'failed-complete) - (error "To complete, the point must be after a symbol at least %d character long." + (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)) @@ -1774,8 +1701,7 @@ Prefix args :: ;; reset database (completion-search-reset cmpl-original-string) ;; erase what we've got - (delete-region cmpl-symbol-start cmpl-symbol-end) - )) + (delete-region cmpl-symbol-start cmpl-symbol-end))) ;; point is at the point to insert the new symbol ;; Get the next completion @@ -1784,8 +1710,7 @@ Prefix args :: (not (minibuffer-window-selected-p)))) (insert-point (point)) (entry (completion-search-next cmpl-current-index)) - string - ) + string) ;; entry is either a completion entry or a string (if cdabbrev) ;; If found, insert @@ -1804,8 +1729,7 @@ Prefix args :: (setq cmpl-last-insert-location (point)) (goto-char insert-point)) (t;; point at end, - (setq cmpl-last-insert-location insert-point)) - ) + (setq cmpl-last-insert-location insert-point))) ;; statistics (cmpl-statistics-block (note-complete-inserted entry cmpl-current-index)) @@ -1823,9 +1747,7 @@ Prefix args :: entry (completion-string entry))) (setq string (cmpl-merge-string-cases string cmpl-original-string)) - (message "Next completion: %s" string) - )) - ) + (message "Next completion: %s" string)))) (t;; none found, insert old (insert cmpl-original-string) ;; Don't accept completions @@ -1840,54 +1762,32 @@ Prefix args :: (cmpl-statistics-block (record-complete-failed cmpl-current-index)) ;; Pretend that we were never here - (setq this-command 'failed-complete) - )))) - -;;;----------------------------------------------- -;;; "Complete" Key Keybindings -;;;----------------------------------------------- - -(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") -;;; (add-completion "cumberbund") -;;; cum -;;; Cumber -;;; cumbering -;;; cumb - + (setq this-command 'failed-complete))))) -;;;--------------------------------------------------------------------------- -;;; Parsing definitions from files into the database -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; Parsing definitions from files into the database +;;--------------------------------------------------------------------------- -;;;----------------------------------------------- -;;; Top Level functions :: -;;;----------------------------------------------- +;;----------------------------------------------- +;; Top Level functions :: +;;----------------------------------------------- -;;; User interface +;; User interface (defun add-completions-from-file (file) - "Parse possible completions from a file and add them to data base." + "Parse possible completions from a FILE and add them to data base." (interactive "fFile: ") (setq file (expand-file-name file)) (let* ((buffer (get-file-buffer file)) - (buffer-already-there-p buffer) - ) - (when (not buffer-already-there-p) - (let ((completions-merging-modes nil)) - (setq buffer (find-file-noselect file)) - )) + (buffer-already-there-p buffer)) + (if (not buffer-already-there-p) + (let ((completions-merging-modes nil)) + (setq buffer (find-file-noselect file)))) (unwind-protect (save-excursion (set-buffer buffer) - (add-completions-from-buffer) - ) - (when (not buffer-already-there-p) - (kill-buffer buffer)) - ))) + (add-completions-from-buffer)) + (if (not buffer-already-there-p) + (kill-buffer buffer))))) (defun add-completions-from-buffer () (interactive) @@ -1895,46 +1795,35 @@ Prefix args :: (start-num (cmpl-statistics-block (aref completion-add-count-vector cmpl-source-file-parsing))) - mode - ) + mode) (cond ((memq major-mode '(emacs-lisp-mode lisp-mode)) (add-completions-from-lisp-buffer) - (setq mode 'lisp) - ) + (setq mode 'lisp)) ((memq major-mode '(c-mode)) (add-completions-from-c-buffer) - (setq mode 'c) - ) + (setq mode 'c)) (t - (error "Do not know how to parse completions in %s buffers." - major-mode) - )) + (error "Cannot parse completions in %s buffers" + major-mode))) (cmpl-statistics-block (record-cmpl-parse-file mode (point-max) (- (aref completion-add-count-vector cmpl-source-file-parsing) - start-num))) - )) + start-num))))) -;;; Find file hook +;; Find file hook (defun cmpl-find-file-hook () (cond (enable-completion (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) - (memq 'lisp completions-merging-modes) - ) + (memq 'lisp completions-merging-modes)) (add-completions-from-buffer)) ((and (memq major-mode '(c-mode)) - (memq 'c completions-merging-modes) - ) - (add-completions-from-buffer) - ))) - )) - -(pushnew 'cmpl-find-file-hook find-file-hooks) + (memq 'c completions-merging-modes)) + (add-completions-from-buffer)))))) -;;;----------------------------------------------- -;;; Tags Table Completions -;;;----------------------------------------------- +;;----------------------------------------------- +;; Tags Table Completions +;;----------------------------------------------- (defun add-completions-from-tags-table () ;; Inspired by eero@media-lab.media.mit.edu @@ -1950,34 +1839,31 @@ Prefix args :: (backward-char 3) (and (setq string (symbol-under-point)) (add-completion-to-tail-if-new string)) - (forward-char 3) - ) - (search-failed) - )))) + (forward-char 3)) + (search-failed))))) -;;;----------------------------------------------- -;;; Lisp File completion parsing -;;;----------------------------------------------- -;;; This merely looks for phrases beginning with (def.... or -;;; (package:def ... and takes the next word. -;;; -;;; We tried using forward-lines and explicit searches but the regexp technique -;;; was faster. (About 100K characters per second) -;;; +;;----------------------------------------------- +;; Lisp File completion parsing +;;----------------------------------------------- +;; This merely looks for phrases beginning with (def.... or +;; (package:def ... and takes the next word. +;; +;; We tried using forward-lines and explicit searches but the regexp technique +;; was faster. (About 100K characters per second) +;; (defconst *lisp-def-regexp* "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" - "A regexp that searches for lisp definition form." - ) + "A regexp that searches for Lisp definition form.") -;;; Tests - -;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 -;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 -;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 -;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 +;; Tests - +;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 +;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 +;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 +;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 -;;; Parses all the definition names from a Lisp mode buffer and adds them to -;;; the completion database. +;; Parses all the definition names from a Lisp mode buffer and adds them to +;; the completion database. (defun add-completions-from-lisp-buffer () ;;; Benchmarks ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second @@ -1988,39 +1874,38 @@ Prefix args :: (while t (re-search-forward *lisp-def-regexp*) (and (setq string (symbol-under-point)) - (add-completion-to-tail-if-new string)) - ) - (search-failed) - )))) + (add-completion-to-tail-if-new string))) + (search-failed))))) -;;;----------------------------------------------- -;;; C file completion parsing -;;;----------------------------------------------- -;;; C : -;;; Looks for #define or [] [] {,} -;;; or structure, array or pointer defs. -;;; It gets most of the definition names. -;;; -;;; As you might suspect by now, we use some symbol table hackery -;;; -;;; Symbol separator chars (have whitespace syntax) --> , ; * = ( -;;; Opening char --> [ { -;;; Closing char --> ] } -;;; opening and closing must be skipped over -;;; Whitespace chars (have symbol syntax) -;;; Everything else has word syntax +;;----------------------------------------------- +;; C file completion parsing +;;----------------------------------------------- +;; C : +;; Looks for #define or [] [] {,} +;; or structure, array or pointer defs. +;; It gets most of the definition names. +;; +;; As you might suspect by now, we use some symbol table hackery +;; +;; Symbol separator chars (have whitespace syntax) --> , ; * = ( +;; Opening char --> [ { +;; Closing char --> ] } +;; 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)) + (let ((table (make-syntax-table)) (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) ;; unfortunately the ?( causes the parens to appear unbalanced - (separator-chars '(?, ?* ?= ?\( ?\; - )) - ) + (separator-chars '(?, ?* ?= ?\( ?\;)) + i) ;; default syntax is whitespace - (dotimes (i 256) - (modify-syntax-entry i "w" table)) + (setq i 0) + (while (< i 256) + (modify-syntax-entry i "w" table) + (setq i (1+ i))) (dolist (char whitespace-chars) (modify-syntax-entry char "_" table)) (dolist (char separator-chars) @@ -2033,7 +1918,7 @@ Prefix args :: (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) -;;; Regexps +;; Regexps (defconst *c-def-regexp* ;; This stops on lines with possible definitions "\n[_a-zA-Z#]" @@ -2043,8 +1928,7 @@ Prefix args :: ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)" ;; this simple version picks up too much extraneous stuff ;; "\n\\(\\w\\|\\s_\\|#\\)\\B" - "A regexp that searches for a definition form." - ) + "A regexp that searches for a definition form.") ; ;(defconst *c-cont-regexp* ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)" @@ -2058,28 +1942,27 @@ Prefix args :: ; (and (eq 0 (string-match regexp string)) (match-end 0)) ; ) -;;; Tests - -;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) -;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) -;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) -;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil -;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 -;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 -;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 -;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil -;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 -;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 -;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil - -;;; Parses all the definition names from a C mode buffer and adds them to the -;;; completion database. +;; Tests - +;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) +;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) +;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) +;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil +;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 +;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 +;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 +;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil +;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 +;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 +;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil + +;; Parses all the definition names from a C mode buffer and adds them to the +;; completion database. (defun add-completions-from-c-buffer () ;; Benchmark -- ;; Sun 3/280-- 1250 lines/sec. (let (string next-point char - (saved-syntax (syntax-table)) - ) + (saved-syntax (syntax-table))) (save-excursion (goto-char (point-min)) (catch 'finish-add-completions @@ -2096,31 +1979,27 @@ Prefix args :: ;; preprocessor macro, see if it's one we handle (setq string (buffer-substring (point) (+ (point) 6))) (cond ((or (string-equal string "define") - (string-equal string "ifdef ") - ) + (string-equal string "ifdef ")) ;; skip forward over definition symbol ;; and add it to database (and (forward-word 2) (setq string (symbol-before-point)) ;;(push string foo) - (add-completion-to-tail-if-new string) - )))) + (add-completion-to-tail-if-new string))))) (t ;; C definition (setq next-point (point)) (while (and next-point ;; scan to next separator char. - (setq next-point (scan-sexps next-point 1)) - ) + (setq next-point (scan-sexps next-point 1))) ;; position the point on the word we want to add (goto-char next-point) (while (= (setq char (following-char)) ?*) ;; handle pointer ref ;; move to next separator char. (goto-char - (setq next-point (scan-sexps (point) 1))) - ) + (setq next-point (scan-sexps (point) 1)))) (forward-word -1) ;; add to database (if (setq string (symbol-under-point)) @@ -2131,11 +2010,8 @@ Prefix args :: (progn (forward-word -1) (setq string - (symbol-under-point)) - )) - (add-completion-to-tail-if-new string) - ) - ) + (symbol-under-point)))) + (add-completion-to-tail-if-new string))) ;; go to next (goto-char next-point) ;; (push (format "%c" (following-char)) foo) @@ -2143,46 +2019,37 @@ Prefix args :: ;; if on an opening delimiter, go to end (while (= (char-syntax char) ?\() (setq next-point (scan-sexps next-point 1) - char (char-after next-point)) - ) + char (char-after next-point))) (or (= char ?,) ;; Current char is an end char. - (setq next-point nil) - )) - )))) + (setq next-point nil))))))) (search-failed ;;done - (throw 'finish-add-completions t) - ) + (throw 'finish-add-completions t)) (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.") - (throw 'finish-add-completions t) - )) - )) - (set-syntax-table saved-syntax) - ))))) + (message "Error parsing C buffer for completions--please send bug report") + (throw 'finish-add-completions t))))) + (set-syntax-table saved-syntax)))))) -;;;--------------------------------------------------------------------------- -;;; Init files -;;;--------------------------------------------------------------------------- +;;--------------------------------------------------------------------------- +;; Init files +;;--------------------------------------------------------------------------- -;;; The version of save-completions-to-file called at kill-emacs time. +;; 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 @@ -2191,12 +2058,12 @@ Prefix args :: (defconst saved-cmpl-file-header ";;; Completion Initialization file. -;;; Version = %s -;;; Format is ( . ) -;;; 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 origin. +;; Version = %s +;; Format is ( . ) +;; 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 origin. \n") (defun completion-backup-filename (filename) @@ -2207,236 +2074,207 @@ Prefix args :: 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* ((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)) - ) + (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)) + (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) -;;; )) +;;(defun auto-save-completions () +;; (if (and save-completions-flag enable-completion cmpl-initialized-p +;; *completion-auto-save-period* +;; (> cmpl-emacs-idle-time *completion-auto-save-period*) +;; cmpl-completions-accepted-p) +;; (save-completions-to-file))) -;;;(pushnew 'autosave-completions cmpl-emacs-idle-time-hooks) +;;(add-hook 'cmpl-emacs-idle-time-hooks 'auto-save-completions) (defun load-completions-from-file (&optional filename no-message-p) - "Loads a completion init file FILENAME. + "Load a completion init file FILENAME. If file is not specified, then use `save-completions-file-name'." (interactive) (setq filename (expand-file-name (or filename save-completions-file-name))) (let* ((backup-filename (completion-backup-filename filename)) - (backup-readable-p (file-readable-p backup-filename)) - ) - (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) + (backup-readable-p (file-readable-p backup-filename))) + (if backup-readable-p (setq filename backup-filename)) + (if (file-readable-p filename) + (progn + (if (not no-message-p) + (message "Loading completions from %sfile %s . . ." + (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)) - )) - ;; update last-use-time - (set-completion-last-use-time cmpl-entry last-use-time) - )) - (t - ;; Bad format - (message "Error: invalid saved completion - %s" - (prin1-to-string entry)) - ;; try to get back in sync - (search-forward "\n(") - ))) - (search-failed - (message "End of file while reading completions.") - ) - (end-of-file - (if (= (point) (point-max)) - (if (not no-message-p) - (message "Loading completions from file %s . . . Done." - filename)) - (message "End of file while reading completions.") - )) - )) - - (cmpl-statistics-block - (record-load-completions - total-in-file total-perm - (- (aref completion-add-count-vector cmpl-source-init-file) - start-num))) - - ))))) + (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)))) + (if (or (eq last-use-time t) + (and (> last-use-time 1000);;backcompatibility + (not (eq cmpl-last-use-time t)) + (or (not cmpl-last-use-time) + ;; more recent + (> last-use-time cmpl-last-use-time)))) + ;; update last-use-time + (set-completion-last-use-time cmpl-entry last-use-time))) + (t + ;; Bad format + (message "Error: invalid saved completion - %s" + (prin1-to-string entry)) + ;; try to get back in sync + (search-forward "\n(")))) + (search-failed + (message "End of file while reading completions.")) + (end-of-file + (if (= (point) (point-max)) + (if (not no-message-p) + (message "Loading completions from file %s . . . Done." + filename)) + (message "End of file while reading completions.")))))) + + (cmpl-statistics-block + (record-load-completions + total-in-file total-perm + (- (aref completion-add-count-vector cmpl-source-init-file) + start-num))) +)))))) (defun initialize-completions () "Load the default completions file. Also sets up so that exiting emacs will automatically save the file." (interactive) (cond ((not cmpl-initialized-p) - (load-completions-from-file) - )) - (setq cmpl-initialized-p t) - ) - - -;;;----------------------------------------------- -;;; Kill EMACS patch -;;;----------------------------------------------- - -(add-hook 'kill-emacs-hook - '(lambda () - (kill-emacs-save-completions) - (cmpl-statistics-block - (record-cmpl-kill-emacs)))) + (load-completions-from-file))) + (setq cmpl-initialized-p t)) -;;;----------------------------------------------- -;;; Kill region patch -;;;----------------------------------------------- +;;----------------------------------------------- +;; Kill region patch +;;----------------------------------------------- (defun completion-kill-region (&optional beg end) "Kill between point and mark. @@ -2462,65 +2300,61 @@ Patched to remove the most recent completion." (t (kill-region beg end)))) -(global-set-key "\C-w" 'completion-kill-region) -;;;----------------------------------------------- -;;; Patches to self-insert-command. -;;;----------------------------------------------- +;;----------------------------------------------- +;; Patches to self-insert-command. +;;----------------------------------------------- -;;; Need 2 versions: generic separator chars. and space (to get auto fill -;;; to work) +;; 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 before point to the completion list (using ADD-COMPLETION). +;; 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 before point to the completion list (using ADD-COMPLETION). (defun completion-separator-self-insert-command (arg) (interactive "p") (use-completion-before-separator) - (self-insert-command arg) - ) + (self-insert-command arg)) (defun completion-separator-self-insert-autofilling (arg) (interactive "p") (use-completion-before-separator) (self-insert-command arg) - (and (> (current-column) fill-column) - auto-fill-function - (funcall auto-fill-function)) - ) + (and auto-fill-function + (funcall auto-fill-function))) -;;;----------------------------------------------- -;;; Wrapping Macro -;;;----------------------------------------------- +;;----------------------------------------------- +;; Wrapping Macro +;;----------------------------------------------- -;;; Note that because of the way byte compiling works, none of -;;; the functions defined with this macro get byte compiled. +;; Note that because of the way byte compiling works, none of +;; the functions defined with this macro get byte compiled. (defmacro def-completion-wrapper (function-name type &optional new-name) "Add a call to update the completion database before function execution. TYPE is the type of the wrapper to be added. Can be :before or :under." - (cond ((eq type ':separator) + (cond ((eq type :separator) (list 'put (list 'quote function-name) ''completion-function ''use-completion-before-separator)) - ((eq type ':before) + ((eq type :before) (list 'put (list 'quote function-name) ''completion-function ''use-completion-before-point)) - ((eq type ':backward-under) + ((eq type :backward-under) (list 'put (list 'quote function-name) ''completion-function ''use-completion-backward-under)) - ((eq type ':backward) + ((eq type :backward) (list 'put (list 'quote function-name) ''completion-function ''use-completion-backward)) - ((eq type ':under) + ((eq type :under) (list 'put (list 'quote function-name) ''completion-function ''use-completion-under-point)) - ((eq type ':under-or-before) + ((eq type :under-or-before) (list 'put (list 'quote function-name) ''completion-function ''use-completion-under-or-before-point)) - ((eq type ':minibuffer-separator) + ((eq type :minibuffer-separator) (list 'put (list 'quote function-name) ''completion-function ''use-completion-minibuffer-separator)))) @@ -2540,111 +2374,168 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (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 'pre-command-hook 'completion-before-command) - - -;;;--------------------------------------------------------------------------- -;;; Patches to standard keymaps insert completions -;;;--------------------------------------------------------------------------- - -;;;----------------------------------------------- -;;; Separators -;;;----------------------------------------------- -;;; We've used the completion syntax table given as a guide. -;;; -;;; Global separator chars. -;;; We left out because there are too many special cases for it. Also, -;;; in normal coding it's rarely typed after a word. -(global-set-key " " 'completion-separator-self-insert-autofilling) -(global-set-key "!" 'completion-separator-self-insert-command) -(global-set-key "%" 'completion-separator-self-insert-command) -(global-set-key "^" 'completion-separator-self-insert-command) -(global-set-key "&" 'completion-separator-self-insert-command) -(global-set-key "(" 'completion-separator-self-insert-command) -(global-set-key ")" 'completion-separator-self-insert-command) -(global-set-key "=" 'completion-separator-self-insert-command) -(global-set-key "`" 'completion-separator-self-insert-command) -(global-set-key "|" 'completion-separator-self-insert-command) -(global-set-key "{" 'completion-separator-self-insert-command) -(global-set-key "}" 'completion-separator-self-insert-command) -(global-set-key "[" 'completion-separator-self-insert-command) -(global-set-key "]" 'completion-separator-self-insert-command) -(global-set-key ";" 'completion-separator-self-insert-command) -(global-set-key "\"" 'completion-separator-self-insert-command) -(global-set-key "'" 'completion-separator-self-insert-command) -(global-set-key "#" 'completion-separator-self-insert-command) -(global-set-key "," 'completion-separator-self-insert-command) -(global-set-key "?" 'completion-separator-self-insert-command) - -;;; We include period and colon even though they are symbol chars because : -;;; - in text we want to pick up the last word in a sentence. -;;; - in C pointer refs. we want to pick up the first symbol -;;; - it won't make a difference for lisp mode (package names are short) -(global-set-key "." 'completion-separator-self-insert-command) -(global-set-key ":" 'completion-separator-self-insert-command) - -;;; Lisp Mode diffs -(define-key lisp-mode-map "!" 'self-insert-command) -(define-key lisp-mode-map "&" 'self-insert-command) -(define-key lisp-mode-map "%" 'self-insert-command) -(define-key lisp-mode-map "?" 'self-insert-command) -(define-key lisp-mode-map "=" 'self-insert-command) -(define-key lisp-mode-map "^" 'self-insert-command) - -;;; C mode diffs. -(def-completion-wrapper electric-c-semi :separator) -(define-key c-mode-map "+" 'completion-separator-self-insert-command) -(define-key c-mode-map "*" 'completion-separator-self-insert-command) -(define-key c-mode-map "/" 'completion-separator-self-insert-command) - -;;; FORTRAN mode diffs. (these are defined when fortran is called) + +;; C mode diffs. +(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 () (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "/" 'completion-separator-self-insert-command) - ) - -;;;----------------------------------------------- -;;; End of line chars. -;;;----------------------------------------------- -(def-completion-wrapper newline :separator) -(def-completion-wrapper newline-and-indent :separator) -(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) -;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) - -;;;----------------------------------------------- -;;; Cursor movement -;;;----------------------------------------------- - -(def-completion-wrapper next-line :under-or-before) -(def-completion-wrapper previous-line :under-or-before) -(def-completion-wrapper beginning-of-buffer :under-or-before) -(def-completion-wrapper end-of-buffer :under-or-before) -(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 -;;; foobar -;;; fooquux -;;; fooper - -(cmpl-statistics-block - (record-completion-file-loaded)) + (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)) + +;;; Enable completion mode. + +;;;###autoload +(defun dynamic-completion-mode () + "Enable dynamic word-completion." + (interactive) + (add-hook 'find-file-hooks 'cmpl-find-file-hook) + (add-hook 'pre-command-hook 'completion-before-command) + + ;; Install the appropriate mode tables. + (add-hook 'lisp-mode-hook + (lambda () + (setq cmpl-syntax-table cmpl-lisp-syntax-table))) + (add-hook 'c-mode-hook + (lambda () + (setq cmpl-syntax-table cmpl-c-syntax-table))) + (add-hook 'fortran-mode-hook + (lambda () + (setq cmpl-syntax-table cmpl-fortran-syntax-table) + (completion-setup-fortran-mode))) + + ;; "Complete" Key Keybindings. + + (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") + ;; (add-completion "cumberbund") + ;; cum + ;; Cumber + ;; cumbering + ;; cumb + + ;; Save completions when killing Emacs. + + (add-hook 'kill-emacs-hook + (lambda () + (kill-emacs-save-completions) + (cmpl-statistics-block + (record-cmpl-kill-emacs)))) + + ;; Patches to standard keymaps insert completions + (substitute-key-definition 'kill-region 'completion-kill-region + global-map) + + ;; Separators + ;; We've used the completion syntax table given as a guide. + ;; + ;; Global separator chars. + ;; We left out because there are too many special cases for it. Also, + ;; in normal coding it's rarely typed after a word. + (global-set-key " " 'completion-separator-self-insert-autofilling) + (global-set-key "!" 'completion-separator-self-insert-command) + (global-set-key "%" 'completion-separator-self-insert-command) + (global-set-key "^" 'completion-separator-self-insert-command) + (global-set-key "&" 'completion-separator-self-insert-command) + (global-set-key "(" 'completion-separator-self-insert-command) + (global-set-key ")" 'completion-separator-self-insert-command) + (global-set-key "=" 'completion-separator-self-insert-command) + (global-set-key "`" 'completion-separator-self-insert-command) + (global-set-key "|" 'completion-separator-self-insert-command) + (global-set-key "{" 'completion-separator-self-insert-command) + (global-set-key "}" 'completion-separator-self-insert-command) + (global-set-key "[" 'completion-separator-self-insert-command) + (global-set-key "]" 'completion-separator-self-insert-command) + (global-set-key ";" 'completion-separator-self-insert-command) + (global-set-key "\"" 'completion-separator-self-insert-command) + (global-set-key "'" 'completion-separator-self-insert-command) + (global-set-key "#" 'completion-separator-self-insert-command) + (global-set-key "," 'completion-separator-self-insert-command) + (global-set-key "?" 'completion-separator-self-insert-command) + + ;; We include period and colon even though they are symbol chars because : + ;; - in text we want to pick up the last word in a sentence. + ;; - in C pointer refs. we want to pick up the first symbol + ;; - it won't make a difference for lisp mode (package names are short) + (global-set-key "." 'completion-separator-self-insert-command) + (global-set-key ":" 'completion-separator-self-insert-command) + + ;; Lisp Mode diffs + (define-key lisp-mode-map "!" 'self-insert-command) + (define-key lisp-mode-map "&" 'self-insert-command) + (define-key lisp-mode-map "%" 'self-insert-command) + (define-key lisp-mode-map "?" 'self-insert-command) + (define-key lisp-mode-map "=" 'self-insert-command) + (define-key lisp-mode-map "^" 'self-insert-command) + + ;; Avoid warnings. + (defvar c-mode-map) + (defvar fortran-mode-map) + + ;;----------------------------------------------- + ;; End of line chars. + ;;----------------------------------------------- + (def-completion-wrapper newline :separator) + (def-completion-wrapper newline-and-indent :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) + ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) + + ;;----------------------------------------------- + ;; Cursor movement + ;;----------------------------------------------- + + (def-completion-wrapper next-line :under-or-before) + (def-completion-wrapper previous-line :under-or-before) + (def-completion-wrapper beginning-of-buffer :under-or-before) + (def-completion-wrapper end-of-buffer :under-or-before) + (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 + ;; foobar + ;; fooquux + ;; fooper + + (cmpl-statistics-block + (record-completion-file-loaded)) + + (initialize-completions)) + +(mapc (lambda (x) + (add-to-list 'debug-ignored-errors x)) + '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" + "^The string \".*\" is too short to be saved as a completion\\.$")) + +(provide 'completion) ;;; completion.el ends here