/[emacs]/emacs/lisp/completion.el
ViewVC logotype

Diff of /emacs/lisp/completion.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.53 by rfrancoise, Sat Sep 24 13:44:02 2005 UTC revision 1.54 by monnier, Mon Nov 28 01:43:28 2005 UTC
# Line 82  Line 82 
82  ;;  SAVING/LOADING COMPLETIONS  ;;  SAVING/LOADING COMPLETIONS
83  ;;   Completions are automatically saved from one session to another  ;;   Completions are automatically saved from one session to another
84  ;; (unless save-completions-flag or enable-completion is nil).  ;; (unless save-completions-flag or enable-completion is nil).
85  ;; Loading this file (or calling initialize-completions) causes EMACS  ;; Activating this minor-mode calling completion-initialize) causes Emacs
86  ;; to load a completions database for a saved completions file  ;; to load a completions database for a saved completions file
87  ;; (default: ~/.completions).  When you exit, EMACS saves a copy of the  ;; (default: ~/.completions).  When you exit, Emacs saves a copy of the
88  ;; completions that you  ;; completions that you
89  ;; often use.  When you next start, EMACS loads in the saved completion file.  ;; often use.  When you next start, Emacs loads in the saved completion file.
90  ;;  ;;
91  ;;   The number of completions saved depends loosely on  ;;   The number of completions saved depends loosely on
92  ;; *saved-completions-decay-factor*.  Completions that have never been  ;; *saved-completions-decay-factor*.  Completions that have never been
# Line 141  Line 141 
141  ;;         App --> Appropriately]  ;;         App --> Appropriately]
142  ;;  ;;
143  ;; INITIALIZATION  ;; INITIALIZATION
144  ;;  The form `(initialize-completions)' initializes the completion system by  ;;  The form `(completion-initialize)' initializes the completion system by
145  ;; trying to load in the user's completions.  After the first cal, further  ;; 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  ;; calls have no effect so one should be careful not to put the form in a
147  ;; site's standard site-init file.  ;; site's standard site-init file.
148  ;;  ;;
# Line 180  Line 180 
180  ;;  complete  ;;  complete
181  ;;    Inserts a completion at point  ;;    Inserts a completion at point
182  ;;  ;;
183  ;;  initialize-completions  ;;  completion-initialize
184  ;;    Loads the completions file and sets up so that exiting emacs will  ;;    Loads the completions file and sets up so that exiting emacs will
185  ;;  save them.  ;;  save them.
186  ;;  ;;
# Line 286  Line 286 
286    
287    
288  (defcustom enable-completion t  (defcustom enable-completion t
289    "*Non-nil means enable recording and saving of completions.    "Non-nil means enable recording and saving of completions.
290  If nil, no new words are added to the database or saved to the init file."  If nil, no new words are added to the database or saved to the init file."
291    :type 'boolean    :type 'boolean
292    :group 'completion)    :group 'completion)
293    
294  (defcustom save-completions-flag t  (defcustom save-completions-flag t
295    "*Non-nil means save most-used completions when exiting Emacs.    "Non-nil means save most-used completions when exiting Emacs.
296  See also `save-completions-retention-time'."  See also `save-completions-retention-time'."
297    :type 'boolean    :type 'boolean
298    :group 'completion)    :group 'completion)
299    
300  (defcustom save-completions-file-name (convert-standard-filename "~/.completions")  (defcustom save-completions-file-name
301    "*The filename to save completions to."    (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 (expand-file-name completions "~/.emacs.d/")))
306         (t olddef)))
307      "The filename to save completions to."
308    :type 'file    :type 'file
309    :group 'completion)    :group 'completion)
310    
311  (defcustom save-completions-retention-time 336  (defcustom save-completions-retention-time 336
312    "*Discard a completion if unused for this many hours.    "Discard a completion if unused for this many hours.
313  \(1 day = 24, 1 week = 168).  If this is 0, non-permanent completions  \(1 day = 24, 1 week = 168).  If this is 0, non-permanent completions
314  will not be saved unless these are used.  Default is two weeks."  will not be saved unless these are used.  Default is two weeks."
315    :type 'integer    :type 'integer
316    :group 'completion)    :group 'completion)
317    
318  (defcustom completion-on-separator-character nil  (defcustom completion-on-separator-character nil
319    "*Non-nil means separator characters mark previous word as used.    "Non-nil means separator characters mark previous word as used.
320  This means the word will be saved as a completion."  This means the word will be saved as a completion."
321    :type 'boolean    :type 'boolean
322    :group 'completion)    :group 'completion)
323    
324  (defcustom completions-file-versions-kept kept-new-versions  (defcustom completions-file-versions-kept kept-new-versions
325    "*Number of versions to keep for the saved completions file."    "Number of versions to keep for the saved completions file."
326    :type 'integer    :type 'integer
327    :group 'completion)    :group 'completion)
328    
329  (defcustom completion-prompt-speed-threshold 4800  (defcustom completion-prompt-speed-threshold 4800
330    "*Minimum output speed at which to display next potential completion."    "Minimum output speed at which to display next potential completion."
331    :type 'integer    :type 'integer
332    :group 'completion)    :group 'completion)
333    
334  (defcustom completion-cdabbrev-prompt-flag nil  (defcustom completion-cdabbrev-prompt-flag nil
335    "*If non-nil, the next completion prompt does a cdabbrev search.    "If non-nil, the next completion prompt does a cdabbrev search.
336  This can be time consuming."  This can be time consuming."
337    :type 'boolean    :type 'boolean
338    :group 'completion)    :group 'completion)
339    
340  (defcustom completion-search-distance 15000  (defcustom completion-search-distance 15000
341    "*How far to search in the buffer when looking for completions.    "How far to search in the buffer when looking for completions.
342  In number of characters.  If nil, search the whole buffer."  In number of characters.  If nil, search the whole buffer."
343    :type 'integer    :type 'integer
344    :group 'completion)    :group 'completion)
345    
346  (defcustom completions-merging-modes '(lisp c)  (defcustom completions-merging-modes '(lisp c)
347    "*List of modes {`c' or `lisp'} for automatic completions merging.    "List of modes {`c' or `lisp'} for automatic completions merging.
348  Definitions from visited files which have these modes  Definitions from visited files which have these modes
349  are automatically added to the completion database."  are automatically added to the completion database."
350    :type '(set (const lisp) (const c))    :type '(set (const lisp) (const c))
# Line 495  Used to decide whether to save completio Line 501  Used to decide whether to save completio
501  ;; Table definitions  ;; Table definitions
502  ;;-----------------------------------------------  ;;-----------------------------------------------
503    
504  (defun cmpl-make-standard-completion-syntax-table ()  (defconst completion-standard-syntax-table
505    (let ((table (make-syntax-table))    (let ((table (make-syntax-table))
506          i)          i)
507      ;; Default syntax is whitespace.      ;; Default syntax is whitespace.
# Line 523  Used to decide whether to save completio Line 529  Used to decide whether to save completio
529          (modify-syntax-entry char "w" table)))          (modify-syntax-entry char "w" table)))
530      table))      table))
531    
532  (defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table))  (defvar completion-syntax-table completion-standard-syntax-table
   
 (defun cmpl-make-lisp-completion-syntax-table ()  
   (let ((table (copy-syntax-table cmpl-standard-syntax-table))  
         (symbol-chars '(?! ?& ?? ?= ?^)))  
     (dolist (char symbol-chars)  
       (modify-syntax-entry char "_" table))  
     table))  
   
 (defun cmpl-make-c-completion-syntax-table ()  
   (let ((table (copy-syntax-table cmpl-standard-syntax-table))  
         (separator-chars '(?+ ?* ?/ ?: ?%)))  
     (dolist (char separator-chars)  
       (modify-syntax-entry char " " table))  
     table))  
   
 (defun cmpl-make-fortran-completion-syntax-table ()  
   (let ((table (copy-syntax-table cmpl-standard-syntax-table))  
         (separator-chars '(?+ ?- ?* ?/ ?:)))  
     (dolist (char separator-chars)  
       (modify-syntax-entry char " " table))  
     table))  
   
 (defconst cmpl-lisp-syntax-table       (cmpl-make-lisp-completion-syntax-table))  
 (defconst cmpl-c-syntax-table          (cmpl-make-c-completion-syntax-table))  
 (defconst cmpl-fortran-syntax-table    (cmpl-make-fortran-completion-syntax-table))  
   
 (defvar cmpl-syntax-table cmpl-standard-syntax-table  
533    "This variable holds the current completion syntax table.")    "This variable holds the current completion syntax table.")
534  (make-variable-buffer-local 'cmpl-syntax-table)  (make-variable-buffer-local 'completion-syntax-table)
535    
536  ;;-----------------------------------------------  ;;-----------------------------------------------
537  ;; Symbol functions  ;; Symbol functions
# Line 561  Used to decide whether to save completio Line 540  Used to decide whether to save completio
540    "Holds first character of symbol, after any completion symbol function.")    "Holds first character of symbol, after any completion symbol function.")
541  (defvar cmpl-symbol-end nil  (defvar cmpl-symbol-end nil
542    "Holds last character of symbol, after any completion symbol function.")    "Holds last character of symbol, after any completion symbol function.")
 ;; These are temp. vars. we use to avoid using let.  
 ;;   Why ?  Small speed improvement.  
 (defvar cmpl-saved-syntax nil)  
 (defvar cmpl-saved-point nil)  
543    
544  (defun symbol-under-point ()  (defun symbol-under-point ()
545    "Return the symbol that the point is currently on.    "Return the symbol that the point is currently on.
546  But only if it is longer than `completion-min-length'."  But only if it is longer than `completion-min-length'."
547    (setq cmpl-saved-syntax (syntax-table))    (with-syntax-table completion-syntax-table
548    (unwind-protect      (when (memq (char-syntax (following-char)) '(?w ?_))
549        (progn        ;; Cursor is on following-char and after preceding-char
550          (set-syntax-table cmpl-syntax-table)        (let ((saved-point (point)))
551          (cond          (setq cmpl-symbol-start (scan-sexps (1+ saved-point) -1)
552          ;; Cursor is on following-char and after preceding-char                cmpl-symbol-end (scan-sexps saved-point 1))
553            ((memq (char-syntax (following-char)) '(?w ?_))          ;; Remove chars to ignore at the start.
554             (setq cmpl-saved-point (point)          (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
555                   cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)                 (goto-char cmpl-symbol-start)
556                   cmpl-symbol-end (scan-sexps cmpl-saved-point 1))                 (forward-word 1)
557             ;; Remove chars to ignore at the start.                 (setq cmpl-symbol-start (point))
558             (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)                 (goto-char saved-point)))
559                    (goto-char cmpl-symbol-start)          ;; Remove chars to ignore at the end.
560                    (forward-word 1)          (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
561                    (setq cmpl-symbol-start (point))                 (goto-char cmpl-symbol-end)
562                    (goto-char cmpl-saved-point)))                 (forward-word -1)
563             ;; Remove chars to ignore at the end.                 (setq cmpl-symbol-end (point))
564             (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)                 (goto-char saved-point)))
565                    (goto-char cmpl-symbol-end)          ;; Return completion if the length is reasonable.
566                    (forward-word -1)          (if (and (<= completion-min-length
567                    (setq cmpl-symbol-end (point))                       (- cmpl-symbol-end cmpl-symbol-start))
568                    (goto-char cmpl-saved-point)))                   (<= (- cmpl-symbol-end cmpl-symbol-start)
569             ;; Return completion if the length is reasonable.                       completion-max-length))
570             (if (and (<= completion-min-length              (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))
                         (- cmpl-symbol-end cmpl-symbol-start))  
                     (<= (- cmpl-symbol-end cmpl-symbol-start)  
                         completion-max-length))  
                (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))  
     (set-syntax-table cmpl-saved-syntax)))  
571    
572  ;; tests for symbol-under-point  ;; tests for symbol-under-point
573  ;;  `^' indicates cursor pos. where value is returned  ;;  `^' indicates cursor pos. where value is returned
# Line 615  But only if it is longer than `completio Line 585  But only if it is longer than `completio
585    "Return a string of the symbol immediately before point.    "Return a string of the symbol immediately before point.
586  Returns nil if there isn't one longer than `completion-min-length'."  Returns nil if there isn't one longer than `completion-min-length'."
587    ;; This is called when a word separator is typed so it must be FAST !    ;; This is called when a word separator is typed so it must be FAST !
588    (setq cmpl-saved-syntax (syntax-table))    (with-syntax-table completion-syntax-table
589    (unwind-protect      ;; Cursor is on following-char and after preceding-char
590        (progn      (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
591          (set-syntax-table cmpl-syntax-table)             ;; Number of chars to ignore at end.
592          ;; Cursor is on following-char and after preceding-char             (setq cmpl-symbol-end (point)
593          (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)                   cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
594                 ;; Number of chars to ignore at end.             ;; Remove chars to ignore at the start.
595                 (setq cmpl-symbol-end (point)             (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
596                       cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))                    (goto-char cmpl-symbol-start)
597                 ;; Remove chars to ignore at the start.                    (forward-word 1)
598                 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)                    (setq cmpl-symbol-start (point))
599                        (goto-char cmpl-symbol-start)                    (goto-char cmpl-symbol-end)))
600                        (forward-word 1)             ;; Return value if long enough.
601                        (setq cmpl-symbol-start (point))             (if (>= cmpl-symbol-end
602                        (goto-char cmpl-symbol-end)))                     (+ cmpl-symbol-start completion-min-length))
603                 ;; Return value if long enough.                 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))
604                 (if (>= cmpl-symbol-end            ((= cmpl-preceding-syntax ?w)
605                         (+ cmpl-symbol-start completion-min-length))             ;; chars to ignore at end
606                     (buffer-substring cmpl-symbol-start cmpl-symbol-end)))             (let ((saved-point (point)))
607                ((= cmpl-preceding-syntax ?w)               (setq cmpl-symbol-start (scan-sexps saved-point -1))
608                 ;; chars to ignore at end               ;; take off chars. from end
609                 (setq cmpl-saved-point (point)               (forward-word -1)
610                       cmpl-symbol-start (scan-sexps cmpl-saved-point -1))               (setq cmpl-symbol-end (point))
611                 ;; take off chars. from end               ;; remove chars to ignore at the start
612                 (forward-word -1)               (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
613                 (setq cmpl-symbol-end (point))                      (goto-char cmpl-symbol-start)
614                 ;; remove chars to ignore at the start                      (forward-word 1)
615                 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)                      (setq cmpl-symbol-start (point))))
616                        (goto-char cmpl-symbol-start)               ;; Restore state.
617                        (forward-word 1)               (goto-char saved-point)
618                        (setq cmpl-symbol-start (point))))               ;; Return completion if the length is reasonable
619                 ;; Restore state.               (if (and (<= completion-min-length
620                 (goto-char cmpl-saved-point)                            (- cmpl-symbol-end cmpl-symbol-start))
621                 ;; Return completion if the length is reasonable                        (<= (- cmpl-symbol-end cmpl-symbol-start)
622                 (if (and (<= completion-min-length                            completion-max-length))
623                              (- cmpl-symbol-end cmpl-symbol-start))                   (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))))
                         (<= (- cmpl-symbol-end cmpl-symbol-start)  
                             completion-max-length))  
                    (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))  
     (set-syntax-table cmpl-saved-syntax)))  
624    
625  ;; tests for symbol-before-point  ;; tests for symbol-before-point
626  ;;  `^' indicates cursor pos. where value is returned  ;;  `^' indicates cursor pos. where value is returned
# Line 675  Returns nil if there isn't one longer th Line 641  Returns nil if there isn't one longer th
641    ;; copying all the code.    ;; copying all the code.
642    ;; However, it is only used by the completion string prompter.    ;; However, it is only used by the completion string prompter.
643    ;; If it comes into common use, it could be rewritten.    ;; If it comes into common use, it could be rewritten.
644    (cond ((memq (progn    (if (memq (with-syntax-table completion-syntax-table
645                   (setq cmpl-saved-syntax (syntax-table))                (char-syntax (following-char)))
646                   (unwind-protect              '(?w ?_))
647                       (progn        (symbol-under-point)
648                         (set-syntax-table cmpl-syntax-table)      (symbol-before-point)))
                        (char-syntax (following-char)))  
                    (set-syntax-table cmpl-saved-syntax)))  
                '(?w ?_))  
          (symbol-under-point))  
         (t  
          (symbol-before-point))))  
649    
650    
651  (defun symbol-before-point-for-complete ()  (defun symbol-before-point-for-complete ()
# Line 693  Returns nil if there isn't one longer th Line 653  Returns nil if there isn't one longer th
653    ;; or nil if there isn't one.  Like symbol-before-point but doesn't trim the    ;; or nil if there isn't one.  Like symbol-before-point but doesn't trim the
654    ;; end chars."    ;; end chars."
655    ;; Cursor is on following-char and after preceding-char    ;; Cursor is on following-char and after preceding-char
656    (setq cmpl-saved-syntax (syntax-table))    (with-syntax-table completion-syntax-table
657    (unwind-protect      (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
658        (progn                   '(?_ ?w))
659          (set-syntax-table cmpl-syntax-table)             (setq cmpl-symbol-end (point)
660          (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))                   cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
661                       '(?_ ?w))             ;; Remove chars to ignore at the start.
662                 (setq cmpl-symbol-end (point)             (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
663                       cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))                    (goto-char cmpl-symbol-start)
664                 ;; Remove chars to ignore at the start.                    (forward-word 1)
665                 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)                    (setq cmpl-symbol-start (point))
666                        (goto-char cmpl-symbol-start)                    (goto-char cmpl-symbol-end)))
667                        (forward-word 1)             ;; Return completion if the length is reasonable.
668                        (setq cmpl-symbol-start (point))             (if (and (<= completion-prefix-min-length
669                        (goto-char cmpl-symbol-end)))                          (- cmpl-symbol-end cmpl-symbol-start))
670                 ;; Return completion if the length is reasonable.                      (<= (- cmpl-symbol-end cmpl-symbol-start)
671                 (if (and (<= completion-prefix-min-length                          completion-max-length))
672                              (- cmpl-symbol-end cmpl-symbol-start))                 (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))
                         (<= (- cmpl-symbol-end cmpl-symbol-start)  
                             completion-max-length))  
                    (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))  
     ;; Restore syntax table.  
     (set-syntax-table cmpl-saved-syntax)))  
673    
674  ;; tests for symbol-before-point-for-complete  ;; tests for symbol-before-point-for-complete
675  ;;  `^' indicates cursor pos. where value is returned  ;;  `^' indicates cursor pos. where value is returned
# Line 866  This is sensitive to `case-fold-search'. Line 821  This is sensitive to `case-fold-search'.
821                  (setq saved-point  (point)                  (setq saved-point  (point)
822                        saved-syntax (syntax-table))                        saved-syntax (syntax-table))
823                  ;; Restore completion state                  ;; Restore completion state
824                  (set-syntax-table cmpl-syntax-table)                  (set-syntax-table completion-syntax-table)
825                  (goto-char cdabbrev-current-point)                  (goto-char cdabbrev-current-point)
826                  ;; Loop looking for completions                  ;; Loop looking for completions
827                  (while                  (while
# Line 1010  Each symbol is bound to a single complet Line 965  Each symbol is bound to a single complet
965    
966  ;; CONSTRUCTOR  ;; CONSTRUCTOR
967  (defun make-completion (string)  (defun make-completion (string)
968    "Return a list of a completion entry."    "Return a completion entry."
969    (list (list string 0 nil current-completion-source)))    (list string 0 nil current-completion-source))
970    
971  ;; Obsolete  ;; Obsolete
972  ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)  ;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
# Line 1026  Each symbol is bound to a single complet Line 981  Each symbol is bound to a single complet
981    
982  ;; READER Macros  ;; READER Macros
983    
984  (defmacro cmpl-prefix-entry-head (prefix-entry)  (defalias 'cmpl-prefix-entry-head 'car)
   (list 'car prefix-entry))  
985    
986  (defmacro cmpl-prefix-entry-tail (prefix-entry)  (defalias 'cmpl-prefix-entry-tail 'cdr)
   (list 'cdr prefix-entry))  
987    
988  ;; WRITER Macros  ;; WRITER Macros
989    
# Line 1092  Each symbol is bound to a single complet Line 1045  Each symbol is bound to a single complet
1045  ;;   These are the internal functions used to update the datebase  ;;   These are the internal functions used to update the datebase
1046  ;;  ;;
1047  ;;  ;;
1048  (defvar completion-to-accept nil)  (defvar completion-to-accept nil
1049    ;;"Set to a string that is pending its acceptance."    "Set to a string that is pending its acceptance.")
1050    ;; this checked by the top level reading functions    ;; this checked by the top level reading functions
1051    
1052  (defvar cmpl-db-downcase-string nil)  (defvar cmpl-db-downcase-string nil
1053    ;; "Setup by find-exact-completion, etc.  The given string, downcased."    "Setup by `find-exact-completion', etc.  The given string, downcased.")
1054  (defvar cmpl-db-symbol nil)  (defvar cmpl-db-symbol nil
1055    ;; "The interned symbol corresponding to cmpl-db-downcase-string.    "The interned symbol corresponding to `cmpl-db-downcase-string'.
1056    ;; Set up by cmpl-db-symbol."  Set up by `cmpl-db-symbol'.")
1057  (defvar cmpl-db-prefix-symbol nil)  (defvar cmpl-db-prefix-symbol nil
1058    ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."    "The interned prefix symbol corresponding to `cmpl-db-downcase-string'.")
1059  (defvar cmpl-db-entry nil)  (defvar cmpl-db-entry nil)
1060  (defvar cmpl-db-debug-p nil  (defvar cmpl-db-debug-p nil
1061    "Set to t if you want to debug the database.")    "Set to t if you want to debug the database.")
# Line 1190  Returns the completion entry." Line 1143  Returns the completion entry."
1143    (or (find-exact-completion string)    (or (find-exact-completion string)
1144        ;; not there        ;; not there
1145        (let (;; create an entry        (let (;; create an entry
1146              (entry (make-completion string))              (entry (list (make-completion string)))
1147              ;; setup the prefix              ;; setup the prefix
1148              (prefix-entry (find-cmpl-prefix-entry              (prefix-entry (find-cmpl-prefix-entry
1149                              (substring cmpl-db-downcase-string 0                              (substring cmpl-db-downcase-string 0
# Line 1244  Returns the completion entry." Line 1197  Returns the completion entry."
1197          cmpl-db-entry)          cmpl-db-entry)
1198      ;; not there      ;; not there
1199      (let (;; create an entry      (let (;; create an entry
1200            (entry (make-completion completion-string))            (entry (list (make-completion completion-string)))
1201            ;; setup the prefix            ;; setup the prefix
1202            (prefix-entry (find-cmpl-prefix-entry            (prefix-entry (find-cmpl-prefix-entry
1203                            (substring cmpl-db-downcase-string 0                            (substring cmpl-db-downcase-string 0
# Line 1650  Prefix args :: Line 1603  Prefix args ::
1603           (setq cmpl-current-index (+ cmpl-current-index (or arg 1))))           (setq cmpl-current-index (+ cmpl-current-index (or arg 1))))
1604          (t          (t
1605           (if (not cmpl-initialized-p)           (if (not cmpl-initialized-p)
1606               (initialize-completions)) ;; make sure everything's loaded               (completion-initialize)) ;; make sure everything's loaded
1607           (cond ((consp current-prefix-arg) ;; control-u           (cond ((consp current-prefix-arg) ;; control-u
1608                  (setq arg 0)                  (setq arg 0)
1609                  (setq cmpl-leave-point-at-start t))                  (setq cmpl-leave-point-at-start t))
# Line 1752  Prefix args :: Line 1705  Prefix args ::
1705          (let ((completions-merging-modes nil))          (let ((completions-merging-modes nil))
1706            (setq buffer (find-file-noselect file))))            (setq buffer (find-file-noselect file))))
1707      (unwind-protect      (unwind-protect
1708           (save-excursion          (with-current-buffer buffer
1709             (set-buffer buffer)            (add-completions-from-buffer))
            (add-completions-from-buffer))  
1710        (if (not buffer-already-there-p)        (if (not buffer-already-there-p)
1711            (kill-buffer buffer)))))            (kill-buffer buffer)))))
1712    
# Line 1781  Prefix args :: Line 1733  Prefix args ::
1733             start-num)))))             start-num)))))
1734    
1735  ;; Find file hook  ;; Find file hook
1736  (defun cmpl-find-file-hook ()  (defun completion-find-file-hook ()
1737    (cond (enable-completion    (cond (enable-completion
1738           (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))           (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
1739                       (memq 'lisp completions-merging-modes))                       (memq 'lisp completions-merging-modes))
# Line 1864  Prefix args :: Line 1816  Prefix args ::
1816  ;; Whitespace chars (have symbol syntax)  ;; Whitespace chars (have symbol syntax)
1817  ;; Everything else has word syntax  ;; Everything else has word syntax
1818    
1819  (defun cmpl-make-c-def-completion-syntax-table ()  (defconst completion-c-def-syntax-table
1820    (let ((table (make-syntax-table))    (let ((table (make-syntax-table))
1821          (whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))          (whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))
1822          ;; unfortunately the ?( causes the parens to appear unbalanced          ;; unfortunately the ?( causes the parens to appear unbalanced
# Line 1885  Prefix args :: Line 1837  Prefix args ::
1837      (modify-syntax-entry ?\} "){" table)      (modify-syntax-entry ?\} "){" table)
1838      table))      table))
1839    
 (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table))  
   
1840  ;; Regexps  ;; Regexps
1841  (defconst *c-def-regexp*  (defconst *c-def-regexp*
1842      ;; This stops on lines with possible definitions      ;; This stops on lines with possible definitions
# Line 1930  Prefix args :: Line 1880  Prefix args ::
1880    ;; Benchmark --    ;; Benchmark --
1881    ;;  Sun 3/280-- 1250 lines/sec.    ;;  Sun 3/280-- 1250 lines/sec.
1882    
1883    (let (string next-point char    (let (string next-point char)
         (saved-syntax (syntax-table)))  
1884      (save-excursion      (save-excursion
1885        (goto-char (point-min))        (goto-char (point-min))
1886        (catch 'finish-add-completions        (catch 'finish-add-completions
1887          (unwind-protect          (with-syntax-table completion-c-def-syntax-table
1888               (while t            (while t
1889                 ;; we loop here only when scan-sexps fails              ;; we loop here only when scan-sexps fails
1890                 ;; (i.e. unbalance exps.)              ;; (i.e. unbalance exps.)
1891                 (set-syntax-table cmpl-c-def-syntax-table)              (condition-case e
1892                 (condition-case e                  (while t
1893                      (while t                    (re-search-forward *c-def-regexp*)
1894                        (re-search-forward *c-def-regexp*)                    (cond
1895                        (cond                     ((= (preceding-char) ?#)
1896                          ((= (preceding-char) ?#)                      ;; preprocessor macro, see if it's one we handle
1897                           ;; preprocessor macro, see if it's one we handle                      (setq string (buffer-substring (point) (+ (point) 6)))
1898                           (setq string (buffer-substring (point) (+ (point) 6)))                      (cond ((member string '("define" "ifdef "))
1899                           (cond ((or (string-equal string "define")                             ;; skip forward over definition symbol
1900                                      (string-equal string "ifdef "))                             ;; and add it to database
1901                                  ;; skip forward over definition symbol                             (and (forward-word 2)
1902                                  ;; and add it to database                                  (setq string (symbol-before-point))
1903                                  (and (forward-word 2)                                  ;;(push string foo)
1904                                       (setq string (symbol-before-point))                                  (add-completion-to-tail-if-new string)))))
1905                                       ;;(push string foo)                     (t
1906                                       (add-completion-to-tail-if-new string)))))                      ;; C definition
1907                          (t                      (setq next-point (point))
1908                           ;; C definition                      (while (and
1909                           (setq next-point (point))                              next-point
1910                           (while (and                              ;; scan to next separator char.
1911                                    next-point                              (setq next-point (scan-sexps next-point 1)))
1912                                    ;; scan to next separator char.                        ;; position the point on the word we want to add
1913                                    (setq next-point (scan-sexps next-point 1)))                        (goto-char next-point)
1914                             ;; position the point on the word we want to add                        (while (= (setq char (following-char)) ?*)
1915                             (goto-char next-point)                          ;; handle pointer ref
1916                             (while (= (setq char (following-char)) ?*)                          ;; move to next separator char.
1917                               ;; handle pointer ref                          (goto-char
1918                               ;; move to next separator char.                           (setq next-point (scan-sexps (point) 1))))
1919                               (goto-char                        (forward-word -1)
1920                                 (setq next-point (scan-sexps (point) 1))))                        ;; add to database
1921                             (forward-word -1)                        (if (setq string (symbol-under-point))
1922                             ;; add to database                            ;; (push string foo)
1923                             (if (setq string (symbol-under-point))                            (add-completion-to-tail-if-new string)
1924                                 ;; (push string foo)                          ;; Local TMC hack (useful for parsing paris.h)
1925                                 (add-completion-to-tail-if-new string)                          (if (and (looking-at "_AP") ;; "ansi prototype"
1926                                 ;; Local TMC hack (useful for parsing paris.h)                                   (progn
1927                                 (if (and (looking-at "_AP") ;; "ansi prototype"                                     (forward-word -1)
1928                                          (progn                                     (setq string
1929                                            (forward-word -1)                                           (symbol-under-point))))
1930                                            (setq string                              (add-completion-to-tail-if-new string)))
1931                                                  (symbol-under-point))))                        ;; go to next
1932                                     (add-completion-to-tail-if-new string)))                        (goto-char next-point)
1933                             ;; go to next                        ;; (push (format "%c" (following-char)) foo)
1934                             (goto-char next-point)                        (if (= (char-syntax char) ?\()
1935                             ;; (push (format "%c" (following-char)) foo)                            ;; if on an opening delimiter, go to end
1936                             (if (= (char-syntax char) ?\()                            (while (= (char-syntax char) ?\()
1937                                 ;; if on an opening delimiter, go to end                              (setq next-point (scan-sexps next-point 1)
1938                                 (while (= (char-syntax char) ?\()                                    char (char-after next-point)))
1939                                   (setq next-point (scan-sexps next-point 1)                          (or (= char ?,)
1940                                         char (char-after next-point)))                              ;; Current char is an end char.
1941                                 (or (= char ?,)                              (setq next-point nil)))))))
1942                                     ;; Current char is an end char.                (search-failed ;;done
1943                                     (setq next-point nil)))))))                 (throw 'finish-add-completions t))
1944                    (search-failed ;;done                (error
1945                      (throw 'finish-add-completions t))                 ;; Check for failure in scan-sexps
1946                    (error                 (if (or (string-equal (nth 1 e)
1947                      ;; Check for failure in scan-sexps                                       "Containing expression ends prematurely")
1948                      (if (or (string-equal (nth 1 e)                         (string-equal (nth 1 e) "Unbalanced parentheses"))
1949                                            "Containing expression ends prematurely")                     ;; unbalanced paren., keep going
1950                              (string-equal (nth 1 e) "Unbalanced parentheses"))                     ;;(ding)
1951                          ;; unbalanced paren., keep going                     (forward-line 1)
1952                          ;;(ding)                   (message "Error parsing C buffer for completions--please send bug report")
1953                          (forward-line 1)                   (throw 'finish-add-completions t))))))))))
                         (message "Error parsing C buffer for completions--please send bug report")  
                         (throw 'finish-add-completions t)))))  
           (set-syntax-table saved-syntax))))))  
1954    
1955    
1956  ;;---------------------------------------------------------------------------  ;;---------------------------------------------------------------------------
# Line 2018  Prefix args :: Line 1964  Prefix args ::
1964          ((not cmpl-completions-accepted-p)          ((not cmpl-completions-accepted-p)
1965           (message "Completions database has not changed - not writing."))           (message "Completions database has not changed - not writing."))
1966          (t          (t
1967           (save-completions-to-file)))))           (save-completions-to-file))))
1968      (cmpl-statistics-block (record-cmpl-kill-emacs)))
1969    
1970  ;; There is no point bothering to change this again  ;; There is no point bothering to change this again
1971  ;; unless the package changes so much that it matters  ;; unless the package changes so much that it matters
# Line 2046  If file name is not specified, use `save Line 1993  If file name is not specified, use `save
1993    (if (file-writable-p filename)    (if (file-writable-p filename)
1994        (progn        (progn
1995          (if (not cmpl-initialized-p)          (if (not cmpl-initialized-p)
1996              (initialize-completions));; make sure everything's loaded              (completion-initialize)) ;; make sure everything's loaded
1997          (message "Saving completions to file %s" filename)          (message "Saving completions to file %s" filename)
1998    
1999          (let* ((delete-old-versions t)          (let* ((delete-old-versions t)
# Line 2059  If file name is not specified, use `save Line 2006  If file name is not specified, use `save
2006                 (total-saved 0)                 (total-saved 0)
2007                 (backup-filename (completion-backup-filename filename)))                 (backup-filename (completion-backup-filename filename)))
2008    
2009            (save-excursion            (with-current-buffer (get-buffer-create " *completion-save-buffer*")
             (get-buffer-create " *completion-save-buffer*")  
             (set-buffer  " *completion-save-buffer*")  
2010              (setq buffer-file-name filename)              (setq buffer-file-name filename)
2011    
2012              (if (not (verify-visited-file-modtime (current-buffer)))              (if (not (verify-visited-file-modtime (current-buffer)))
# Line 2151  If file is not specified, then use `save Line 2096  If file is not specified, then use `save
2096            (if (not no-message-p)            (if (not no-message-p)
2097                (message "Loading completions from %sfile %s . . ."                (message "Loading completions from %sfile %s . . ."
2098                         (if backup-readable-p "backup " "") filename))                         (if backup-readable-p "backup " "") filename))
2099            (save-excursion            (with-current-buffer (get-buffer-create " *completion-save-buffer*")
             (get-buffer-create " *completion-save-buffer*")  
             (set-buffer  " *completion-save-buffer*")  
2100              (setq buffer-file-name filename)              (setq buffer-file-name filename)
2101              ;; prepare the buffer to be modified              ;; prepare the buffer to be modified
2102              (clear-visited-file-modtime)              (clear-visited-file-modtime)
# Line 2161  If file is not specified, then use `save Line 2104  If file is not specified, then use `save
2104    
2105              (let ((insert-okay-p nil)              (let ((insert-okay-p nil)
2106                    (buffer (current-buffer))                    (buffer (current-buffer))
2107                    (current-time (cmpl-hours-since-origin))                    string entry last-use-time
                   string num-uses entry last-use-time  
2108                    cmpl-entry cmpl-last-use-time                    cmpl-entry cmpl-last-use-time
2109                    (current-completion-source cmpl-source-init-file)                    (current-completion-source cmpl-source-init-file)
2110                    (start-num                    (start-num
# Line 2233  If file is not specified, then use `save Line 2175  If file is not specified, then use `save
2175                     start-num)))                     start-num)))
2176  ))))))  ))))))
2177    
2178  (defun initialize-completions ()  (defun completion-initialize ()
2179    "Load the default completions file.    "Load the default completions file.
2180  Also sets up so that exiting Emacs will automatically save the file."  Also sets up so that exiting Emacs will automatically save the file."
2181    (interactive)    (interactive)
2182    (cond ((not cmpl-initialized-p)    (unless cmpl-initialized-p
2183           (load-completions-from-file)))      (load-completions-from-file)
2184    (setq cmpl-initialized-p t))      (setq cmpl-initialized-p t)))
2185    
2186  ;;-----------------------------------------------  ;;-----------------------------------------------
2187  ;; Kill region patch  ;; Kill region patch
# Line 2302  Patched to remove the most recent comple Line 2244  Patched to remove the most recent comple
2244  ;; Note that because of the way byte compiling works, none of  ;; Note that because of the way byte compiling works, none of
2245  ;; the functions defined with this macro get byte compiled.  ;; the functions defined with this macro get byte compiled.
2246    
2247  (defmacro def-completion-wrapper (function-name type &optional new-name)  (defun completion-def-wrapper (function-name type)
2248    "Add a call to update the completion database before function execution.    "Add a call to update the completion database before function execution.
2249  TYPE is the type of the wrapper to be added.  Can be :before or :under."  TYPE is the type of the wrapper to be added.  Can be :before or :under."
2250    (cond ((eq type :separator)    (put function-name 'completion-function
2251           (list 'put (list 'quote function-name) ''completion-function         (cdr (assq type
2252                 ''use-completion-before-separator))                    '((:separator 'use-completion-before-separator)
2253          ((eq type :before)                      (:before 'use-completion-before-point)
2254           (list 'put (list 'quote function-name) ''completion-function                      (:backward-under 'use-completion-backward-under)
2255                 ''use-completion-before-point))                      (:backward 'use-completion-backward)
2256          ((eq type :backward-under)                      (:under 'use-completion-under-point)
2257           (list 'put (list 'quote function-name) ''completion-function                      (:under-or-before 'use-completion-under-or-before-point)
2258                 ''use-completion-backward-under))                      (:minibuffer-separator 'use-completion-minibuffer-separator))))))
         ((eq type :backward)  
          (list 'put (list 'quote function-name) ''completion-function  
                ''use-completion-backward))  
         ((eq type :under)  
          (list 'put (list 'quote function-name) ''completion-function  
                ''use-completion-under-point))  
         ((eq type :under-or-before)  
          (list 'put (list 'quote function-name) ''completion-function  
                ''use-completion-under-or-before-point))  
         ((eq type :minibuffer-separator)  
          (list 'put (list 'quote function-name) ''completion-function  
                ''use-completion-minibuffer-separator))))  
2259    
2260  (defun use-completion-minibuffer-separator ()  (defun use-completion-minibuffer-separator ()
2261    (let ((cmpl-syntax-table cmpl-standard-syntax-table))    (let ((completion-syntax-table completion-standard-syntax-table))
2262      (use-completion-before-separator)))      (use-completion-before-separator)))
2263    
2264  (defun use-completion-backward-under ()  (defun use-completion-backward-under ()
# Line 2347  TYPE is the type of the wrapper to be ad Line 2277  TYPE is the type of the wrapper to be ad
2277                      (get this-command 'completion-function))                      (get this-command 'completion-function))
2278                 'use-completion-under-or-before-point)))                 'use-completion-under-or-before-point)))
2279    
2280    ;; Lisp mode diffs.
2281    
2282    (defconst completion-lisp-syntax-table
2283      (let ((table (copy-syntax-table completion-standard-syntax-table))
2284            (symbol-chars '(?! ?& ?? ?= ?^)))
2285        (dolist (char symbol-chars)
2286          (modify-syntax-entry char "_" table))
2287        table))
2288    
2289    (defun completion-lisp-mode-hook ()
2290      (setq completion-syntax-table completion-lisp-syntax-table)
2291      ;; Lisp Mode diffs
2292      (local-set-key "!" 'self-insert-command)
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    
2299  ;; C mode diffs.  ;; C mode diffs.
2300    
2301  (defvar c-mode-map)  (defconst completion-c-syntax-table
2302      (let ((table (copy-syntax-table completion-standard-syntax-table))
2303            (separator-chars '(?+ ?* ?/ ?: ?%)))
2304        (dolist (char separator-chars)
2305          (modify-syntax-entry char " " table))
2306        table))
2307    
2308    (completion-def-wrapper 'electric-c-semi :separator)
2309  (defun completion-c-mode-hook ()  (defun completion-c-mode-hook ()
2310    (def-completion-wrapper electric-c-semi :separator)    (setq completion-syntax-table completion-c-syntax-table)
2311    (define-key c-mode-map "+" 'completion-separator-self-insert-command)    (local-set-key "+" 'completion-separator-self-insert-command)
2312    (define-key c-mode-map "*" 'completion-separator-self-insert-command)    (local-set-key "*" 'completion-separator-self-insert-command)
2313    (define-key c-mode-map "/" 'completion-separator-self-insert-command))    (local-set-key "/" 'completion-separator-self-insert-command))
 ;; Do this either now or whenever C mode is loaded.  
 (if (featurep 'cc-mode)  
     (completion-c-mode-hook)  
   (add-hook 'c-mode-hook 'completion-c-mode-hook))  
2314    
2315  ;; FORTRAN mode diffs. (these are defined when fortran is called)  ;; FORTRAN mode diffs. (these are defined when fortran is called)
2316    
2317  (defvar fortran-mode-map)  (defconst completion-fortran-syntax-table
2318      (let ((table (copy-syntax-table completion-standard-syntax-table))
2319            (separator-chars '(?+ ?- ?* ?/ ?:)))
2320        (dolist (char separator-chars)
2321          (modify-syntax-entry char " " table))
2322        table))
2323    
2324  (defun completion-setup-fortran-mode ()  (defun completion-setup-fortran-mode ()
2325    (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)    (setq completion-syntax-table completion-fortran-syntax-table)
2326    (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)    (local-set-key "+" 'completion-separator-self-insert-command)
2327    (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)    (local-set-key "-" 'completion-separator-self-insert-command)
2328    (define-key fortran-mode-map "/" 'completion-separator-self-insert-command))    (local-set-key "*" 'completion-separator-self-insert-command)
2329      (local-set-key "/" 'completion-separator-self-insert-command))
2330    
2331  ;;; Enable completion mode.  ;; Enable completion mode.
2332    
2333    (defvar fortran-mode-hook)
2334    
2335    (defvar completion-saved-bindings nil)
2336    
2337  ;;;###autoload  ;;;###autoload
2338  (defun dynamic-completion-mode ()  (define-minor-mode dynamic-completion-mode
2339    "Enable dynamic word-completion."    "Enable dynamic word-completion."
2340    (interactive)    :global t
2341    (add-hook 'find-file-hook 'cmpl-find-file-hook)    ;; This is always good, not specific to dynamic-completion-mode.
2342    (add-hook 'pre-command-hook 'completion-before-command)    (define-key function-key-map [C-return] [?\C-\r])
2343    
2344    ;; Install the appropriate mode tables.    (dolist (x '((find-file-hook          . completion-find-file-hook)
2345    (add-hook 'lisp-mode-hook                 (pre-command-hook        . completion-before-command)
2346              (lambda ()                 ;; Save completions when killing Emacs.
2347                 (setq cmpl-syntax-table cmpl-lisp-syntax-table)))                 (kill-emacs-hook         . kill-emacs-save-completions)
2348    (add-hook 'c-mode-hook  
2349              (lambda ()                 ;; Install the appropriate mode tables.
2350                 (setq cmpl-syntax-table cmpl-c-syntax-table)))                 (lisp-mode-hook          . completion-lisp-mode-hook)
2351    (add-hook 'fortran-mode-hook                 (c-mode-hook             . completion-c-mode-hook)
2352              (lambda ()                 (fortran-mode-hook       . completion-setup-fortran-mode)))
2353                 (setq cmpl-syntax-table cmpl-fortran-syntax-table)      (if dynamic-completion-mode
2354                 (completion-setup-fortran-mode)))          (add-hook (car x) (cdr x))
2355          (remove-hook (car x) (cdr x))))
2356      
2357      ;; "Complete" Key Keybindings.  We don't want to use a minor-mode
2358      ;; map because these have too high a priority.  We could/should
2359      ;; probably change the interpretation of minor-mode-map-alist such
2360      ;; that a map has lower precedence if the symbol is not buffer-local.
2361      (while completion-saved-bindings
2362        (let ((binding (pop completion-saved-bindings)))
2363          (global-set-key (car binding) (cdr binding))))
2364      (when dynamic-completion-mode
2365        (dolist (binding
2366                 '(("\M-\r"  . complete)
2367                   ([?\C-\r] . complete)
2368    
2369                   ;; Tests -
2370                   ;; (add-completion "cumberland")
2371                   ;; (add-completion "cumberbund")
2372                   ;; cum
2373                   ;; Cumber
2374                   ;; cumbering
2375                   ;; cumb
2376    
2377                   ;; Patches to standard keymaps insert completions
2378                   ([remap kill-region] . completion-kill-region)
2379    
2380                   ;; Separators
2381                   ;; We've used the completion syntax table given  as a guide.
2382                   ;;
2383                   ;; Global separator chars.
2384                   ;;  We left out <tab> because there are too many special
2385                   ;; cases for it.  Also, in normal coding it's rarely typed
2386                   ;; after a word.
2387                   (" " . completion-separator-self-insert-autofilling)
2388                   ("!" . completion-separator-self-insert-command)
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    
2408                   ;; We include period and colon even though they are symbol
2409                   ;; chars because :
2410                   ;;  - in text we want to pick up the last word in a sentence.
2411                   ;;  - in C pointer refs. we want to pick up the first symbol
2412                   ;;  - it won't make a difference for lisp mode (package names
2413                   ;;    are short)
2414                   ("." . completion-separator-self-insert-command)
2415                   (":" . completion-separator-self-insert-command)))
2416          (push (cons (car binding) (lookup-key global-map (car binding)))
2417                completion-saved-bindings)
2418          (global-set-key (car binding) (cdr binding)))
2419    
2420        ;; Tests --
2421        ;; foobarbiz
2422        ;; foobar
2423        ;; fooquux
2424        ;; fooper
2425    
2426    ;; "Complete" Key Keybindings.      (cmpl-statistics-block
2427         (record-completion-file-loaded))
2428    
2429    (global-set-key "\M-\r" 'complete)      (completion-initialize)))
   (global-set-key [?\C-\r] 'complete)  
   (define-key function-key-map [C-return] [?\C-\r])  
2430    
2431    ;; Tests -  ;;-----------------------------------------------
2432    ;; (add-completion "cumberland")  ;; End of line chars.
2433    ;; (add-completion "cumberbund")  ;;-----------------------------------------------
2434    ;; cum  (completion-def-wrapper 'newline :separator)
2435    ;; Cumber  (completion-def-wrapper 'newline-and-indent :separator)
2436    ;; cumbering  (completion-def-wrapper 'comint-send-input :separator)
2437    ;; cumb  (completion-def-wrapper 'exit-minibuffer :minibuffer-separator)
2438    (completion-def-wrapper 'eval-print-last-sexp :separator)
2439    ;; Save completions when killing Emacs.  (completion-def-wrapper 'eval-last-sexp :separator)
2440    ;;(completion-def-wrapper 'minibuffer-complete-and-exit :minibuffer)
   (add-hook 'kill-emacs-hook  
             (lambda ()  
                (kill-emacs-save-completions)  
                (cmpl-statistics-block  
                 (record-cmpl-kill-emacs))))  
   
   ;; Patches to standard keymaps insert completions  
   (substitute-key-definition 'kill-region 'completion-kill-region  
                              global-map)  
   
   ;; Separators  
   ;; We've used the completion syntax table given  as a guide.  
   ;;  
   ;; Global separator chars.  
   ;;  We left out <tab> because there are too many special cases for it.  Also,  
   ;; in normal coding it's rarely typed after a word.  
   (global-set-key " " 'completion-separator-self-insert-autofilling)  
   (global-set-key "!" 'completion-separator-self-insert-command)  
   (global-set-key "%" 'completion-separator-self-insert-command)  
   (global-set-key "^" 'completion-separator-self-insert-command)  
   (global-set-key "&" 'completion-separator-self-insert-command)  
   (global-set-key "(" 'completion-separator-self-insert-command)  
   (global-set-key ")" 'completion-separator-self-insert-command)  
   (global-set-key "=" 'completion-separator-self-insert-command)  
   (global-set-key "`" 'completion-separator-self-insert-command)  
   (global-set-key "|" 'completion-separator-self-insert-command)  
   (global-set-key "{" 'completion-separator-self-insert-command)  
   (global-set-key "}" 'completion-separator-self-insert-command)  
   (global-set-key "[" 'completion-separator-self-insert-command)  
   (global-set-key "]" 'completion-separator-self-insert-command)  
   (global-set-key ";" 'completion-separator-self-insert-command)  
   (global-set-key "\"" 'completion-separator-self-insert-command)  
   (global-set-key "'" 'completion-separator-self-insert-command)  
   (global-set-key "#" 'completion-separator-self-insert-command)  
   (global-set-key "," 'completion-separator-self-insert-command)  
   (global-set-key "?" 'completion-separator-self-insert-command)  
   
   ;; We include period and colon even though they are symbol chars because :  
   ;;  - in text we want to pick up the last word in a sentence.  
   ;;  - in C pointer refs. we want to pick up the first symbol  
   ;;  - it won't make a difference for lisp mode (package names are short)  
   (global-set-key "." 'completion-separator-self-insert-command)  
   (global-set-key ":" 'completion-separator-self-insert-command)  
2441    
2442    ;; Lisp Mode diffs  ;;-----------------------------------------------
2443    (define-key lisp-mode-map "!" 'self-insert-command)  ;; Cursor movement
2444    (define-key lisp-mode-map "&" 'self-insert-command)  ;;-----------------------------------------------
   (define-key lisp-mode-map "%" 'self-insert-command)  
   (define-key lisp-mode-map "?" 'self-insert-command)  
   (define-key lisp-mode-map "=" 'self-insert-command)  
   (define-key lisp-mode-map "^" 'self-insert-command)  
   
   ;; Avoid warnings.  
   (defvar c-mode-map)  
   (defvar fortran-mode-map)  
   
   ;;-----------------------------------------------  
   ;; End of line chars.  
   ;;-----------------------------------------------  
   (def-completion-wrapper newline :separator)  
   (def-completion-wrapper newline-and-indent :separator)  
   (def-completion-wrapper comint-send-input :separator)  
   (def-completion-wrapper exit-minibuffer :minibuffer-separator)  
   (def-completion-wrapper eval-print-last-sexp :separator)  
   (def-completion-wrapper eval-last-sexp :separator)  
   ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)  
   
   ;;-----------------------------------------------  
   ;; Cursor movement  
   ;;-----------------------------------------------  
   
   (def-completion-wrapper next-line :under-or-before)  
   (def-completion-wrapper previous-line :under-or-before)  
   (def-completion-wrapper beginning-of-buffer :under-or-before)  
   (def-completion-wrapper end-of-buffer :under-or-before)  
   (def-completion-wrapper beginning-of-line :under-or-before)  
   (def-completion-wrapper end-of-line :under-or-before)  
   (def-completion-wrapper forward-char :under-or-before)  
   (def-completion-wrapper forward-word :under-or-before)  
   (def-completion-wrapper forward-sexp :under-or-before)  
   (def-completion-wrapper backward-char :backward-under)  
   (def-completion-wrapper backward-word :backward-under)  
   (def-completion-wrapper backward-sexp :backward-under)  
   
   (def-completion-wrapper delete-backward-char :backward)  
   (def-completion-wrapper delete-backward-char-untabify :backward)  
   
   ;; Tests --  
   ;; foobarbiz  
   ;; foobar  
   ;; fooquux  
   ;; fooper  
2445    
2446    (cmpl-statistics-block  (completion-def-wrapper 'next-line :under-or-before)
2447     (record-completion-file-loaded))  (completion-def-wrapper 'previous-line :under-or-before)
2448    (completion-def-wrapper 'beginning-of-buffer :under-or-before)
2449    (completion-def-wrapper 'end-of-buffer :under-or-before)
2450    (completion-def-wrapper 'beginning-of-line :under-or-before)
2451    (completion-def-wrapper 'end-of-line :under-or-before)
2452    (completion-def-wrapper 'forward-char :under-or-before)
2453    (completion-def-wrapper 'forward-word :under-or-before)
2454    (completion-def-wrapper 'forward-sexp :under-or-before)
2455    (completion-def-wrapper 'backward-char :backward-under)
2456    (completion-def-wrapper 'backward-word :backward-under)
2457    (completion-def-wrapper 'backward-sexp :backward-under)
2458    
2459    (completion-def-wrapper 'delete-backward-char :backward)
2460    (completion-def-wrapper 'delete-backward-char-untabify :backward)
2461    
2462    (initialize-completions))  ;; Old names, non-namespace-clean.
2463    (defvaralias 'cmpl-syntax-table 'completion-syntax-table)
2464    (defalias 'initialize-completions 'completion-initialize)
2465    
2466  (mapc (lambda (x) (add-to-list 'debug-ignored-errors x))  (dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
       '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"  
2467          "^The string \".*\" is too short to be saved as a completion\\.$"))          "^The string \".*\" is too short to be saved as a completion\\.$"))
2468      (add-to-list 'debug-ignored-errors x))
2469    
2470  (provide 'completion)  (provide 'completion)
2471    
2472  ;;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e  ;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e
2473  ;;; completion.el ends here  ;;; completion.el ends here

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.54

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26