1;;; completion.el --- dynamic word-completion code 2;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. 3 4;; Maintainer: FSF 5;; Keywords: abbrev 6;; Author: Jim Salem <salem@think.com> and Brewster Kahle <brewster@think.com> 7;; of Thinking Machines Inc. 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to 23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 25;;; Commentary: 26;;; 27;;; What to put in .emacs 28;;;----------------------- 29;;; (load "completion") 30;;; (initialize-completions) 31 32;;;--------------------------------------------------------------------------- 33;;; Documentation [Slightly out of date] 34;;;--------------------------------------------------------------------------- 35;;; (also check the documentation string of the functions) 36;;; 37;;; Introduction 38;;;--------------- 39;;; 40;;; After you type a few characters, pressing the "complete" key inserts 41;;; the rest of the word you are likely to type. 42;;; 43;;; This watches all the words that you type and remembers them. When 44;;; typing a new word, pressing "complete" (meta-return) "completes" the 45;;; word by inserting the most recently used word that begins with the 46;;; same characters. If you press meta-return repeatedly, it cycles 47;;; through all the words it knows about. 48;;; 49;;; If you like the completion then just continue typing, it is as if you 50;;; entered the text by hand. If you want the inserted extra characters 51;;; to go away, type control-w or delete. More options are described below. 52;;; 53;;; The guesses are made in the order of the most recently "used". Typing 54;;; in a word and then typing a separator character (such as a space) "uses" 55;;; the word. So does moving a cursor over the word. If no words are found, 56;;; it uses an extended version of the dabbrev style completion. 57;;; 58;;; You automatically save the completions you use to a file between 59;;; sessions. 60;;; 61;;; Completion enables programmers to enter longer, more descriptive 62;;; variable names while typing fewer keystrokes than they normally would. 63;;; 64;;; 65;;; Full documentation 66;;;--------------------- 67;;; 68;;; A "word" is any string containing characters with either word or symbol 69;;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] 70;;; Unless you change the constants, you must type at least three characters 71;;; for the word to be recognized. Only words longer than 6 characters are 72;;; saved. 73;;; 74;;; When you load this file, completion will be on. I suggest you use the 75;;; compiled version (because it is noticeably faster). 76;;; 77;;; M-X completion-mode toggles whether or not new words are added to the 78;;; database by changing the value of enable-completion. 79;;; 80;;; SAVING/LOADING COMPLETIONS 81;;; Completions are automatically saved from one session to another 82;;; (unless save-completions-flag or enable-completion is nil). 83;;; Loading this file (or calling initialize-completions) causes EMACS 84;;; to load a completions database for a saved completions file 85;;; (default: ~/.completions). When you exit, EMACS saves a copy of the 86;;; completions that you 87;;; often use. When you next start, EMACS loads in the saved completion file. 88;;; 89;;; The number of completions saved depends loosely on 90;;; *saved-completions-decay-factor*. Completions that have never been 91;;; inserted via "complete" are not saved. You are encouraged to experiment 92;;; with different functions (see compute-completion-min-num-uses). 93;;; 94;;; Some completions are permanent and are always saved out. These 95;;; completions have their num-uses slot set to T. Use 96;;; add-permanent-completion to do this 97;;; 98;;; Completions are saved only if enable-completion is T. The number of old 99;;; versions kept of the saved completions file is controlled by 100;;; completions-file-versions-kept. 101;;; 102;;; COMPLETE KEY OPTIONS 103;;; The complete function takes a numeric arguments. 104;;; control-u :: leave the point at the beginning of the completion rather 105;;; than the middle. 106;;; a number :: rotate through the possible completions by that amount 107;;; `-' :: same as -1 (insert previous completion) 108;;; 109;;; HOW THE DATABASE IS MAINTAINED 110;;; <write> 111;;; 112;;; UPDATING THE DATABASE MANUALLY 113;;; m-x kill-completion 114;;; kills the completion at point. 115;;; m-x add-completion 116;;; m-x add-permanent-completion 117;;; 118;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE 119;;; m-x add-completions-from-buffer 120;;; Parses all the definition names from a C or LISP mode buffer and 121;;; adds them to the completion database. 122;;; 123;;; m-x add-completions-from-lisp-file 124;;; Parses all the definition names from a C or Lisp mode file and 125;;; adds them to the completion database. 126;;; 127;;; UPDATING THE DATABASE FROM A TAGS TABLE 128;;; m-x add-completions-from-tags-table 129;;; Adds completions from the current tags-table-buffer. 130;;; 131;;; HOW A COMPLETION IS FOUND 132;;; <write> 133;;; 134;;; STRING CASING 135;;; Completion is string case independent if case-fold-search has its 136;;; normal default of T. Also when the completion is inserted the case of the 137;;; entry is coerced appropriately. 138;;; [E.G. APP --> APPROPRIATELY app --> appropriately 139;;; App --> Appropriately] 140;;; 141;;; INITIALIZATION 142;;; The form `(initialize-completions)' initializes the completion system by 143;;; trying to load in the user's completions. After the first cal, further 144;;; calls have no effect so one should be careful not to put the form in a 145;;; site's standard site-init file. 146;;; 147;;;--------------------------------------------------------------------------- 148;;; 149;;; 150 151;;;--------------------------------------------------------------------------- 152;;; Functions you might like to call 153;;;--------------------------------------------------------------------------- 154;;; 155;;; add-completion string &optional num-uses 156;;; Adds a new string to the database 157;;; 158;;; add-permanent-completion string 159;;; Adds a new string to the database with num-uses = T 160;;; 161 162;;; kill-completion string 163;;; Kills the completion from the database. 164;;; 165;;; clear-all-completions 166;;; Clears the database 167;;; 168;;; list-all-completions 169;;; Returns a list of all completions. 170;;; 171;;; 172;;; next-completion string &optional index 173;;; Returns a completion entry that starts with string. 174;;; 175;;; find-exact-completion string 176;;; Returns a completion entry that exactly matches string. 177;;; 178;;; complete 179;;; Inserts a completion at point 180;;; 181;;; initialize-completions 182;;; Loads the completions file and sets up so that exiting emacs will 183;;; save them. 184;;; 185;;; save-completions-to-file &optional filename 186;;; load-completions-from-file &optional filename 187;;; 188;;;----------------------------------------------- 189;;; Other functions 190;;;----------------------------------------------- 191;;; 192;;; get-completion-list string 193;;; 194;;; These things are for manipulating the structure 195;;; make-completion string num-uses 196;;; completion-num-uses completion 197;;; completion-string completion 198;;; set-completion-num-uses completion num-uses 199;;; set-completion-string completion string 200;;; 201;;; 202 203;;;----------------------------------------------- 204;;; To Do :: (anybody ?) 205;;;----------------------------------------------- 206;;; 207;;; Implement Lookup and keyboard interface in C 208;;; Add package prefix smarts (for Common Lisp) 209;;; Add autoprompting of possible completions after every keystroke (fast 210;;; terminals only !) 211;;; Add doc. to texinfo 212;;; 213;;; 214;;;----------------------------------------------- 215;;; Change Log: 216;;;----------------------------------------------- 217;;; Sometime in '84 Brewster implemented a somewhat buggy version for 218;;; Symbolics LISPMs. 219;;; Jan. '85 Jim became enamored of the idea and implemented a faster, 220;;; more robust version. 221;;; With input from many users at TMC, (rose, craig, and gls come to mind), 222;;; the current style of interface was developed. 223;;; 9/87, Jim and Brewster took terminals home. Yuck. After 224;;; complaining for a while Brewester implemented a subset of the current 225;;; LISPM version for GNU Emacs. 226;;; 8/88 After complaining for a while (and with sufficient 227;;; promised rewards), Jim reimplemented a version of GNU completion 228;;; superior to that of the LISPM version. 229;;; 230;;;----------------------------------------------- 231;;; Acknowledgements 232;;;----------------------------------------------- 233;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), 234;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, 235;;; 236;;;----------------------------------------------- 237;;; Change Log 238;;;----------------------------------------------- 239;;; From version 9 to 10 240;;; - Allowance for non-integral *completion-version* nos. 241;;; - Fix cmpl-apply-as-top-level for keyboard macros 242;;; - Fix broken completion merging (in save-completions-to-file) 243;;; - More misc. fixes for version 19.0 of emacs 244;;; 245;;; From Version 8 to 9 246;;; - Ported to version 19.0 of emacs (backcompatible with version 18) 247;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) 248;;; 249;;; From Version 7 to 8 250;;; - Misc. changes to comments 251;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e 252;;; - cdabbrev now checks all the visible window buffers and the "other buffer" 253;;; - `%' is now a symbol character rather than a separator (except in C mode) 254;;; 255;;; From Version 6 to 7 256;;; - Fixed bug with saving out .completion file the first time 257;;; 258;;; From Version 5 to 6 259;;; - removed statistics recording 260;;; - reworked advise to handle autoloads 261;;; - Fixed fortran mode support 262;;; - Added new cursor motion triggers 263;;; 264;;; From Version 4 to 5 265;;; - doesn't bother saving if nothing has changed 266;;; - auto-save if haven't used for a 1/2 hour 267;;; - save period extended to two weeks 268;;; - minor fix to capitalization code 269;;; - added *completion-auto-save-period* to variables recorded. 270;;; - added reenter protection to cmpl-record-statistics-filter 271;;; - added backup protection to save-completions-to-file (prevents 272;;; problems with disk full errors) 273 274;;; Code: 275 276;;;--------------------------------------------------------------------------- 277;;; User changeable parameters 278;;;--------------------------------------------------------------------------- 279 280(defvar enable-completion t 281 "*Non-nil means enable recording and saving of completions. 282If nil, no new words added to the database or saved to the init file.") 283 284(defvar save-completions-flag t 285 "*Non-nil means save most-used completions when exiting Emacs. 286See also `saved-completions-retention-time'.") 287 288(defvar save-completions-file-name "~/.completions" 289 "*The filename to save completions to.") 290 291(defvar save-completions-retention-time 336 292 "*Discard a completion if unused for this many hours. 293\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions 294will not be saved unless these are used. Default is two weeks.") 295 296(defvar completion-on-separator-character nil 297 "*Non-nil means separator characters mark previous word as used. 298This means the word will be saved as a completion.") 299 300(defvar completions-file-versions-kept kept-new-versions 301 "*Number of versions to keep for the saved completions file.") 302 303(defvar completion-prompt-speed-threshold 4800 304 "*Minimum output speed at which to display next potential completion.") 305 306(defvar completion-cdabbrev-prompt-flag nil 307 "*If non-nil, the next completion prompt does a cdabbrev search. 308This can be time consuming.") 309 310(defvar completion-search-distance 15000 311 "*How far to search in the buffer when looking for completions. 312In number of characters. If nil, search the whole buffer.") 313 314(defvar completions-merging-modes '(lisp c) 315 "*List of modes {`c' or `lisp'} for automatic completions merging. 316Definitions from visited files which have these modes 317are automatically added to the completion database.") 318 319;;;(defvar *record-cmpl-statistics-p* nil 320;;; "*If non-nil, record completion statistics.") 321 322;;;(defvar *completion-auto-save-period* 1800 323;;; "*The period in seconds to wait for emacs to be idle before autosaving 324;;;the completions. Default is a 1/2 hour.") 325 326(defconst completion-min-length nil ;; defined below in eval-when 327 "*The minimum length of a stored completion. 328DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") 329 330(defconst completion-max-length nil ;; defined below in eval-when 331 "*The maximum length of a stored completion. 332DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") 333 334(defconst completion-prefix-min-length nil ;; defined below in eval-when 335 "The minimum length of a completion search string. 336DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") 337 338(defmacro eval-when-compile-load-eval (&rest body) 339 ;; eval everything before expanding 340 (mapcar 'eval body) 341 (cons 'progn body)) 342 343(defun completion-eval-when () 344 (eval-when-compile-load-eval 345 ;; These vars. are defined at both compile and load time. 346 (setq completion-min-length 6) 347 (setq completion-max-length 200) 348 (setq completion-prefix-min-length 3))) 349 350(completion-eval-when) 351 352;; Need this file around too 353(require 'cl) 354 355;;;--------------------------------------------------------------------------- 356;;; Internal Variables 357;;;--------------------------------------------------------------------------- 358 359(defvar cmpl-initialized-p nil 360 "Set to t when the completion system is initialized. 361Indicates that the old completion file has been read in.") 362 363(defvar cmpl-completions-accepted-p nil 364 "Set to t as soon as the first completion has been accepted. 365Used to decide whether to save completions.") 366 367 368;;;--------------------------------------------------------------------------- 369;;; Low level tools 370;;;--------------------------------------------------------------------------- 371 372;;;----------------------------------------------- 373;;; Misc. 374;;;----------------------------------------------- 375 376(defun minibuffer-window-selected-p () 377 "True iff the current window is the minibuffer." 378 (window-minibuffer-p (selected-window))) 379 380;; This used to be `(eval form)'. Eval FORM at run time now. 381(defmacro cmpl-read-time-eval (form) 382 form) 383 384;;;----------------------------------------------- 385;;; String case coercion 386;;;----------------------------------------------- 387 388(defun cmpl-string-case-type (string) 389 "Returns :capitalized, :up, :down, :mixed, or :neither." 390 (let ((case-fold-search nil)) 391 (cond ((string-match "[a-z]" string) 392 (cond ((string-match "[A-Z]" string) 393 (cond ((and (> (length string) 1) 394 (null (string-match "[A-Z]" string 1))) 395 ':capitalized) 396 (t 397 ':mixed))) 398 (t ':down))) 399 (t 400 (cond ((string-match "[A-Z]" string) 401 ':up) 402 (t ':neither)))) 403 )) 404 405;;; Tests - 406;;; (cmpl-string-case-type "123ABCDEF456") --> :up 407;;; (cmpl-string-case-type "123abcdef456") --> :down 408;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed 409;;; (cmpl-string-case-type "123456") --> :neither 410;;; (cmpl-string-case-type "Abcde123") --> :capitalized 411 412(defun cmpl-coerce-string-case (string case-type) 413 (cond ((eq case-type ':down) (downcase string)) 414 ((eq case-type ':up) (upcase string)) 415 ((eq case-type ':capitalized) 416 (setq string (downcase string)) 417 (aset string 0 (logand ?\337 (aref string 0))) 418 string) 419 (t string) 420 )) 421 422(defun cmpl-merge-string-cases (string-to-coerce given-string) 423 (let ((string-case-type (cmpl-string-case-type string-to-coerce)) 424 ) 425 (cond ((memq string-case-type '(:down :up :capitalized)) 426 ;; Found string is in a standard case. Coerce to a type based on 427 ;; the given string 428 (cmpl-coerce-string-case string-to-coerce 429 (cmpl-string-case-type given-string)) 430 ) 431 (t 432 ;; If the found string is in some unusual case, just insert it 433 ;; as is 434 string-to-coerce) 435 ))) 436 437;;; Tests - 438;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 439;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 440;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 441;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 442 443 444(defun cmpl-hours-since-origin () 445 (let ((time (current-time))) 446 (truncate 447 (+ (* (/ (car time) 3600.0) (lsh 1 16)) 448 (/ (nth 2 time) 3600.0))))) 449 450;;;--------------------------------------------------------------------------- 451;;; "Symbol" parsing functions 452;;;--------------------------------------------------------------------------- 453;;; The functions symbol-before-point, symbol-under-point, etc. quickly return 454;;; an appropriate symbol string. The strategy is to temporarily change 455;;; the syntax table to enable fast symbol searching. There are three classes 456;;; of syntax in these "symbol" syntax tables :: 457;;; 458;;; syntax (?_) - "symbol" chars (e.g. alphanumerics) 459;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). 460;;; syntax (? ) - everything else 461;;; 462;;; Thus by judicious use of scan-sexps and forward-word, we can get 463;;; the word we want relatively fast and without consing. 464;;; 465;;; Why do we need a separate category for "symbol chars to ignore at ends" ? 466;;; For example, in LISP we want starting :'s trimmed 467;;; so keyword argument specifiers also define the keyword completion. And, 468;;; for example, in C we want `.' appearing in a structure ref. to 469;;; be kept intact in order to store the whole structure ref.; however, if 470;;; it appears at the end of a symbol it should be discarded because it is 471;;; probably used as a period. 472 473;;; Here is the default completion syntax :: 474;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % 475;;; Symbol chars to ignore at ends :: _ : . - 476;;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' # 477;;; , ? <Everything else> 478 479;;; Mode specific differences and notes :: 480;;; LISP diffs -> 481;;; Symbol chars :: ! & ? = ^ 482;;; 483;;; C diffs -> 484;;; Separator chars :: + * / : % 485;;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator 486;;; char., however, we wanted to have completion symbols include pointer 487;;; references. For example, "foo->bar" is a symbol as far as completion is 488;;; concerned. 489;;; 490;;; FORTRAN diffs -> 491;;; Separator chars :: + - * / : 492;;; 493;;; Pathname diffs -> 494;;; Symbol chars :: . 495;;; Of course there is no pathname "mode" and in fact we have not implemented 496;;; this table. However, if there was such a mode, this is what it would look 497;;; like. 498 499;;;----------------------------------------------- 500;;; Table definitions 501;;;----------------------------------------------- 502 503(defun cmpl-make-standard-completion-syntax-table () 504 (let ((table (make-vector 256 0)) ;; default syntax is whitespace 505 ) 506 ;; alpha chars 507 (dotimes (i 26) 508 (modify-syntax-entry (+ ?a i) "_" table) 509 (modify-syntax-entry (+ ?A i) "_" table)) 510 ;; digit chars. 511 (dotimes (i 10) 512 (modify-syntax-entry (+ ?0 i) "_" table)) 513 ;; Other ones 514 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) 515 (symbol-chars-ignore '(?_ ?- ?: ?.)) 516 ) 517 (dolist (char symbol-chars) 518 (modify-syntax-entry char "_" table)) 519 (dolist (char symbol-chars-ignore) 520 (modify-syntax-entry char "w" table) 521 ) 522 ) 523 table)) 524 525(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) 526 527(defun cmpl-make-lisp-completion-syntax-table () 528 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) 529 (symbol-chars '(?! ?& ?? ?= ?^)) 530 ) 531 (dolist (char symbol-chars) 532 (modify-syntax-entry char "_" table)) 533 table)) 534 535(defun cmpl-make-c-completion-syntax-table () 536 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) 537 (separator-chars '(?+ ?* ?/ ?: ?%)) 538 ) 539 (dolist (char separator-chars) 540 (modify-syntax-entry char " " table)) 541 table)) 542 543(defun cmpl-make-fortran-completion-syntax-table () 544 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) 545 (separator-chars '(?+ ?- ?* ?/ ?:)) 546 ) 547 (dolist (char separator-chars) 548 (modify-syntax-entry char " " table)) 549 table)) 550 551(defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) 552(defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) 553(defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table)) 554 555(defvar cmpl-syntax-table cmpl-standard-syntax-table 556 "This variable holds the current completion syntax table.") 557(make-variable-buffer-local 'cmpl-syntax-table) 558 559;;;----------------------------------------------- 560;;; Installing the appropriate mode tables 561;;;----------------------------------------------- 562 563(add-hook 'lisp-mode-hook 564 '(lambda () 565 (setq cmpl-syntax-table cmpl-lisp-syntax-table))) 566 567(add-hook 'c-mode-hook 568 '(lambda () 569 (setq cmpl-syntax-table cmpl-c-syntax-table))) 570 571(add-hook 'fortran-mode-hook 572 '(lambda () 573 (setq cmpl-syntax-table cmpl-fortran-syntax-table) 574 (completion-setup-fortran-mode))) 575 576;;;----------------------------------------------- 577;;; Symbol functions 578;;;----------------------------------------------- 579(defvar cmpl-symbol-start nil 580 "Holds first character of symbol, after any completion symbol function.") 581(defvar cmpl-symbol-end nil 582 "Holds last character of symbol, after any completion symbol function.") 583;;; These are temp. vars. we use to avoid using let. 584;;; Why ? Small speed improvement. 585(defvar cmpl-saved-syntax nil) 586(defvar cmpl-saved-point nil) 587 588(defun symbol-under-point () 589 "Returns the symbol that the point is currently on. 590But only if it is longer than `completion-min-length'." 591 (setq cmpl-saved-syntax (syntax-table)) 592 (set-syntax-table cmpl-syntax-table) 593 (cond 594 ;; Cursor is on following-char and after preceding-char 595 ((memq (char-syntax (following-char)) '(?w ?_)) 596 (setq cmpl-saved-point (point) 597 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) 598 cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) 599 ;; remove chars to ignore at the start 600 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 601 (goto-char cmpl-symbol-start) 602 (forward-word 1) 603 (setq cmpl-symbol-start (point)) 604 (goto-char cmpl-saved-point) 605 )) 606 ;; remove chars to ignore at the end 607 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) 608 (goto-char cmpl-symbol-end) 609 (forward-word -1) 610 (setq cmpl-symbol-end (point)) 611 (goto-char cmpl-saved-point) 612 )) 613 ;; restore state 614 (set-syntax-table cmpl-saved-syntax) 615 ;; Return completion if the length is reasonable 616 (if (and (<= (cmpl-read-time-eval completion-min-length) 617 (- cmpl-symbol-end cmpl-symbol-start)) 618 (<= (- cmpl-symbol-end cmpl-symbol-start) 619 (cmpl-read-time-eval completion-max-length))) 620 (buffer-substring cmpl-symbol-start cmpl-symbol-end)) 621 ) 622 (t 623 ;; restore table if no symbol 624 (set-syntax-table cmpl-saved-syntax) 625 nil) 626 )) 627 628;;; tests for symbol-under-point 629;;; `^' indicates cursor pos. where value is returned 630;;; simple-word-test 631;;; ^^^^^^^^^^^^^^^^ --> simple-word-test 632;;; _harder_word_test_ 633;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test 634;;; .___.______. 635;;; --> nil 636;;; /foo/bar/quux.hello 637;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello 638;;; 639 640(defun symbol-before-point () 641 "Returns a string of the symbol immediately before point. 642Returns nil if there isn't one longer than `completion-min-length'." 643 ;; This is called when a word separator is typed so it must be FAST ! 644 (setq cmpl-saved-syntax (syntax-table)) 645 (set-syntax-table cmpl-syntax-table) 646 ;; Cursor is on following-char and after preceding-char 647 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) 648 ;; No chars. to ignore at end 649 (setq cmpl-symbol-end (point) 650 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) 651 ) 652 ;; remove chars to ignore at the start 653 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 654 (goto-char cmpl-symbol-start) 655 (forward-word 1) 656 (setq cmpl-symbol-start (point)) 657 (goto-char cmpl-symbol-end) 658 )) 659 ;; restore state 660 (set-syntax-table cmpl-saved-syntax) 661 ;; return value if long enough 662 (if (>= cmpl-symbol-end 663 (+ cmpl-symbol-start 664 (cmpl-read-time-eval completion-min-length))) 665 (buffer-substring cmpl-symbol-start cmpl-symbol-end)) 666 ) 667 ((= cmpl-preceding-syntax ?w) 668 ;; chars to ignore at end 669 (setq cmpl-saved-point (point) 670 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)) 671 ;; take off chars. from end 672 (forward-word -1) 673 (setq cmpl-symbol-end (point)) 674 ;; remove chars to ignore at the start 675 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 676 (goto-char cmpl-symbol-start) 677 (forward-word 1) 678 (setq cmpl-symbol-start (point)) 679 )) 680 ;; restore state 681 (goto-char cmpl-saved-point) 682 (set-syntax-table cmpl-saved-syntax) 683 ;; Return completion if the length is reasonable 684 (if (and (<= (cmpl-read-time-eval completion-min-length) 685 (- cmpl-symbol-end cmpl-symbol-start)) 686 (<= (- cmpl-symbol-end cmpl-symbol-start) 687 (cmpl-read-time-eval completion-max-length))) 688 (buffer-substring cmpl-symbol-start cmpl-symbol-end)) 689 ) 690 (t 691 ;; restore table if no symbol 692 (set-syntax-table cmpl-saved-syntax) 693 nil) 694 )) 695 696;;; tests for symbol-before-point 697;;; `^' indicates cursor pos. where value is returned 698;;; simple-word-test 699;;; ^ --> nil 700;;; ^ --> nil 701;;; ^ --> simple-w 702;;; ^ --> simple-word-test 703;;; _harder_word_test_ 704;;; ^ --> harder_word_test 705;;; ^ --> harder_word_test 706;;; ^ --> harder 707;;; .___.... 708;;; --> nil 709 710(defun symbol-under-or-before-point () 711 ;;; This could be made slightly faster but it is better to avoid 712 ;;; copying all the code. 713 ;;; However, it is only used by the completion string prompter. 714 ;;; If it comes into common use, it could be rewritten. 715 (setq cmpl-saved-syntax (syntax-table)) 716 (set-syntax-table cmpl-syntax-table) 717 (cond ((memq (char-syntax (following-char)) '(?w ?_)) 718 (set-syntax-table cmpl-saved-syntax) 719 (symbol-under-point)) 720 (t 721 (set-syntax-table cmpl-saved-syntax) 722 (symbol-before-point)) 723 )) 724 725 726(defun symbol-before-point-for-complete () 727 ;; "Returns a string of the symbol immediately before point 728 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the 729 ;; end chars." 730 ;; Cursor is on following-char and after preceding-char 731 (setq cmpl-saved-syntax (syntax-table)) 732 (set-syntax-table cmpl-syntax-table) 733 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) 734 '(?_ ?w)) 735 (setq cmpl-symbol-end (point) 736 cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) 737 ) 738 ;; remove chars to ignore at the start 739 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 740 (goto-char cmpl-symbol-start) 741 (forward-word 1) 742 (setq cmpl-symbol-start (point)) 743 (goto-char cmpl-symbol-end) 744 )) 745 ;; restore state 746 (set-syntax-table cmpl-saved-syntax) 747 ;; Return completion if the length is reasonable 748 (if (and (<= (cmpl-read-time-eval 749 completion-prefix-min-length) 750 (- cmpl-symbol-end cmpl-symbol-start)) 751 (<= (- cmpl-symbol-end cmpl-symbol-start) 752 (cmpl-read-time-eval completion-max-length))) 753 (buffer-substring cmpl-symbol-start cmpl-symbol-end)) 754 ) 755 (t 756 ;; restore table if no symbol 757 (set-syntax-table cmpl-saved-syntax) 758 nil) 759 )) 760 761;;; tests for symbol-before-point-for-complete 762;;; `^' indicates cursor pos. where value is returned 763;;; simple-word-test 764;;; ^ --> nil 765;;; ^ --> nil 766;;; ^ --> simple-w 767;;; ^ --> simple-word-test 768;;; _harder_word_test_ 769;;; ^ --> harder_word_test 770;;; ^ --> harder_word_test_ 771;;; ^ --> harder_ 772;;; .___.... 773;;; --> nil 774 775 776 777;;;--------------------------------------------------------------------------- 778;;; Statistics Recording 779;;;--------------------------------------------------------------------------- 780 781;;; Note that the guts of this has been turned off. The guts 782;;; are in completion-stats.el. 783 784;;;----------------------------------------------- 785;;; Conditionalizing code on *record-cmpl-statistics-p* 786;;;----------------------------------------------- 787;;; All statistics code outside this block should use this 788(defmacro cmpl-statistics-block (&rest body)) 789;;; "Only executes body if we are recording statistics." 790;;; (list 'cond 791;;; (list* '*record-cmpl-statistics-p* body) 792;;; )) 793 794;;;----------------------------------------------- 795;;; Completion Sources 796;;;----------------------------------------------- 797 798;; ID numbers 799(defconst cmpl-source-unknown 0) 800(defconst cmpl-source-init-file 1) 801(defconst cmpl-source-file-parsing 2) 802(defconst cmpl-source-separator 3) 803(defconst cmpl-source-cursor-moves 4) 804(defconst cmpl-source-interactive 5) 805(defconst cmpl-source-cdabbrev 6) 806(defconst num-cmpl-sources 7) 807(defvar current-completion-source cmpl-source-unknown) 808 809 810 811;;;--------------------------------------------------------------------------- 812;;; Completion Method #2: dabbrev-expand style 813;;;--------------------------------------------------------------------------- 814;;; 815;;; This method is used if there are no useful stored completions. It is 816;;; based on dabbrev-expand with these differences : 817;;; 1) Faster (we don't use regexps) 818;;; 2) case coercion handled correctly 819;;; This is called cdabbrev to differentiate it. 820;;; We simply search backwards through the file looking for words which 821;;; start with the same letters we are trying to complete. 822;;; 823 824(defvar cdabbrev-completions-tried nil) 825;;; "A list of all the cdabbrev completions since the last reset.") 826 827(defvar cdabbrev-current-point 0) 828;;; "The current point position the cdabbrev search is at.") 829 830(defvar cdabbrev-current-window nil) 831;;; "The current window we are looking for cdabbrevs in. T if looking in 832;;; (other-buffer), NIL if no more cdabbrevs.") 833 834(defvar cdabbrev-wrapped-p nil) 835;;; "T if the cdabbrev search has wrapped around the file.") 836 837(defvar cdabbrev-abbrev-string "") 838(defvar cdabbrev-start-point 0) 839 840;;; Test strings for cdabbrev 841;;; cdat-upcase ;;same namestring 842;;; CDAT-UPCASE ;;ok 843;;; cdat2 ;;too short 844;;; cdat-1-2-3-4 ;;ok 845;;; a-cdat-1 ;;doesn't start correctly 846;;; cdat-simple ;;ok 847 848 849(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) 850 "Resets the cdabbrev search to search for abbrev-string. 851INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore 852during the search." 853 (setq cdabbrev-abbrev-string abbrev-string 854 cdabbrev-completions-tried 855 (cons (downcase abbrev-string) initial-completions-tried) 856 ) 857 (reset-cdabbrev-window t) 858 ) 859 860(defun set-cdabbrev-buffer () 861 ;; cdabbrev-current-window must not be NIL 862 (set-buffer (if (eq cdabbrev-current-window t) 863 (other-buffer) 864 (window-buffer cdabbrev-current-window))) 865 ) 866 867 868(defun reset-cdabbrev-window (&optional initializep) 869 "Resets the cdabbrev search to search for abbrev-string." 870 ;; Set the window 871 (cond (initializep 872 (setq cdabbrev-current-window (selected-window)) 873 ) 874 ((eq cdabbrev-current-window t) 875 ;; Everything has failed 876 (setq cdabbrev-current-window nil)) 877 (cdabbrev-current-window 878 (setq cdabbrev-current-window (next-window cdabbrev-current-window)) 879 (if (eq cdabbrev-current-window (selected-window)) 880 ;; No more windows, try other buffer. 881 (setq cdabbrev-current-window t))) 882 ) 883 (when cdabbrev-current-window 884 (save-excursion 885 (set-cdabbrev-buffer) 886 (setq cdabbrev-current-point (point) 887 cdabbrev-start-point cdabbrev-current-point 888 cdabbrev-stop-point 889 (if completion-search-distance 890 (max (point-min) 891 (- cdabbrev-start-point completion-search-distance)) 892 (point-min)) 893 cdabbrev-wrapped-p nil) 894 ))) 895 896(defun next-cdabbrev () 897 "Return the next possible cdabbrev expansion or nil if there isn't one. 898`reset-cdabbrev' must've been called already. 899This is sensitive to `case-fold-search'." 900 ;; note that case-fold-search affects the behavior of this function 901 ;; Bug: won't pick up an expansion that starts at the top of buffer 902 (when cdabbrev-current-window 903 (let (saved-point 904 saved-syntax 905 (expansion nil) 906 downcase-expansion tried-list syntax saved-point-2) 907 (save-excursion 908 (unwind-protect 909 (progn 910 ;; Switch to current completion buffer 911 (set-cdabbrev-buffer) 912 ;; Save current buffer state 913 (setq saved-point (point) 914 saved-syntax (syntax-table)) 915 ;; Restore completion state 916 (set-syntax-table cmpl-syntax-table) 917 (goto-char cdabbrev-current-point) 918 ;; Loop looking for completions 919 (while 920 ;; This code returns t if it should loop again 921 (cond 922 (;; search for the string 923 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) 924 ;; return nil if the completion is valid 925 (not 926 (and 927 ;; does it start with a separator char ? 928 (or (= (setq syntax (char-syntax (preceding-char))) ? ) 929 (and (= syntax ?w) 930 ;; symbol char to ignore at end. Are we at end ? 931 (progn 932 (setq saved-point-2 (point)) 933 (forward-word -1) 934 (prog1 935 (= (char-syntax (preceding-char)) ? ) 936 (goto-char saved-point-2) 937 )))) 938 ;; is the symbol long enough ? 939 (setq expansion (symbol-under-point)) 940 ;; have we not tried this one before 941 (progn 942 ;; See if we've already used it 943 (setq tried-list cdabbrev-completions-tried 944 downcase-expansion (downcase expansion)) 945 (while (and tried-list 946 (not (string-equal downcase-expansion 947 (car tried-list)))) 948 ;; Already tried, don't choose this one 949 (setq tried-list (cdr tried-list)) 950 ) 951 ;; at this point tried-list will be nil if this 952 ;; expansion has not yet been tried 953 (if tried-list 954 (setq expansion nil) 955 t) 956 )))) 957 ;; search failed 958 (cdabbrev-wrapped-p 959 ;; If already wrapped, then we've failed completely 960 nil) 961 (t 962 ;; need to wrap 963 (goto-char (setq cdabbrev-current-point 964 (if completion-search-distance 965 (min (point-max) (+ cdabbrev-start-point completion-search-distance)) 966 (point-max)))) 967 968 (setq cdabbrev-wrapped-p t)) 969 )) 970 ;; end of while loop 971 (cond (expansion 972 ;; successful 973 (setq cdabbrev-completions-tried 974 (cons downcase-expansion cdabbrev-completions-tried) 975 cdabbrev-current-point (point)))) 976 ) 977 (set-syntax-table saved-syntax) 978 (goto-char saved-point) 979 )) 980 ;; If no expansion, go to next window 981 (cond (expansion) 982 (t (reset-cdabbrev-window) 983 (next-cdabbrev))) 984 ))) 985 986;;; The following must be eval'd in the minibuffer :: 987;;; (reset-cdabbrev "cdat") 988;;; (next-cdabbrev) --> "cdat-simple" 989;;; (next-cdabbrev) --> "cdat-1-2-3-4" 990;;; (next-cdabbrev) --> "CDAT-UPCASE" 991;;; (next-cdabbrev) --> "cdat-wrapping" 992;;; (next-cdabbrev) --> "cdat_start_sym" 993;;; (next-cdabbrev) --> nil 994;;; (next-cdabbrev) --> nil 995;;; (next-cdabbrev) --> nil 996 997;;; _cdat_start_sym 998;;; cdat-wrapping 999 1000 1001;;;--------------------------------------------------------------------------- 1002;;; Completion Database 1003;;;--------------------------------------------------------------------------- 1004 1005;;; We use two storage modes for the two search types :: 1006;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions 1007;;; Used by search-completion-next 1008;;; the value of the symbol is nil or a cons of head and tail pointers 1009;;; 2) Interning {cmpl-obarray} to see if it's in the database 1010;;; Used by find-exact-completion, completion-in-database-p 1011;;; The value of the symbol is the completion entry 1012 1013;;; bad things may happen if this length is changed due to the way 1014;;; GNU implements obarrays 1015(defconst cmpl-obarray-length 511) 1016 1017(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) 1018 "An obarray used to store the downcased completion prefixes. 1019Each symbol is bound to a list of completion entries.") 1020 1021(defvar cmpl-obarray (make-vector cmpl-obarray-length 0) 1022 "An obarray used to store the downcased completions. 1023Each symbol is bound to a single completion entry.") 1024 1025;;;----------------------------------------------- 1026;;; Completion Entry Structure Definition 1027;;;----------------------------------------------- 1028 1029;;; A completion entry is a LIST of string, prefix-symbol num-uses, and 1030;;; last-use-time (the time the completion was last used) 1031;;; last-use-time is T if the string should be kept permanently 1032;;; num-uses is incremented everytime the completion is used. 1033 1034;;; We chose lists because (car foo) is faster than (aref foo 0) and the 1035;;; creation time is about the same. 1036 1037;;; READER MACROS 1038 1039(defmacro completion-string (completion-entry) 1040 (list 'car completion-entry)) 1041 1042(defmacro completion-num-uses (completion-entry) 1043 ;; "The number of times it has used. Used to decide whether to save 1044 ;; it." 1045 (list 'car (list 'cdr completion-entry))) 1046 1047(defmacro completion-last-use-time (completion-entry) 1048 ;; "The time it was last used. In hours since origin. Used to decide 1049 ;; whether to save it. T if one should always save it." 1050 (list 'nth 2 completion-entry)) 1051 1052(defmacro completion-source (completion-entry) 1053 (list 'nth 3 completion-entry)) 1054 1055;;; WRITER MACROS 1056(defmacro set-completion-string (completion-entry string) 1057 (list 'setcar completion-entry string)) 1058 1059(defmacro set-completion-num-uses (completion-entry num-uses) 1060 (list 'setcar (list 'cdr completion-entry) num-uses)) 1061 1062(defmacro set-completion-last-use-time (completion-entry last-use-time) 1063 (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time)) 1064 1065;;; CONSTRUCTOR 1066(defun make-completion (string) 1067 "Returns a list of a completion entry." 1068 (list (list string 0 nil current-completion-source))) 1069 1070;; Obsolete 1071;;(defmacro cmpl-prefix-entry-symbol (completion-entry) 1072;; (list 'car (list 'cdr completion-entry))) 1073 1074 1075 1076;;;----------------------------------------------- 1077;;; Prefix symbol entry definition 1078;;;----------------------------------------------- 1079;;; A cons of (head . tail) 1080 1081;;; READER Macros 1082 1083(defmacro cmpl-prefix-entry-head (prefix-entry) 1084 (list 'car prefix-entry)) 1085 1086(defmacro cmpl-prefix-entry-tail (prefix-entry) 1087 (list 'cdr prefix-entry)) 1088 1089;;; WRITER Macros 1090 1091(defmacro set-cmpl-prefix-entry-head (prefix-entry new-head) 1092 (list 'setcar prefix-entry new-head)) 1093 1094(defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail) 1095 (list 'setcdr prefix-entry new-tail)) 1096 1097;;; Constructor 1098 1099(defun make-cmpl-prefix-entry (completion-entry-list) 1100 "Makes a new prefix entry containing only completion-entry." 1101 (cons completion-entry-list completion-entry-list)) 1102 1103;;;----------------------------------------------- 1104;;; Completion Database - Utilities 1105;;;----------------------------------------------- 1106 1107(defun clear-all-completions () 1108 "Initializes the completion storage. All existing completions are lost." 1109 (interactive) 1110 (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) 1111 (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) 1112 (cmpl-statistics-block 1113 (record-clear-all-completions)) 1114 ) 1115 1116(defun list-all-completions () 1117 "Returns a list of all the known completion entries." 1118 (let ((return-completions nil)) 1119 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) 1120 return-completions)) 1121 1122(defun list-all-completions-1 (prefix-symbol) 1123 (if (boundp prefix-symbol) 1124 (setq return-completions 1125 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) 1126 return-completions)))) 1127 1128(defun list-all-completions-by-hash-bucket () 1129 "Return list of lists of known completion entries, organized by hash bucket." 1130 (let ((return-completions nil)) 1131 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) 1132 return-completions)) 1133 1134(defun list-all-completions-by-hash-bucket-1 (prefix-symbol) 1135 (if (boundp prefix-symbol) 1136 (setq return-completions 1137 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) 1138 return-completions)))) 1139 1140 1141;;;----------------------------------------------- 1142;;; Updating the database 1143;;;----------------------------------------------- 1144;;; 1145;;; These are the internal functions used to update the datebase 1146;;; 1147;;; 1148(defvar completion-to-accept nil) 1149 ;;"Set to a string that is pending its acceptance." 1150 ;; this checked by the top level reading functions 1151 1152(defvar cmpl-db-downcase-string nil) 1153 ;; "Setup by find-exact-completion, etc. The given string, downcased." 1154(defvar cmpl-db-symbol nil) 1155 ;; "The interned symbol corresponding to cmpl-db-downcase-string. 1156 ;; Set up by cmpl-db-symbol." 1157(defvar cmpl-db-prefix-symbol nil) 1158 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." 1159(defvar cmpl-db-entry nil) 1160(defvar cmpl-db-debug-p nil 1161 "Set to T if you want to debug the database.") 1162 1163;;; READS 1164(defun find-exact-completion (string) 1165 "Returns the completion entry for string or nil. 1166Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'." 1167 (and (boundp (setq cmpl-db-symbol 1168 (intern (setq cmpl-db-downcase-string (downcase string)) 1169 cmpl-obarray))) 1170 (symbol-value cmpl-db-symbol) 1171 )) 1172 1173(defun find-cmpl-prefix-entry (prefix-string) 1174 "Returns the prefix entry for string. 1175Sets `cmpl-db-prefix-symbol'. 1176Prefix-string must be exactly `completion-prefix-min-length' long 1177and downcased. Sets up `cmpl-db-prefix-symbol'." 1178 (and (boundp (setq cmpl-db-prefix-symbol 1179 (intern prefix-string cmpl-prefix-obarray))) 1180 (symbol-value cmpl-db-prefix-symbol))) 1181 1182(defvar inside-locate-completion-entry nil) 1183;; used to trap lossage in silent error correction 1184 1185(defun locate-completion-entry (completion-entry prefix-entry) 1186 "Locates the completion entry. 1187Returns a pointer to the element before the completion entry or nil if 1188the completion entry is at the head. 1189Must be called after `find-exact-completion'." 1190 (let ((prefix-list (cmpl-prefix-entry-head prefix-entry)) 1191 next-prefix-list 1192 ) 1193 (cond 1194 ((not (eq (car prefix-list) completion-entry)) 1195 ;; not already at head 1196 (while (and prefix-list 1197 (not (eq completion-entry 1198 (car (setq next-prefix-list (cdr prefix-list))) 1199 ))) 1200 (setq prefix-list next-prefix-list)) 1201 (cond (;; found 1202 prefix-list) 1203 ;; Didn't find it. Database is messed up. 1204 (cmpl-db-debug-p 1205 ;; not found, error if debug mode 1206 (error "Completion entry exists but not on prefix list - %s" 1207 string)) 1208 (inside-locate-completion-entry 1209 ;; recursive error: really scrod 1210 (locate-completion-db-error)) 1211 (t 1212 ;; Patch out 1213 (set cmpl-db-symbol nil) 1214 ;; Retry 1215 (locate-completion-entry-retry completion-entry) 1216 )))))) 1217 1218(defun locate-completion-entry-retry (old-entry) 1219 (let ((inside-locate-completion-entry t)) 1220 (add-completion (completion-string old-entry) 1221 (completion-num-uses old-entry) 1222 (completion-last-use-time old-entry)) 1223 (let ((cmpl-entry (find-exact-completion (completion-string old-entry))) 1224 (pref-entry 1225 (if cmpl-entry 1226 (find-cmpl-prefix-entry 1227 (substring cmpl-db-downcase-string 1228 0 completion-prefix-min-length)))) 1229 ) 1230 (if (and cmpl-entry pref-entry) 1231 ;; try again 1232 (locate-completion-entry cmpl-entry pref-entry) 1233 ;; still losing 1234 (locate-completion-db-error)) 1235 ))) 1236 1237(defun locate-completion-db-error () 1238 ;; recursive error: really scrod 1239 (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.") 1240 ) 1241 1242;;; WRITES 1243(defun add-completion-to-tail-if-new (string) 1244 "If STRING is not in the database add it to appropriate prefix list. 1245STRING is added to the end of the appropriate prefix list with 1246num-uses = 0. The database is unchanged if it is there. STRING must be 1247longer than `completion-prefix-min-length'. 1248This must be very fast. 1249Returns the completion entry." 1250 (or (find-exact-completion string) 1251 ;; not there 1252 (let (;; create an entry 1253 (entry (make-completion string)) 1254 ;; setup the prefix 1255 (prefix-entry (find-cmpl-prefix-entry 1256 (substring cmpl-db-downcase-string 0 1257 (cmpl-read-time-eval 1258 completion-prefix-min-length)))) 1259 ) 1260 ;; The next two forms should happen as a unit (atomically) but 1261 ;; no fatal errors should result if that is not the case. 1262 (cond (prefix-entry 1263 ;; These two should be atomic, but nothing fatal will happen 1264 ;; if they're not. 1265 (setcdr (cmpl-prefix-entry-tail prefix-entry) entry) 1266 (set-cmpl-prefix-entry-tail prefix-entry entry)) 1267 (t 1268 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) 1269 )) 1270 ;; statistics 1271 (cmpl-statistics-block 1272 (note-added-completion)) 1273 ;; set symbol 1274 (set cmpl-db-symbol (car entry)) 1275 ))) 1276 1277(defun add-completion-to-head (string) 1278 "If STRING is not in the database, add it to prefix list. 1279STRING is added to the head of the appropriate prefix list. Otherwise 1280it is moved to the head of the list. 1281STRING must be longer than `completion-prefix-min-length'. 1282Updates the saved string with the supplied string. 1283This must be very fast. 1284Returns the completion entry." 1285 ;; Handle pending acceptance 1286 (if completion-to-accept (accept-completion)) 1287 ;; test if already in database 1288 (if (setq cmpl-db-entry (find-exact-completion string)) 1289 ;; found 1290 (let* ((prefix-entry (find-cmpl-prefix-entry 1291 (substring cmpl-db-downcase-string 0 1292 (cmpl-read-time-eval 1293 completion-prefix-min-length)))) 1294 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) 1295 (cmpl-ptr (cdr splice-ptr)) 1296 ) 1297 ;; update entry 1298 (set-completion-string cmpl-db-entry string) 1299 ;; move to head (if necessary) 1300 (cond (splice-ptr 1301 ;; These should all execute atomically but it is not fatal if 1302 ;; they don't. 1303 ;; splice it out 1304 (or (setcdr splice-ptr (cdr cmpl-ptr)) 1305 ;; fix up tail if necessary 1306 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) 1307 ;; splice in at head 1308 (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) 1309 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) 1310 )) 1311 cmpl-db-entry) 1312 ;; not there 1313 (let (;; create an entry 1314 (entry (make-completion string)) 1315 ;; setup the prefix 1316 (prefix-entry (find-cmpl-prefix-entry 1317 (substring cmpl-db-downcase-string 0 1318 (cmpl-read-time-eval 1319 completion-prefix-min-length)))) 1320 ) 1321 (cond (prefix-entry 1322 ;; Splice in at head 1323 (setcdr entry (cmpl-prefix-entry-head prefix-entry)) 1324 (set-cmpl-prefix-entry-head prefix-entry entry)) 1325 (t 1326 ;; Start new prefix entry 1327 (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) 1328 )) 1329 ;; statistics 1330 (cmpl-statistics-block 1331 (note-added-completion)) 1332 ;; Add it to the symbol 1333 (set cmpl-db-symbol (car entry)) 1334 ))) 1335 1336(defun delete-completion (string) 1337 "Deletes the completion from the database. 1338String must be longer than `completion-prefix-min-length'." 1339 ;; Handle pending acceptance 1340 (if completion-to-accept (accept-completion)) 1341 (if (setq cmpl-db-entry (find-exact-completion string)) 1342 ;; found 1343 (let* ((prefix-entry (find-cmpl-prefix-entry 1344 (substring cmpl-db-downcase-string 0 1345 (cmpl-read-time-eval 1346 completion-prefix-min-length)))) 1347 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) 1348 ) 1349 ;; delete symbol reference 1350 (set cmpl-db-symbol nil) 1351 ;; remove from prefix list 1352 (cond (splice-ptr 1353 ;; not at head 1354 (or (setcdr splice-ptr (cdr (cdr splice-ptr))) 1355 ;; fix up tail if necessary 1356 (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) 1357 ) 1358 (t 1359 ;; at head 1360 (or (set-cmpl-prefix-entry-head 1361 prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry))) 1362 ;; List is now empty 1363 (set cmpl-db-prefix-symbol nil)) 1364 )) 1365 (cmpl-statistics-block 1366 (note-completion-deleted)) 1367 ) 1368 (error "Unknown completion: %s. Couldn't delete it." string) 1369 )) 1370 1371;;; Tests -- 1372;;; - Add and Find - 1373;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) 1374;;; (find-exact-completion "banana") --> ("banana" 0 nil 0) 1375;;; (find-exact-completion "bana") --> nil 1376;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1377;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1378;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) 1379;;; (find-exact-completion "banish") --> ("banish" 0 nil 0) 1380;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) 1381;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1382;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) 1383;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1384;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1385;;; 1386;;; - Deleting - 1387;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) 1388;;; (delete-completion "banner") 1389;;; (find-exact-completion "banner") --> nil 1390;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1391;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1392;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) 1393;;; (delete-completion "banana") 1394;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) 1395;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) 1396;;; (delete-completion "banner") 1397;;; (delete-completion "banish") 1398;;; (find-cmpl-prefix-entry "ban") --> nil 1399;;; (delete-completion "banner") --> error 1400;;; 1401;;; - Tail - 1402;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) 1403;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1404;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) 1405;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) 1406;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) 1407;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) 1408;;; 1409 1410 1411;;;--------------------------------------------------------------------------- 1412;;; Database Update :: Interface level routines 1413;;;--------------------------------------------------------------------------- 1414;;; 1415;;; These lie on top of the database ref. functions but below the standard 1416;;; user interface level 1417 1418 1419(defun interactive-completion-string-reader (prompt) 1420 (let* ((default (symbol-under-or-before-point)) 1421 (new-prompt 1422 (if default 1423 (format "%s: (default: %s) " prompt default) 1424 (format "%s: " prompt)) 1425 ) 1426 (read (completing-read new-prompt cmpl-obarray)) 1427 ) 1428 (if (zerop (length read)) (setq read (or default ""))) 1429 (list read) 1430 )) 1431 1432(defun check-completion-length (string) 1433 (if (< (length string) completion-min-length) 1434 (error "The string \"%s\" is too short to be saved as a completion." 1435 string) 1436 (list string))) 1437 1438(defun add-completion (string &optional num-uses last-use-time) 1439 "Add STRING to completion list, or move it to head of list. 1440The completion is altered appropriately if num-uses and/or last-use-time is 1441specified." 1442 (interactive (interactive-completion-string-reader "Completion to add")) 1443 (check-completion-length string) 1444 (let* ((current-completion-source (if (interactive-p) 1445 cmpl-source-interactive 1446 current-completion-source)) 1447 (entry (add-completion-to-head string))) 1448 1449 (if num-uses (set-completion-num-uses entry num-uses)) 1450 (if last-use-time 1451 (set-completion-last-use-time entry last-use-time)) 1452 )) 1453 1454(defun add-permanent-completion (string) 1455 "Add STRING if it isn't already listed, and mark it permanent." 1456 (interactive 1457 (interactive-completion-string-reader "Completion to add permanently")) 1458 (let ((current-completion-source (if (interactive-p) 1459 cmpl-source-interactive 1460 current-completion-source)) 1461 ) 1462 (add-completion string nil t) 1463 )) 1464 1465(defun kill-completion (string) 1466 (interactive (interactive-completion-string-reader "Completion to kill")) 1467 (check-completion-length string) 1468 (delete-completion string) 1469 ) 1470 1471(defun accept-completion () 1472 "Accepts the pending completion in `completion-to-accept'. 1473This bumps num-uses. Called by `add-completion-to-head' and 1474`completion-search-reset'." 1475 (let ((string completion-to-accept) 1476 ;; if this is added afresh here, then it must be a cdabbrev 1477 (current-completion-source cmpl-source-cdabbrev) 1478 entry 1479 ) 1480 (setq completion-to-accept nil) 1481 (setq entry (add-completion-to-head string)) 1482 (set-completion-num-uses entry (1+ (completion-num-uses entry))) 1483 (setq cmpl-completions-accepted-p t) 1484 )) 1485 1486(defun use-completion-under-point () 1487 "Add the completion symbol underneath the point into the completion buffer." 1488 (let ((string (and enable-completion (symbol-under-point))) 1489 (current-completion-source cmpl-source-cursor-moves)) 1490 (if string (add-completion-to-head string)))) 1491 1492(defun use-completion-before-point () 1493 "Add the completion symbol before point into the completion buffer." 1494 (let ((string (and enable-completion (symbol-before-point))) 1495 (current-completion-source cmpl-source-cursor-moves)) 1496 (if string (add-completion-to-head string)))) 1497 1498(defun use-completion-under-or-before-point () 1499 "Add the completion symbol before point into the completion buffer." 1500 (let ((string (and enable-completion (symbol-under-or-before-point))) 1501 (current-completion-source cmpl-source-cursor-moves)) 1502 (if string (add-completion-to-head string)))) 1503 1504(defun use-completion-before-separator () 1505 "Add the completion symbol before point into the completion buffer. 1506Completions added this way will automatically be saved if 1507`completion-on-separator-character' is non-nil." 1508 (let ((string (and enable-completion (symbol-before-point))) 1509 (current-completion-source cmpl-source-separator) 1510 entry) 1511 (cmpl-statistics-block 1512 (note-separator-character string) 1513 ) 1514 (cond (string 1515 (setq entry (add-completion-to-head string)) 1516 (when (and completion-on-separator-character 1517 (zerop (completion-num-uses entry))) 1518 (set-completion-num-uses entry 1) 1519 (setq cmpl-completions-accepted-p t) 1520 ))) 1521 )) 1522 1523;;; Tests -- 1524;;; - Add and Find - 1525;;; (add-completion "banana" 5 10) 1526;;; (find-exact-completion "banana") --> ("banana" 5 10 0) 1527;;; (add-completion "banana" 6) 1528;;; (find-exact-completion "banana") --> ("banana" 6 10 0) 1529;;; (add-completion "banish") 1530;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) 1531;;; 1532;;; - Accepting - 1533;;; (setq completion-to-accept "banana") 1534;;; (accept-completion) 1535;;; (find-exact-completion "banana") --> ("banana" 7 10) 1536;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) 1537;;; (setq completion-to-accept "banish") 1538;;; (add-completion "banner") 1539;;; (car (find-cmpl-prefix-entry "ban")) 1540;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) 1541;;; 1542;;; - Deleting - 1543;;; (kill-completion "banish") 1544;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) 1545 1546 1547;;;--------------------------------------------------------------------------- 1548;;; Searching the database 1549;;;--------------------------------------------------------------------------- 1550;;; Functions outside this block must call completion-search-reset followed 1551;;; by calls to completion-search-next or completion-search-peek 1552;;; 1553 1554;;; Status variables 1555;; Commented out to improve loading speed 1556(defvar cmpl-test-string "") 1557;; "The current string used by completion-search-next." 1558(defvar cmpl-test-regexp "") 1559;; "The current regexp used by completion-search-next. 1560;; (derived from cmpl-test-string)" 1561(defvar cmpl-last-index 0) 1562;; "The last index that completion-search-next was called with." 1563(defvar cmpl-cdabbrev-reset-p nil) 1564;; "Set to t when cdabbrevs have been reset." 1565(defvar cmpl-next-possibilities nil) 1566;; "A pointer to the element BEFORE the next set of possible completions. 1567;; cadr of this is the cmpl-next-possibility" 1568(defvar cmpl-starting-possibilities nil) 1569;; "The initial list of starting possibilities." 1570(defvar cmpl-next-possibility nil) 1571;; "The cached next possibility." 1572(defvar cmpl-tried-list nil) 1573;; "A downcased list of all the completions we have tried." 1574 1575 1576(defun completion-search-reset (string) 1577 "Set up the for completion searching for STRING. 1578STRING must be longer than `completion-prefix-min-length'." 1579 (if completion-to-accept (accept-completion)) 1580 (setq cmpl-starting-possibilities 1581 (cmpl-prefix-entry-head 1582 (find-cmpl-prefix-entry 1583 (downcase (substring string 0 completion-prefix-min-length)))) 1584 cmpl-test-string string 1585 cmpl-test-regexp (concat (regexp-quote string) ".")) 1586 (completion-search-reset-1) 1587 ) 1588 1589(defun completion-search-reset-1 () 1590 (setq cmpl-next-possibilities cmpl-starting-possibilities 1591 cmpl-next-possibility nil 1592 cmpl-cdabbrev-reset-p nil 1593 cmpl-last-index -1 1594 cmpl-tried-list nil 1595 )) 1596 1597(defun completion-search-next (index) 1598 "Return the next completion entry. 1599If INDEX is out of sequence, reset and start from the top. 1600If there are no more entries, try cdabbrev and returns only a string." 1601 (cond 1602 ((= index (setq cmpl-last-index (1+ cmpl-last-index))) 1603 (completion-search-peek t)) 1604 ((minusp index) 1605 (completion-search-reset-1) 1606 (setq cmpl-last-index index) 1607 ;; reverse the possibilities list 1608 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities)) 1609 ;; do a "normal" search 1610 (while (and (completion-search-peek nil) 1611 (minusp (setq index (1+ index)))) 1612 (setq cmpl-next-possibility nil) 1613 ) 1614 (cond ((not cmpl-next-possibilities)) 1615 ;; If no more possibilities, leave it that way 1616 ((= -1 cmpl-last-index) 1617 ;; next completion is at index 0. reset next-possibility list 1618 ;; to start at beginning 1619 (setq cmpl-next-possibilities cmpl-starting-possibilities)) 1620 (t 1621 ;; otherwise point to one before current 1622 (setq cmpl-next-possibilities 1623 (nthcdr (- (length cmpl-starting-possibilities) 1624 (length cmpl-next-possibilities)) 1625 cmpl-starting-possibilities)) 1626 ))) 1627 (t 1628 ;; non-negative index, reset and search 1629 ;;(prin1 'reset) 1630 (completion-search-reset-1) 1631 (setq cmpl-last-index index) 1632 (while (and (completion-search-peek t) 1633 (not (minusp (setq index (1- index))))) 1634 (setq cmpl-next-possibility nil) 1635 )) 1636 ) 1637 (prog1 1638 cmpl-next-possibility 1639 (setq cmpl-next-possibility nil) 1640 )) 1641 1642 1643(defun completion-search-peek (use-cdabbrev) 1644 "Returns the next completion entry without actually moving the pointers. 1645Calling this again or calling `completion-search-next' results in the same 1646string being returned. Depends on `case-fold-search'. 1647If there are no more entries, try cdabbrev and then return only a string." 1648 (cond 1649 ;; return the cached value if we have it 1650 (cmpl-next-possibility) 1651 ((and cmpl-next-possibilities 1652 ;; still a few possibilities left 1653 (progn 1654 (while 1655 (and (not (eq 0 (string-match cmpl-test-regexp 1656 (completion-string (car cmpl-next-possibilities))))) 1657 (setq cmpl-next-possibilities (cdr cmpl-next-possibilities)) 1658 )) 1659 cmpl-next-possibilities 1660 )) 1661 ;; successful match 1662 (setq cmpl-next-possibility (car cmpl-next-possibilities) 1663 cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility)) 1664 cmpl-tried-list) 1665 cmpl-next-possibilities (cdr cmpl-next-possibilities) 1666 ) 1667 cmpl-next-possibility) 1668 (use-cdabbrev 1669 ;; unsuccessful, use cdabbrev 1670 (cond ((not cmpl-cdabbrev-reset-p) 1671 (reset-cdabbrev cmpl-test-string cmpl-tried-list) 1672 (setq cmpl-cdabbrev-reset-p t) 1673 )) 1674 (setq cmpl-next-possibility (next-cdabbrev)) 1675 ) 1676 ;; Completely unsuccessful, return nil 1677 )) 1678 1679;;; Tests -- 1680;;; - Add and Find - 1681;;; (add-completion "banana") 1682;;; (completion-search-reset "ban") 1683;;; (completion-search-next 0) --> "banana" 1684;;; 1685;;; - Discrimination - 1686;;; (add-completion "cumberland") 1687;;; (add-completion "cumberbund") 1688;;; cumbering 1689;;; (completion-search-reset "cumb") 1690;;; (completion-search-peek t) --> "cumberbund" 1691;;; (completion-search-next 0) --> "cumberbund" 1692;;; (completion-search-peek t) --> "cumberland" 1693;;; (completion-search-next 1) --> "cumberland" 1694;;; (completion-search-peek nil) --> nil 1695;;; (completion-search-next 2) --> "cumbering" {cdabbrev} 1696;;; (completion-search-next 3) --> nil or "cumming"{depends on context} 1697;;; (completion-search-next 1) --> "cumberland" 1698;;; (completion-search-peek t) --> "cumbering" {cdabbrev} 1699;;; 1700;;; - Accepting - 1701;;; (completion-search-next 1) --> "cumberland" 1702;;; (setq completion-to-accept "cumberland") 1703;;; (completion-search-reset "foo") 1704;;; (completion-search-reset "cum") 1705;;; (completion-search-next 0) --> "cumberland" 1706;;; 1707;;; - Deleting - 1708;;; (kill-completion "cumberland") 1709;;; cummings 1710;;; (completion-search-reset "cum") 1711;;; (completion-search-next 0) --> "cumberbund" 1712;;; (completion-search-next 1) --> "cummings" 1713;;; 1714;;; - Ignoring Capitalization - 1715;;; (completion-search-reset "CuMb") 1716;;; (completion-search-next 0) --> "cumberbund" 1717 1718 1719 1720;;;----------------------------------------------- 1721;;; COMPLETE 1722;;;----------------------------------------------- 1723 1724(defun completion-mode () 1725 "Toggles whether or not to add new words to the completion database." 1726 (interactive) 1727 (setq enable-completion (not enable-completion)) 1728 (message "Completion mode is now %s." (if enable-completion "ON" "OFF")) 1729 ) 1730 1731(defvar cmpl-current-index 0) 1732(defvar cmpl-original-string nil) 1733(defvar cmpl-last-insert-location -1) 1734(defvar cmpl-leave-point-at-start nil) 1735 1736(defun complete (&optional arg) 1737 "Fill out a completion of the word before point. 1738Point is left at end. Consecutive calls rotate through all possibilities. 1739Prefix args :: 1740 control-u :: leave the point at the beginning of the completion rather 1741 than at the end. 1742 a number :: rotate through the possible completions by that amount 1743 `-' :: same as -1 (insert previous completion) 1744 {See the comments at the top of `completion.el' for more info.}" 1745 (interactive "*p") 1746 ;;; Set up variables 1747 (cond ((eq last-command this-command) 1748 ;; Undo last one 1749 (delete-region cmpl-last-insert-location (point)) 1750 ;; get next completion 1751 (setq cmpl-current-index (+ cmpl-current-index (or arg 1))) 1752 ) 1753 (t 1754 (if (not cmpl-initialized-p) 1755 (initialize-completions)) ;; make sure everything's loaded 1756 (cond ((consp current-prefix-arg) ;; control-u 1757 (setq arg 0) 1758 (setq cmpl-leave-point-at-start t) 1759 ) 1760 (t 1761 (setq cmpl-leave-point-at-start nil) 1762 )) 1763 ;; get string 1764 (setq cmpl-original-string (symbol-before-point-for-complete)) 1765 (cond ((not cmpl-original-string) 1766 (setq this-command 'failed-complete) 1767 (error "To complete, the point must be after a symbol at least %d character long." 1768 completion-prefix-min-length))) 1769 ;; get index 1770 (setq cmpl-current-index (if current-prefix-arg arg 0)) 1771 ;; statistics 1772 (cmpl-statistics-block 1773 (note-complete-entered-afresh cmpl-original-string)) 1774 ;; reset database 1775 (completion-search-reset cmpl-original-string) 1776 ;; erase what we've got 1777 (delete-region cmpl-symbol-start cmpl-symbol-end) 1778 )) 1779 1780 ;; point is at the point to insert the new symbol 1781 ;; Get the next completion 1782 (let* ((print-status-p 1783 (and (>= baud-rate completion-prompt-speed-threshold) 1784 (not (minibuffer-window-selected-p)))) 1785 (insert-point (point)) 1786 (entry (completion-search-next cmpl-current-index)) 1787 string 1788 ) 1789 ;; entry is either a completion entry or a string (if cdabbrev) 1790 1791 ;; If found, insert 1792 (cond (entry 1793 ;; Setup for proper case 1794 (setq string (if (stringp entry) 1795 entry (completion-string entry))) 1796 (setq string (cmpl-merge-string-cases 1797 string cmpl-original-string)) 1798 ;; insert 1799 (insert string) 1800 ;; accept it 1801 (setq completion-to-accept string) 1802 ;; fixup and cache point 1803 (cond (cmpl-leave-point-at-start 1804 (setq cmpl-last-insert-location (point)) 1805 (goto-char insert-point)) 1806 (t;; point at end, 1807 (setq cmpl-last-insert-location insert-point)) 1808 ) 1809 ;; statistics 1810 (cmpl-statistics-block 1811 (note-complete-inserted entry cmpl-current-index)) 1812 ;; Done ! cmpl-stat-complete-successful 1813 ;;display the next completion 1814 (cond 1815 ((and print-status-p 1816 ;; This updates the display and only prints if there 1817 ;; is no typeahead 1818 (sit-for 0) 1819 (setq entry 1820 (completion-search-peek 1821 completion-cdabbrev-prompt-flag))) 1822 (setq string (if (stringp entry) 1823 entry (completion-string entry))) 1824 (setq string (cmpl-merge-string-cases 1825 string cmpl-original-string)) 1826 (message "Next completion: %s" string) 1827 )) 1828 ) 1829 (t;; none found, insert old 1830 (insert cmpl-original-string) 1831 ;; Don't accept completions 1832 (setq completion-to-accept nil) 1833 ;; print message 1834 ;; This used to call cmpl19-sit-for, an undefined function. 1835 ;; I hope that sit-for does the right thing; I don't know -- rms. 1836 (if (and print-status-p (sit-for 0)) 1837 (message "No %scompletions." 1838 (if (eq this-command last-command) "more " ""))) 1839 ;; statistics 1840 (cmpl-statistics-block 1841 (record-complete-failed cmpl-current-index)) 1842 ;; Pretend that we were never here 1843 (setq this-command 'failed-complete) 1844 )))) 1845 1846;;;----------------------------------------------- 1847;;; "Complete" Key Keybindings 1848;;;----------------------------------------------- 1849 1850(global-set-key "\M-\r" 'complete) 1851(global-set-key [?\C-\r] 'complete) 1852(define-key function-key-map [C-return] [?\C-\r]) 1853 1854;;; Tests - 1855;;; (add-completion "cumberland") 1856;;; (add-completion "cumberbund") 1857;;; cum 1858;;; Cumber 1859;;; cumbering 1860;;; cumb 1861 1862 1863;;;--------------------------------------------------------------------------- 1864;;; Parsing definitions from files into the database 1865;;;--------------------------------------------------------------------------- 1866 1867;;;----------------------------------------------- 1868;;; Top Level functions :: 1869;;;----------------------------------------------- 1870 1871;;; User interface 1872(defun add-completions-from-file (file) 1873 "Parse possible completions from a file and add them to data base." 1874 (interactive "fFile: ") 1875 (setq file (expand-file-name file)) 1876 (let* ((buffer (get-file-buffer file)) 1877 (buffer-already-there-p buffer) 1878 ) 1879 (when (not buffer-already-there-p) 1880 (let ((completions-merging-modes nil)) 1881 (setq buffer (find-file-noselect file)) 1882 )) 1883 (unwind-protect 1884 (save-excursion 1885 (set-buffer buffer) 1886 (add-completions-from-buffer) 1887 ) 1888 (when (not buffer-already-there-p) 1889 (kill-buffer buffer)) 1890 ))) 1891 1892(defun add-completions-from-buffer () 1893 (interactive) 1894 (let ((current-completion-source cmpl-source-file-parsing) 1895 (start-num 1896 (cmpl-statistics-block 1897 (aref completion-add-count-vector cmpl-source-file-parsing))) 1898 mode 1899 ) 1900 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode)) 1901 (add-completions-from-lisp-buffer) 1902 (setq mode 'lisp) 1903 ) 1904 ((memq major-mode '(c-mode)) 1905 (add-completions-from-c-buffer) 1906 (setq mode 'c) 1907 ) 1908 (t 1909 (error "Do not know how to parse completions in %s buffers." 1910 major-mode) 1911 )) 1912 (cmpl-statistics-block 1913 (record-cmpl-parse-file 1914 mode (point-max) 1915 (- (aref completion-add-count-vector cmpl-source-file-parsing) 1916 start-num))) 1917 )) 1918 1919;;; Find file hook 1920(defun cmpl-find-file-hook () 1921 (cond (enable-completion 1922 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) 1923 (memq 'lisp completions-merging-modes) 1924 ) 1925 (add-completions-from-buffer)) 1926 ((and (memq major-mode '(c-mode)) 1927 (memq 'c completions-merging-modes) 1928 ) 1929 (add-completions-from-buffer) 1930 ))) 1931 )) 1932 1933(pushnew 'cmpl-find-file-hook find-file-hooks) 1934 1935;;;----------------------------------------------- 1936;;; Tags Table Completions 1937;;;----------------------------------------------- 1938 1939(defun add-completions-from-tags-table () 1940 ;; Inspired by eero@media-lab.media.mit.edu 1941 "Add completions from the current tags table." 1942 (interactive) 1943 (visit-tags-table-buffer) ;this will prompt if no tags-table 1944 (save-excursion 1945 (goto-char (point-min)) 1946 (let (string) 1947 (condition-case e 1948 (while t 1949 (search-forward "\177") 1950 (backward-char 3) 1951 (and (setq string (symbol-under-point)) 1952 (add-completion-to-tail-if-new string)) 1953 (forward-char 3) 1954 ) 1955 (search-failed) 1956 )))) 1957 1958 1959;;;----------------------------------------------- 1960;;; Lisp File completion parsing 1961;;;----------------------------------------------- 1962;;; This merely looks for phrases beginning with (def.... or 1963;;; (package:def ... and takes the next word. 1964;;; 1965;;; We tried using forward-lines and explicit searches but the regexp technique 1966;;; was faster. (About 100K characters per second) 1967;;; 1968(defconst *lisp-def-regexp* 1969 "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" 1970 "A regexp that searches for lisp definition form." 1971 ) 1972 1973;;; Tests - 1974;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 1975;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 1976;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 1977;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 1978 1979;;; Parses all the definition names from a Lisp mode buffer and adds them to 1980;;; the completion database. 1981(defun add-completions-from-lisp-buffer () 1982 ;;; Benchmarks 1983 ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second 1984 (let (string) 1985 (save-excursion 1986 (goto-char (point-min)) 1987 (condition-case e 1988 (while t 1989 (re-search-forward *lisp-def-regexp*) 1990 (and (setq string (symbol-under-point)) 1991 (add-completion-to-tail-if-new string)) 1992 ) 1993 (search-failed) 1994 )))) 1995 1996 1997;;;----------------------------------------------- 1998;;; C file completion parsing 1999;;;----------------------------------------------- 2000;;; C : 2001;;; Looks for #define or [<storage class>] [<type>] <name>{,<name>} 2002;;; or structure, array or pointer defs. 2003;;; It gets most of the definition names. 2004;;; 2005;;; As you might suspect by now, we use some symbol table hackery 2006;;; 2007;;; Symbol separator chars (have whitespace syntax) --> , ; * = ( 2008;;; Opening char --> [ { 2009;;; Closing char --> ] } 2010;;; opening and closing must be skipped over 2011;;; Whitespace chars (have symbol syntax) 2012;;; Everything else has word syntax 2013 2014(defun cmpl-make-c-def-completion-syntax-table () 2015 (let ((table (make-vector 256 0)) 2016 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) 2017 ;; unfortunately the ?( causes the parens to appear unbalanced 2018 (separator-chars '(?, ?* ?= ?\( ?\; 2019 )) 2020 ) 2021 ;; default syntax is whitespace 2022 (dotimes (i 256) 2023 (modify-syntax-entry i "w" table)) 2024 (dolist (char whitespace-chars) 2025 (modify-syntax-entry char "_" table)) 2026 (dolist (char separator-chars) 2027 (modify-syntax-entry char " " table)) 2028 (modify-syntax-entry ?\[ "(]" table) 2029 (modify-syntax-entry ?\{ "(}" table) 2030 (modify-syntax-entry ?\] ")[" table) 2031 (modify-syntax-entry ?\} "){" table) 2032 table)) 2033 2034(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) 2035 2036;;; Regexps 2037(defconst *c-def-regexp* 2038 ;; This stops on lines with possible definitions 2039 "\n[_a-zA-Z#]" 2040 ;; This stops after the symbol to add. 2041 ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)" 2042 ;; This stops before the symbol to add. {Test cases in parens. below} 2043 ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)" 2044 ;; this simple version picks up too much extraneous stuff 2045 ;; "\n\\(\\w\\|\\s_\\|#\\)\\B" 2046 "A regexp that searches for a definition form." 2047 ) 2048; 2049;(defconst *c-cont-regexp* 2050; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)" 2051; "This regexp should be used in a looking-at to parse for lists of variables.") 2052; 2053;(defconst *c-struct-regexp* 2054; "\\(*\\|\\s \\)*\\b" 2055; "This regexp should be used to test whether a symbol follows a structure definition.") 2056 2057;(defun test-c-def-regexp (regexp string) 2058; (and (eq 0 (string-match regexp string)) (match-end 0)) 2059; ) 2060 2061;;; Tests - 2062;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) 2063;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) 2064;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) 2065;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil 2066;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 2067;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 2068;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 2069;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil 2070;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 2071;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 2072;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil 2073 2074;;; Parses all the definition names from a C mode buffer and adds them to the 2075;;; completion database. 2076(defun add-completions-from-c-buffer () 2077 ;; Benchmark -- 2078 ;; Sun 3/280-- 1250 lines/sec. 2079 2080 (let (string next-point char 2081 (saved-syntax (syntax-table)) 2082 ) 2083 (save-excursion 2084 (goto-char (point-min)) 2085 (catch 'finish-add-completions 2086 (unwind-protect 2087 (while t 2088 ;; we loop here only when scan-sexps fails 2089 ;; (i.e. unbalance exps.) 2090 (set-syntax-table cmpl-c-def-syntax-table) 2091 (condition-case e 2092 (while t 2093 (re-search-forward *c-def-regexp*) 2094 (cond 2095 ((= (preceding-char) ?#) 2096 ;; preprocessor macro, see if it's one we handle 2097 (setq string (buffer-substring (point) (+ (point) 6))) 2098 (cond ((or (string-equal string "define") 2099 (string-equal string "ifdef ") 2100 ) 2101 ;; skip forward over definition symbol 2102 ;; and add it to database 2103 (and (forward-word 2) 2104 (setq string (symbol-before-point)) 2105 ;;(push string foo) 2106 (add-completion-to-tail-if-new string) 2107 )))) 2108 (t 2109 ;; C definition 2110 (setq next-point (point)) 2111 (while (and 2112 next-point 2113 ;; scan to next separator char. 2114 (setq next-point (scan-sexps next-point 1)) 2115 ) 2116 ;; position the point on the word we want to add 2117 (goto-char next-point) 2118 (while (= (setq char (following-char)) ?*) 2119 ;; handle pointer ref 2120 ;; move to next separator char. 2121 (goto-char 2122 (setq next-point (scan-sexps (point) 1))) 2123 ) 2124 (forward-word -1) 2125 ;; add to database 2126 (if (setq string (symbol-under-point)) 2127 ;; (push string foo) 2128 (add-completion-to-tail-if-new string) 2129 ;; Local TMC hack (useful for parsing paris.h) 2130 (if (and (looking-at "_AP") ;; "ansi prototype" 2131 (progn 2132 (forward-word -1) 2133 (setq string 2134 (symbol-under-point)) 2135 )) 2136 (add-completion-to-tail-if-new string) 2137 ) 2138 ) 2139 ;; go to next 2140 (goto-char next-point) 2141 ;; (push (format "%c" (following-char)) foo) 2142 (if (= (char-syntax char) ?\() 2143 ;; if on an opening delimiter, go to end 2144 (while (= (char-syntax char) ?\() 2145 (setq next-point (scan-sexps next-point 1) 2146 char (char-after next-point)) 2147 ) 2148 (or (= char ?,) 2149 ;; Current char is an end char. 2150 (setq next-point nil) 2151 )) 2152 )))) 2153 (search-failed ;;done 2154 (throw 'finish-add-completions t) 2155 ) 2156 (error 2157 ;; Check for failure in scan-sexps 2158 (if (or (string-equal (second e) 2159 "Containing expression ends prematurely") 2160 (string-equal (second e) "Unbalanced parentheses")) 2161 ;; unbalanced paren., keep going 2162 ;;(ding) 2163 (forward-line 1) 2164 (message "Error parsing C buffer for completions. Please bug report.") 2165 (throw 'finish-add-completions t) 2166 )) 2167 )) 2168 (set-syntax-table saved-syntax) 2169 ))))) 2170 2171 2172;;;--------------------------------------------------------------------------- 2173;;; Init files 2174;;;--------------------------------------------------------------------------- 2175 2176;;; The version of save-completions-to-file called at kill-emacs time. 2177(defun kill-emacs-save-completions () 2178 (when (and save-completions-flag enable-completion cmpl-initialized-p) 2179 (cond 2180 ((not cmpl-completions-accepted-p) 2181 (message "Completions database has not changed - not writing.")) 2182 (t 2183 (save-completions-to-file) 2184 )) 2185 )) 2186 2187;; There is no point bothering to change this again 2188;; unless the package changes so much that it matters 2189;; for people that have saved completions. 2190(defconst completion-version "11") 2191 2192(defconst saved-cmpl-file-header 2193 ";;; Completion Initialization file. 2194;;; Version = %s 2195;;; Format is (<string> . <last-use-time>) 2196;;; <string> is the completion 2197;;; <last-use-time> is the time the completion was last used 2198;;; If it is t, the completion will never be pruned from the file. 2199;;; Otherwise it is in hours since origin. 2200\n") 2201 2202(defun completion-backup-filename (filename) 2203 (concat filename ".BAK")) 2204 2205(defun save-completions-to-file (&optional filename) 2206 "Save completions in init file FILENAME. 2207If file name is not specified, use `save-completions-file-name'." 2208 (interactive) 2209 (setq filename (expand-file-name (or filename save-completions-file-name))) 2210 (when (file-writable-p filename) 2211 (if (not cmpl-initialized-p) 2212 (initialize-completions));; make sure everything's loaded 2213 (message "Saving completions to file %s" filename) 2214 2215 (let* ((trim-versions-without-asking t) 2216 (kept-old-versions 0) 2217 (kept-new-versions completions-file-versions-kept) 2218 last-use-time 2219 (current-time (cmpl-hours-since-origin)) 2220 (total-in-db 0) 2221 (total-perm 0) 2222 (total-saved 0) 2223 (backup-filename (completion-backup-filename filename)) 2224 ) 2225 2226 (save-excursion 2227 (get-buffer-create " *completion-save-buffer*") 2228 (set-buffer " *completion-save-buffer*") 2229 (setq buffer-file-name filename) 2230 2231 (when (not (verify-visited-file-modtime (current-buffer))) 2232 ;; file has changed on disk. Bring us up-to-date 2233 (message "Completion file has changed. Merging. . .") 2234 (load-completions-from-file filename t) 2235 (message "Merging finished. Saving completions to file %s" filename) 2236 ) 2237 2238 ;; prepare the buffer to be modified 2239 (clear-visited-file-modtime) 2240 (erase-buffer) 2241 ;; (/ 1 0) 2242 (insert (format saved-cmpl-file-header completion-version)) 2243 (dolist (completion (list-all-completions)) 2244 (setq total-in-db (1+ total-in-db)) 2245 (setq last-use-time (completion-last-use-time completion)) 2246 ;; Update num uses and maybe write completion to a file 2247 (cond ((or;; Write to file if 2248 ;; permanent 2249 (and (eq last-use-time t) 2250 (setq total-perm (1+ total-perm))) 2251 ;; or if 2252 (if (plusp (completion-num-uses completion)) 2253 ;; it's been used 2254 (setq last-use-time current-time) 2255 ;; or it was saved before and 2256 (and last-use-time 2257 ;; save-completions-retention-time is nil 2258 (or (not save-completions-retention-time) 2259 ;; or time since last use is < ...retention-time* 2260 (< (- current-time last-use-time) 2261 save-completions-retention-time)) 2262 ))) 2263 ;; write to file 2264 (setq total-saved (1+ total-saved)) 2265 (insert (prin1-to-string (cons (completion-string completion) 2266 last-use-time)) "\n") 2267 ))) 2268 2269 ;; write the buffer 2270 (condition-case e 2271 (let ((file-exists-p (file-exists-p filename))) 2272 (when file-exists-p 2273 ;; If file exists . . . 2274 ;; Save a backup(so GNU doesn't screw us when we're out of disk) 2275 ;; (GNU leaves a 0 length file if it gets a disk full error!) 2276 2277 ;; If backup doesn't exit, Rename current to backup 2278 ;; {If backup exists the primary file is probably messed up} 2279 (unless (file-exists-p backup-filename) 2280 (rename-file filename backup-filename)) 2281 ;; Copy the backup back to the current name 2282 ;; (so versioning works) 2283 (copy-file backup-filename filename t) 2284 ) 2285 ;; Save it 2286 (save-buffer) 2287 (when file-exists-p 2288 ;; If successful, remove backup 2289 (delete-file backup-filename) 2290 )) 2291 (error 2292 (set-buffer-modified-p nil) 2293 (message "Couldn't save completion file %s." filename) 2294 )) 2295 ;; Reset accepted-p flag 2296 (setq cmpl-completions-accepted-p nil) 2297 ) 2298 (cmpl-statistics-block 2299 (record-save-completions total-in-db total-perm total-saved)) 2300 ))) 2301 2302;;;(defun autosave-completions () 2303;;; (when (and save-completions-flag enable-completion cmpl-initialized-p 2304;;; *completion-auto-save-period* 2305;;; (> cmpl-emacs-idle-time *completion-auto-save-period*) 2306;;; cmpl-completions-accepted-p) 2307;;; (save-completions-to-file) 2308;;; )) 2309 2310;;;(pushnew 'autosave-completions cmpl-emacs-idle-time-hooks) 2311 2312(defun load-completions-from-file (&optional filename no-message-p) 2313 "Loads a completion init file FILENAME. 2314If file is not specified, then use `save-completions-file-name'." 2315 (interactive) 2316 (setq filename (expand-file-name (or filename save-completions-file-name))) 2317 (let* ((backup-filename (completion-backup-filename filename)) 2318 (backup-readable-p (file-readable-p backup-filename)) 2319 ) 2320 (when backup-readable-p (setq filename backup-filename)) 2321 (when (file-readable-p filename) 2322 (if (not no-message-p) 2323 (message "Loading completions from %sfile %s . . ." 2324 (if backup-readable-p "backup " "") filename)) 2325 (save-excursion 2326 (get-buffer-create " *completion-save-buffer*") 2327 (set-buffer " *completion-save-buffer*") 2328 (setq buffer-file-name filename) 2329 ;; prepare the buffer to be modified 2330 (clear-visited-file-modtime) 2331 (erase-buffer) 2332 2333 (let ((insert-okay-p nil) 2334 (buffer (current-buffer)) 2335 (current-time (cmpl-hours-since-origin)) 2336 string num-uses entry last-use-time 2337 cmpl-entry cmpl-last-use-time 2338 (current-completion-source cmpl-source-init-file) 2339 (start-num 2340 (cmpl-statistics-block 2341 (aref completion-add-count-vector cmpl-source-file-parsing))) 2342 (total-in-file 0) (total-perm 0) 2343 ) 2344 ;; insert the file into a buffer 2345 (condition-case e 2346 (progn (insert-file-contents filename t) 2347 (setq insert-okay-p t)) 2348 2349 (file-error 2350 (message "File error trying to load completion file %s." 2351 filename))) 2352 ;; parse it 2353 (when insert-okay-p 2354 (goto-char (point-min)) 2355 2356 (condition-case e 2357 (while t 2358 (setq entry (read buffer)) 2359 (setq total-in-file (1+ total-in-file)) 2360 (cond 2361 ((and (consp entry) 2362 (stringp (setq string (car entry))) 2363 (cond 2364 ((eq (setq last-use-time (cdr entry)) 'T) 2365 ;; handle case sensitivity 2366 (setq total-perm (1+ total-perm)) 2367 (setq last-use-time t)) 2368 ((eq last-use-time t) 2369 (setq total-perm (1+ total-perm))) 2370 ((integerp last-use-time)) 2371 )) 2372 ;; Valid entry 2373 ;; add it in 2374 (setq cmpl-last-use-time 2375 (completion-last-use-time 2376 (setq cmpl-entry 2377 (add-completion-to-tail-if-new string)) 2378 )) 2379 (if (or (eq last-use-time t) 2380 (and (> last-use-time 1000);;backcompatibility 2381 (not (eq cmpl-last-use-time t)) 2382 (or (not cmpl-last-use-time) 2383 ;; more recent 2384 (> last-use-time cmpl-last-use-time)) 2385 )) 2386 ;; update last-use-time 2387 (set-completion-last-use-time cmpl-entry last-use-time) 2388 )) 2389 (t 2390 ;; Bad format 2391 (message "Error: invalid saved completion - %s" 2392 (prin1-to-string entry)) 2393 ;; try to get back in sync 2394 (search-forward "\n(") 2395 ))) 2396 (search-failed 2397 (message "End of file while reading completions.") 2398 ) 2399 (end-of-file 2400 (if (= (point) (point-max)) 2401 (if (not no-message-p) 2402 (message "Loading completions from file %s . . . Done." 2403 filename)) 2404 (message "End of file while reading completions.") 2405 )) 2406 )) 2407 2408 (cmpl-statistics-block 2409 (record-load-completions 2410 total-in-file total-perm 2411 (- (aref completion-add-count-vector cmpl-source-init-file) 2412 start-num))) 2413 2414 ))))) 2415 2416(defun initialize-completions () 2417 "Load the default completions file. 2418Also sets up so that exiting emacs will automatically save the file." 2419 (interactive) 2420 (cond ((not cmpl-initialized-p) 2421 (load-completions-from-file) 2422 )) 2423 (setq cmpl-initialized-p t) 2424 ) 2425 2426 2427;;;----------------------------------------------- 2428;;; Kill EMACS patch 2429;;;----------------------------------------------- 2430 2431(add-hook 'kill-emacs-hook 2432 '(lambda () 2433 (kill-emacs-save-completions) 2434 (cmpl-statistics-block 2435 (record-cmpl-kill-emacs)))) 2436 2437;;;----------------------------------------------- 2438;;; Kill region patch 2439;;;----------------------------------------------- 2440 2441(defun completion-kill-region (&optional beg end) 2442 "Kill between point and mark. 2443The text is deleted but saved in the kill ring. 2444The command \\[yank] can retrieve it from there. 2445/(If you want to kill and then yank immediately, use \\[copy-region-as-kill].) 2446 2447This is the primitive for programs to kill text (as opposed to deleting it). 2448Supply two arguments, character numbers indicating the stretch of text 2449 to be killed. 2450Any command that calls this function is a \"kill command\". 2451If the previous command was also a kill command, 2452the text killed this time appends to the text killed last time 2453to make one entry in the kill ring. 2454Patched to remove the most recent completion." 2455 (interactive "r") 2456 (cond ((eq last-command 'complete) 2457 (delete-region (point) cmpl-last-insert-location) 2458 (insert cmpl-original-string) 2459 (setq completion-to-accept nil) 2460 (cmpl-statistics-block 2461 (record-complete-failed))) 2462 (t 2463 (kill-region beg end)))) 2464 2465(global-set-key "\C-w" 'completion-kill-region) 2466 2467;;;----------------------------------------------- 2468;;; Patches to self-insert-command. 2469;;;----------------------------------------------- 2470 2471;;; Need 2 versions: generic separator chars. and space (to get auto fill 2472;;; to work) 2473 2474;;; All common separators (eg. space "(" ")" """) characters go through a 2475;;; function to add new words to the list of words to complete from: 2476;;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). 2477;;; If the character before this was an alpha-numeric then this adds the 2478;;; symbol before point to the completion list (using ADD-COMPLETION). 2479 2480(defun completion-separator-self-insert-command (arg) 2481 (interactive "p") 2482 (use-completion-before-separator) 2483 (self-insert-command arg) 2484 ) 2485 2486(defun completion-separator-self-insert-autofilling (arg) 2487 (interactive "p") 2488 (use-completion-before-separator) 2489 (self-insert-command arg) 2490 (and (> (current-column) fill-column) 2491 auto-fill-function 2492 (funcall auto-fill-function)) 2493 ) 2494 2495;;;----------------------------------------------- 2496;;; Wrapping Macro 2497;;;----------------------------------------------- 2498 2499;;; Note that because of the way byte compiling works, none of 2500;;; the functions defined with this macro get byte compiled. 2501 2502(defmacro def-completion-wrapper (function-name type &optional new-name) 2503 "Add a call to update the completion database before function execution. 2504TYPE is the type of the wrapper to be added. Can be :before or :under." 2505 (cond ((eq type ':separator) 2506 (list 'put (list 'quote function-name) ''completion-function 2507 ''use-completion-before-separator)) 2508 ((eq type ':before) 2509 (list 'put (list 'quote function-name) ''completion-function 2510 ''use-completion-before-point)) 2511 ((eq type ':backward-under) 2512 (list 'put (list 'quote function-name) ''completion-function 2513 ''use-completion-backward-under)) 2514 ((eq type ':backward) 2515 (list 'put (list 'quote function-name) ''completion-function 2516 ''use-completion-backward)) 2517 ((eq type ':under) 2518 (list 'put (list 'quote function-name) ''completion-function 2519 ''use-completion-under-point)) 2520 ((eq type ':under-or-before) 2521 (list 'put (list 'quote function-name) ''completion-function 2522 ''use-completion-under-or-before-point)) 2523 ((eq type ':minibuffer-separator) 2524 (list 'put (list 'quote function-name) ''completion-function 2525 ''use-completion-minibuffer-separator)))) 2526 2527(defun use-completion-minibuffer-separator () 2528 (let ((cmpl-syntax-table cmpl-standard-syntax-table)) 2529 (use-completion-before-separator))) 2530 2531(defun use-completion-backward-under () 2532 (use-completion-under-point) 2533 (if (eq last-command 'complete) 2534 ;; probably a failed completion if you have to back up 2535 (cmpl-statistics-block (record-complete-failed)))) 2536 2537(defun use-completion-backward () 2538 (if (eq last-command 'complete) 2539 ;; probably a failed completion if you have to back up 2540 (cmpl-statistics-block (record-complete-failed)))) 2541 2542(defun completion-before-command () 2543 (funcall (or (get this-command 'completion-function) 2544 'use-completion-under-or-before-point))) 2545(add-hook 'pre-command-hook 'completion-before-command) 2546 2547 2548;;;--------------------------------------------------------------------------- 2549;;; Patches to standard keymaps insert completions 2550;;;--------------------------------------------------------------------------- 2551 2552;;;----------------------------------------------- 2553;;; Separators 2554;;;----------------------------------------------- 2555;;; We've used the completion syntax table given as a guide. 2556;;; 2557;;; Global separator chars. 2558;;; We left out <tab> because there are too many special cases for it. Also, 2559;;; in normal coding it's rarely typed after a word. 2560(global-set-key " " 'completion-separator-self-insert-autofilling) 2561(global-set-key "!" 'completion-separator-self-insert-command) 2562(global-set-key "%" 'completion-separator-self-insert-command) 2563(global-set-key "^" 'completion-separator-self-insert-command) 2564(global-set-key "&" 'completion-separator-self-insert-command) 2565(global-set-key "(" 'completion-separator-self-insert-command) 2566(global-set-key ")" 'completion-separator-self-insert-command) 2567(global-set-key "=" 'completion-separator-self-insert-command) 2568(global-set-key "`" 'completion-separator-self-insert-command) 2569(global-set-key "|" 'completion-separator-self-insert-command) 2570(global-set-key "{" 'completion-separator-self-insert-command) 2571(global-set-key "}" 'completion-separator-self-insert-command) 2572(global-set-key "[" 'completion-separator-self-insert-command) 2573(global-set-key "]" 'completion-separator-self-insert-command) 2574(global-set-key ";" 'completion-separator-self-insert-command) 2575(global-set-key "\"" 'completion-separator-self-insert-command) 2576(global-set-key "'" 'completion-separator-self-insert-command) 2577(global-set-key "#" 'completion-separator-self-insert-command) 2578(global-set-key "," 'completion-separator-self-insert-command) 2579(global-set-key "?" 'completion-separator-self-insert-command) 2580 2581;;; We include period and colon even though they are symbol chars because : 2582;;; - in text we want to pick up the last word in a sentence. 2583;;; - in C pointer refs. we want to pick up the first symbol 2584;;; - it won't make a difference for lisp mode (package names are short) 2585(global-set-key "." 'completion-separator-self-insert-command) 2586(global-set-key ":" 'completion-separator-self-insert-command) 2587 2588;;; Lisp Mode diffs 2589(define-key lisp-mode-map "!" 'self-insert-command) 2590(define-key lisp-mode-map "&" 'self-insert-command) 2591(define-key lisp-mode-map "%" 'self-insert-command) 2592(define-key lisp-mode-map "?" 'self-insert-command) 2593(define-key lisp-mode-map "=" 'self-insert-command) 2594(define-key lisp-mode-map "^" 'self-insert-command) 2595 2596;;; C mode diffs. 2597(def-completion-wrapper electric-c-semi :separator) 2598(define-key c-mode-map "+" 'completion-separator-self-insert-command) 2599(define-key c-mode-map "*" 'completion-separator-self-insert-command) 2600(define-key c-mode-map "/" 'completion-separator-self-insert-command) 2601 2602;;; FORTRAN mode diffs. (these are defined when fortran is called) 2603(defun completion-setup-fortran-mode () 2604 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) 2605 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) 2606 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) 2607 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command) 2608 ) 2609 2610;;;----------------------------------------------- 2611;;; End of line chars. 2612;;;----------------------------------------------- 2613(def-completion-wrapper newline :separator) 2614(def-completion-wrapper newline-and-indent :separator) 2615(def-completion-wrapper comint-send-input :separator) 2616(def-completion-wrapper exit-minibuffer :minibuffer-separator) 2617(def-completion-wrapper eval-print-last-sexp :separator) 2618(def-completion-wrapper eval-last-sexp :separator) 2619;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) 2620 2621;;;----------------------------------------------- 2622;;; Cursor movement 2623;;;----------------------------------------------- 2624 2625(def-completion-wrapper next-line :under-or-before) 2626(def-completion-wrapper previous-line :under-or-before) 2627(def-completion-wrapper beginning-of-buffer :under-or-before) 2628(def-completion-wrapper end-of-buffer :under-or-before) 2629(def-completion-wrapper beginning-of-line :under-or-before) 2630(def-completion-wrapper end-of-line :under-or-before) 2631(def-completion-wrapper forward-char :under-or-before) 2632(def-completion-wrapper forward-word :under-or-before) 2633(def-completion-wrapper forward-sexp :under-or-before) 2634(def-completion-wrapper backward-char :backward-under) 2635(def-completion-wrapper backward-word :backward-under) 2636(def-completion-wrapper backward-sexp :backward-under) 2637 2638(def-completion-wrapper delete-backward-char :backward) 2639(def-completion-wrapper delete-backward-char-untabify :backward) 2640 2641;;; Tests -- 2642;;; foobarbiz 2643;;; foobar 2644;;; fooquux 2645;;; fooper 2646 2647(cmpl-statistics-block 2648 (record-completion-file-loaded)) 2649 2650;;; completion.el ends here 2651