;;; completion.el --- dynamic word-completion code
-;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2012
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2015 Free Software
+;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
;; Author: Jim Salem <alem@bbnplanet.com> of Thinking Machines Inc.
;; (ideas suggested by Brewster Kahle)
:type '(set (const lisp) (const c))
:group 'completion)
-;;(defvar *record-cmpl-statistics-p* nil
-;; "If non-nil, record completion statistics.")
-
;;(defvar *completion-auto-save-period* 1800
;; "The period in seconds to wait for emacs to be idle before autosaving
;;the completions. Default is a 1/2 hour.")
(defvar cmpl-preceding-syntax)
-(defvar completion-string)
+(defvar cmpl--completion-string)
\f
;;---------------------------------------------------------------------------
;; Low level tools
\f
(defun cmpl-hours-since-origin ()
- (let ((time (current-time)))
- (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
+ (floor (float-time) 3600))
\f
;;---------------------------------------------------------------------------
;; "Symbol" parsing functions
;; Note that the guts of this has been turned off. The guts
;; are in completion-stats.el.
-;;-----------------------------------------------
-;; Conditionalizing code on *record-cmpl-statistics-p*
-;;-----------------------------------------------
-;; All statistics code outside this block should use this
-(defmacro cmpl-statistics-block (&rest _body))
-;; "Only executes body if we are recording statistics."
-;; (list 'cond
-;; (list* '*record-cmpl-statistics-p* body)
-;; ))
-
;;-----------------------------------------------
;; Completion Sources
;;-----------------------------------------------
"Initialize the completion storage. All existing completions are lost."
(interactive)
(setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
- (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
- (cmpl-statistics-block
- (record-clear-all-completions)))
+ (setq cmpl-obarray (make-vector cmpl-obarray-length 0)))
(defvar completions-list-return-value)
(cmpl-db-debug-p
;; not found, error if debug mode
(error "Completion entry exists but not on prefix list - %s"
- completion-string))
+ cmpl--completion-string))
(inside-locate-completion-entry
;; recursive error: really scrod
(locate-completion-db-error))
(set-cmpl-prefix-entry-tail prefix-entry entry))
(t
(set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
- ;; statistics
- (cmpl-statistics-block
- (note-added-completion))
;; set symbol
(set cmpl-db-symbol (car entry)))))
Updates the saved string with the supplied string.
This must be very fast.
Returns the completion entry."
- ;; Handle pending acceptance
- (if completion-to-accept (accept-completion))
- ;; test if already in database
- (if (setq cmpl-db-entry (find-exact-completion completion-string))
- ;; found
- (let* ((prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length)))
- (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
- (cmpl-ptr (cdr splice-ptr)))
- ;; update entry
- (set-completion-string cmpl-db-entry completion-string)
- ;; move to head (if necessary)
- (cond (splice-ptr
- ;; These should all execute atomically but it is not fatal if
- ;; they don't.
- ;; splice it out
- (or (setcdr splice-ptr (cdr cmpl-ptr))
- ;; fix up tail if necessary
- (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
- ;; splice in at head
- (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
- (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
- cmpl-db-entry)
- ;; not there
- (let (;; create an entry
- (entry (list (make-completion completion-string)))
- ;; setup the prefix
- (prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length))))
- (cond (prefix-entry
- ;; Splice in at head
- (setcdr entry (cmpl-prefix-entry-head prefix-entry))
- (set-cmpl-prefix-entry-head prefix-entry entry))
- (t
- ;; Start new prefix entry
- (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
- ;; statistics
- (cmpl-statistics-block
- (note-added-completion))
- ;; Add it to the symbol
- (set cmpl-db-symbol (car entry)))))
+ (let ((cmpl--completion-string completion-string))
+ ;; Handle pending acceptance
+ (if completion-to-accept (accept-completion))
+ ;; test if already in database
+ (if (setq cmpl-db-entry (find-exact-completion completion-string))
+ ;; found
+ (let* ((prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length)))
+ (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
+ (cmpl-ptr (cdr splice-ptr)))
+ ;; update entry
+ (set-completion-string cmpl-db-entry completion-string)
+ ;; move to head (if necessary)
+ (cond (splice-ptr
+ ;; These should all execute atomically but it is not fatal if
+ ;; they don't.
+ ;; splice it out
+ (or (setcdr splice-ptr (cdr cmpl-ptr))
+ ;; fix up tail if necessary
+ (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
+ ;; splice in at head
+ (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
+ (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
+ cmpl-db-entry)
+ ;; not there
+ (let ( ;; create an entry
+ (entry (list (make-completion completion-string)))
+ ;; setup the prefix
+ (prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length))))
+ (cond (prefix-entry
+ ;; Splice in at head
+ (setcdr entry (cmpl-prefix-entry-head prefix-entry))
+ (set-cmpl-prefix-entry-head prefix-entry entry))
+ (t
+ ;; Start new prefix entry
+ (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
+ ;; Add it to the symbol
+ (set cmpl-db-symbol (car entry))))))
(defun delete-completion (completion-string)
"Delete the completion from the database.
String must be longer than `completion-prefix-min-length'."
;; Handle pending acceptance
- (if completion-to-accept (accept-completion))
- (if (setq cmpl-db-entry (find-exact-completion completion-string))
- ;; found
- (let* ((prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length)))
- (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
- ;; delete symbol reference
- (set cmpl-db-symbol nil)
- ;; remove from prefix list
- (cond (splice-ptr
- ;; not at head
- (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
- ;; fix up tail if necessary
- (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
- (t
- ;; at head
- (or (set-cmpl-prefix-entry-head
+ (let ((cmpl--completion-string completion-string))
+ (if completion-to-accept (accept-completion))
+ (if (setq cmpl-db-entry (find-exact-completion completion-string))
+ ;; found
+ (let* ((prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length)))
+ (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
+ ;; delete symbol reference
+ (set cmpl-db-symbol nil)
+ ;; remove from prefix list
+ (cond (splice-ptr
+ ;; not at head
+ (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
+ ;; fix up tail if necessary
+ (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
+ (t
+ ;; at head
+ (or (set-cmpl-prefix-entry-head
prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
- ;; List is now empty
- (set cmpl-db-prefix-symbol nil))))
- (cmpl-statistics-block
- (note-completion-deleted)))
- (error "Unknown completion `%s'" completion-string)))
+ ;; List is now empty
+ (set cmpl-db-prefix-symbol nil)))))
+ (error "Unknown completion `%s'" completion-string))))
;; Tests --
;; - Add and Find -
(delete-completion string))
(defun accept-completion ()
- "Accepts the pending completion in `completion-to-accept'.
+ "Accept the pending completion in `completion-to-accept'.
This bumps num-uses. Called by `add-completion-to-head' and
`completion-search-reset'."
(let ((string completion-to-accept)
(let ((string (and enable-completion (symbol-before-point)))
(current-completion-source cmpl-source-separator)
entry)
- (cmpl-statistics-block
- (note-separator-character string))
(cond (string
(setq entry (add-completion-to-head string))
(if (and completion-on-separator-character
completion-prefix-min-length)))
;; get index
(setq cmpl-current-index (if current-prefix-arg arg 0))
- ;; statistics
- (cmpl-statistics-block
- (note-complete-entered-afresh cmpl-original-string))
;; reset database
(completion-search-reset cmpl-original-string)
;; erase what we've got
;; Get the next completion
(let* ((print-status-p
(and (>= baud-rate completion-prompt-speed-threshold)
- (not (window-minibuffer-p (selected-window)))))
+ (not (window-minibuffer-p))))
(insert-point (point))
(entry (completion-search-next cmpl-current-index))
string)
(goto-char insert-point))
(t;; point at end,
(setq cmpl-last-insert-location insert-point)))
- ;; statistics
- (cmpl-statistics-block
- (note-complete-inserted entry cmpl-current-index))
;; Done ! cmpl-stat-complete-successful
;;display the next completion
(cond
(if (and print-status-p (sit-for 0))
(message "No %scompletions."
(if (eq this-command last-command) "more " "")))
- ;; statistics
- (cmpl-statistics-block
- (record-complete-failed cmpl-current-index))
;; Pretend that we were never here
(setq this-command 'failed-complete)))))
\f
(defun add-completions-from-buffer ()
(interactive)
- (let ((current-completion-source cmpl-source-file-parsing)
- (start-num
- (cmpl-statistics-block
- (aref completion-add-count-vector cmpl-source-file-parsing)))
- mode)
+ (let ((current-completion-source cmpl-source-file-parsing))
(cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
- (add-completions-from-lisp-buffer)
- (setq mode 'lisp))
+ (add-completions-from-lisp-buffer))
((memq major-mode '(c-mode))
- (add-completions-from-c-buffer)
- (setq mode 'c))
+ (add-completions-from-c-buffer))
(t
(error "Cannot parse completions in %s buffers"
- major-mode)))
- (cmpl-statistics-block
- (record-cmpl-parse-file
- mode (point-max)
- (- (aref completion-add-count-vector cmpl-source-file-parsing)
- start-num)))))
+ major-mode)))))
;; Find file hook
(defun completion-find-file-hook ()
((not cmpl-completions-accepted-p)
(message "Completions database has not changed - not writing."))
(t
- (save-completions-to-file))))
- (cmpl-statistics-block (record-cmpl-kill-emacs)))
+ (save-completions-to-file)))))
;; There is no point bothering to change this again
;; unless the package changes so much that it matters
(kept-old-versions 0)
(kept-new-versions completions-file-versions-kept)
last-use-time
- (current-time (cmpl-hours-since-origin))
+ (this-use-time (cmpl-hours-since-origin))
(total-in-db 0)
(total-perm 0)
(total-saved 0)
;; or if
(if (> (completion-num-uses completion) 0)
;; it's been used
- (setq last-use-time current-time)
+ (setq last-use-time this-use-time)
;; or it was saved before and
(and last-use-time
;; save-completions-retention-time is nil
(or (not save-completions-retention-time)
;; or time since last use is < ...retention-time*
- (< (- current-time last-use-time)
+ (< (- this-use-time last-use-time)
save-completions-retention-time)))))
;; write to file
(setq total-saved (1+ total-saved))
(set-buffer-modified-p nil)
(message "Couldn't save completion file `%s'" filename)))
;; Reset accepted-p flag
- (setq cmpl-completions-accepted-p nil) )
- (cmpl-statistics-block
- (record-save-completions total-in-db total-perm total-saved))))))
+ (setq cmpl-completions-accepted-p nil) )))))
;;(defun auto-save-completions ()
;; (if (and save-completions-flag enable-completion cmpl-initialized-p
string entry last-use-time
cmpl-entry cmpl-last-use-time
(current-completion-source cmpl-source-init-file)
- (start-num
- (cmpl-statistics-block
- (aref completion-add-count-vector cmpl-source-file-parsing)))
(total-in-file 0) (total-perm 0))
;; insert the file into a buffer
(condition-case nil
(message "Loading completions from file %s . . . Done."
filename))
(message "End of file while reading completions."))))))
-
- (cmpl-statistics-block
- (record-load-completions
- total-in-file total-perm
- (- (aref completion-add-count-vector cmpl-source-init-file)
- start-num)))
))))))
(defun completion-initialize ()
(cond ((eq last-command 'complete)
(delete-region (point) cmpl-last-insert-location)
(insert cmpl-original-string)
- (setq completion-to-accept nil)
- (cmpl-statistics-block
- (record-complete-failed)))
+ (setq completion-to-accept nil))
(t
(kill-region beg end))))
;; to work)
;; All common separators (eg. space "(" ")" """) characters go through a
-;; function to add new words to the list of words to complete from:
-;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
+;; function to add new words to the list of words to complete from.
;; If the character before this was an alpha-numeric then this adds the
;; symbol before point to the completion list (using ADD-COMPLETION).
-(defun completion-separator-self-insert-command (arg)
- (interactive "p")
- (if (command-remapping 'self-insert-command)
- (funcall (command-remapping 'self-insert-command) arg)
- (use-completion-before-separator)
- (self-insert-command arg)))
-
-(defun completion-separator-self-insert-autofilling (arg)
- (interactive "p")
- (if (command-remapping 'self-insert-command)
- (funcall (command-remapping 'self-insert-command) arg)
- (use-completion-before-separator)
- (self-insert-command arg)
- (and auto-fill-function
- (funcall auto-fill-function))))
+(defvar completion-separator-chars
+ (append " !%^&()=`|{}[];\\'#,?"
+ ;; 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)
+ ".:" nil))
+
+(defun completion--post-self-insert ()
+ (when (memq last-command-event completion-separator-chars)
+ (let ((after-pos (electric--after-char-pos)))
+ (when after-pos
+ (save-excursion
+ (goto-char (1- after-pos))
+ (use-completion-before-separator))))))
;;-----------------------------------------------
;; Wrapping Macro
(use-completion-before-separator)))
(defun use-completion-backward-under ()
- (use-completion-under-point)
- (if (eq last-command 'complete)
- ;; probably a failed completion if you have to back up
- (cmpl-statistics-block (record-complete-failed))))
+ (use-completion-under-point))
(defun use-completion-backward ()
- (if (eq last-command 'complete)
- ;; probably a failed completion if you have to back up
- (cmpl-statistics-block (record-complete-failed))))
+ nil)
(defun completion-before-command ()
(funcall (or (and (symbolp this-command)
(completion-def-wrapper 'electric-c-semi :separator)
(defun completion-c-mode-hook ()
(setq completion-syntax-table completion-c-syntax-table)
- (local-set-key "+" 'completion-separator-self-insert-command)
- (local-set-key "*" 'completion-separator-self-insert-command)
- (local-set-key "/" 'completion-separator-self-insert-command))
+ (setq-local completion-separator-chars
+ (append "+*/" completion-separator-chars)))
;; FORTRAN mode diffs. (these are defined when fortran is called)
(defun completion-setup-fortran-mode ()
(setq completion-syntax-table completion-fortran-syntax-table)
- (local-set-key "+" 'completion-separator-self-insert-command)
- (local-set-key "-" 'completion-separator-self-insert-command)
- (local-set-key "*" 'completion-separator-self-insert-command)
- (local-set-key "/" 'completion-separator-self-insert-command))
+ (setq-local completion-separator-chars
+ (append "+-*/" completion-separator-chars)))
\f
;; Enable completion mode.
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:global t
+ :group 'completion
;; This is always good, not specific to dynamic-completion-mode.
(define-key function-key-map [C-return] [?\C-\r])
- (dolist (x '((find-file-hook . completion-find-file-hook)
- (pre-command-hook . completion-before-command)
+ (dolist (x `((find-file-hook . ,#'completion-find-file-hook)
+ (pre-command-hook . ,#'completion-before-command)
;; Save completions when killing Emacs.
- (kill-emacs-hook . kill-emacs-save-completions)
+ (kill-emacs-hook . ,#'kill-emacs-save-completions)
+ (post-self-insert-hook . ,#'completion--post-self-insert)
;; Install the appropriate mode tables.
- (lisp-mode-hook . completion-lisp-mode-hook)
- (c-mode-hook . completion-c-mode-hook)
- (fortran-mode-hook . completion-setup-fortran-mode)))
+ (lisp-mode-hook . ,#'completion-lisp-mode-hook)
+ (c-mode-hook . ,#'completion-c-mode-hook)
+ (fortran-mode-hook . ,#'completion-setup-fortran-mode)))
(if dynamic-completion-mode
(add-hook (car x) (cdr x))
(remove-hook (car x) (cdr x))))
;; cumb
;; Patches to standard keymaps insert completions
- ([remap kill-region] . completion-kill-region)
-
- ;; 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.
- (" " . completion-separator-self-insert-autofilling)
- ("!" . completion-separator-self-insert-command)
- ("%" . completion-separator-self-insert-command)
- ("^" . completion-separator-self-insert-command)
- ("&" . completion-separator-self-insert-command)
- ("(" . completion-separator-self-insert-command)
- (")" . completion-separator-self-insert-command)
- ("=" . completion-separator-self-insert-command)
- ("`" . completion-separator-self-insert-command)
- ("|" . completion-separator-self-insert-command)
- ("{" . completion-separator-self-insert-command)
- ("}" . completion-separator-self-insert-command)
- ("[" . completion-separator-self-insert-command)
- ("]" . completion-separator-self-insert-command)
- (";" . completion-separator-self-insert-command)
- ("\"". completion-separator-self-insert-command)
- ("'" . completion-separator-self-insert-command)
- ("#" . completion-separator-self-insert-command)
- ("," . completion-separator-self-insert-command)
- ("?" . 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)
- ("." . completion-separator-self-insert-command)
- (":" . completion-separator-self-insert-command)))
+ ([remap kill-region] . completion-kill-region)))
(push (cons (car binding) (lookup-key global-map (car binding)))
completion-saved-bindings)
(global-set-key (car binding) (cdr binding)))
;; fooquux
;; fooper
- (cmpl-statistics-block
- (record-completion-file-loaded))
-
(completion-initialize)))
;;-----------------------------------------------