Tweak the left precedence of '=>'

[gnu-emacs] / lisp / completion.el

diff --git a/lisp/completion.el b/lisp/completion.el
index d2d94e778d59454ede671391be89c2c581e9b75c..093740d2cc38aa51c1de090bfadc25f5b8221e74 100644 (file)
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1,6 +1,6 @@
 ;;; completion.el --- dynamic word-completion code
 
 ;;; 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
 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org


@@ -373,7 +373,7 @@ Used to decide whether to save completions.")
 
 (defvar cmpl-preceding-syntax)
 
 
 (defvar cmpl-preceding-syntax)
 

-(defvar completion-string)
+(defvar cmpl--completion-string)

 \f
 ;;---------------------------------------------------------------------------
 ;; Low level tools
 \f
 ;;---------------------------------------------------------------------------
 ;; 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)
         ;; 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)
                (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.
                (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)
            ;; 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.
                   (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
            (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)
              (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)
                     (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)
            ;; 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.
                   (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))
                                  ;; 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)))))
                                    (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"
             (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))
             (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."
 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
 
 (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)))
                      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 -
 
 ;; Tests --
 ;;  - Add and Find -


@@ -1311,7 +1313,7 @@ are specified."
   (delete-completion string))
 
 (defun accept-completion ()
   (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)
 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
                     (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)))))
                                 (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))))
                         ;; 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)
                       ;; 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
                         ;; 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)))
                                    (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
 ;; 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).
 
 ;; 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
 
 ;;-----------------------------------------------
 ;; 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
 (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.
 
 
 ;; 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)
 (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)
 
 
 ;; 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)
 
 (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.
 
 \f
 ;; 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])
 
   ;; 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.
                ;; 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.
 
                ;; 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))))
     (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
                ;; 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)))
       (push (cons (car binding) (lookup-key global-map (car binding)))
             completion-saved-bindings)
       (global-set-key (car binding) (cdr binding)))