X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ba4502fe1465f7803beca3ae187e41f0b25bef10..9d463aec8b3d848556bbe320c0cf8bd310528168:/lisp/completion.el diff --git a/lisp/completion.el b/lisp/completion.el index d2d94e778d..093740d2cc 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -1,6 +1,6 @@ ;;; completion.el --- dynamic word-completion code -;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2014 Free Software +;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2016 Free Software ;; Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -373,7 +373,7 @@ Used to decide whether to save completions.") (defvar cmpl-preceding-syntax) -(defvar completion-string) +(defvar cmpl--completion-string) ;;--------------------------------------------------------------------------- ;; Low level tools @@ -542,13 +542,13 @@ But only if it is longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char saved-point))) ;; Remove chars to ignore at the end. (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) (goto-char cmpl-symbol-end) - (forward-word -1) + (forward-word-strictly -1) (setq cmpl-symbol-end (point)) (goto-char saved-point))) ;; Return completion if the length is reasonable. @@ -584,7 +584,7 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end))) ;; Return value if long enough. @@ -597,12 +597,12 @@ Returns nil if there isn't one longer than `completion-min-length'." (let ((saved-point (point))) (setq cmpl-symbol-start (scan-sexps saved-point -1)) ;; take off chars. from end - (forward-word -1) + (forward-word-strictly -1) (setq cmpl-symbol-end (point)) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)))) ;; Restore state. (goto-char saved-point) @@ -653,7 +653,7 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end))) ;; Return completion if the length is reasonable. @@ -821,7 +821,7 @@ This is sensitive to `case-fold-search'." ;; symbol char to ignore at end. Are we at end ? (progn (setq saved-point-2 (point)) - (forward-word -1) + (forward-word-strictly -1) (prog1 (= (char-syntax (preceding-char)) ? ) (goto-char saved-point-2))))) @@ -1082,7 +1082,7 @@ Must be called after `find-exact-completion'." (cmpl-db-debug-p ;; not found, error if debug mode (error "Completion entry exists but not on prefix list - %s" - completion-string)) + cmpl--completion-string)) (inside-locate-completion-entry ;; recursive error: really scrod (locate-completion-db-error)) @@ -1149,73 +1149,75 @@ COMPLETION-STRING must be longer than `completion-prefix-min-length'. Updates the saved string with the supplied string. This must be very fast. Returns the completion entry." - ;; Handle pending acceptance - (if completion-to-accept (accept-completion)) - ;; test if already in database - (if (setq cmpl-db-entry (find-exact-completion 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))))) + (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))))) - (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 - @@ -1311,7 +1313,7 @@ are specified." (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) @@ -1848,7 +1850,7 @@ Prefix args :: (cond ((looking-at "\\(define\\|ifdef\\)\\>") ;; skip forward over definition symbol ;; and add it to database - (and (forward-word 2) + (and (forward-word-strictly 2) (setq string (symbol-before-point)) ;;(push string foo) (add-completion-to-tail-if-new string))))) @@ -1866,7 +1868,7 @@ Prefix args :: ;; move to next separator char. (goto-char (setq next-point (scan-sexps (point) 1)))) - (forward-word -1) + (forward-word-strictly -1) ;; add to database (if (setq string (symbol-under-point)) ;; (push string foo) @@ -1874,7 +1876,7 @@ Prefix args :: ;; Local TMC hack (useful for parsing paris.h) (if (and (looking-at "_AP") ;; "ansi prototype" (progn - (forward-word -1) + (forward-word-strictly -1) (setq string (symbol-under-point)))) (add-completion-to-tail-if-new string))) @@ -2156,26 +2158,27 @@ Patched to remove the most recent completion." ;; 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 @@ -2225,12 +2228,9 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (defun completion-lisp-mode-hook () (setq completion-syntax-table completion-lisp-syntax-table) ;; Lisp Mode diffs - (local-set-key "!" 'self-insert-command) - (local-set-key "&" 'self-insert-command) - (local-set-key "%" 'self-insert-command) - (local-set-key "?" 'self-insert-command) - (local-set-key "=" 'self-insert-command) - (local-set-key "^" 'self-insert-command)) + (setq-local completion-separator-chars + (cl-set-difference completion-separator-chars + (append "!&%?=^" nil)))) ;; C mode diffs. @@ -2244,9 +2244,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (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) @@ -2259,10 +2258,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (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))) ;; Enable completion mode. @@ -2281,15 +2278,16 @@ if ARG is omitted or nil." ;; 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)))) @@ -2315,44 +2313,7 @@ if ARG is omitted or nil." ;; 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 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)))