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