[Emacs-diffs] /srv/bzr/emacs/trunk r100076: Unify complete-symbol with completion-at-point.

[Chong Yidong]

------------------------------------------------------------
revno: 100076
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Wed 2010-04-28 15:04:16 -0400
message:
  Unify complete-symbol with completion-at-point.
  
  * bindings.el (complete-symbol): Move into minibuffer.el.
  
  * minibuffer.el (complete-tag): Move from etags.el.  If tags
  completion cannot be performed, return nil instead of signalling
  an error.
  (completion-at-point): Make it an alias for complete-symbol.
  (complete-symbol): Move from bindings.el, and replace with the
  body of completion-at-point.
  
  * progmodes/etags.el (complete-tag): Move to minibuffer.el.
  
  * cedet/semantic.el (semantic-mode): When enabled, add
  semantic-ia-complete-symbol to completion-at-point-functions.
  
  * cedet/semantic/ia.el (semantic-ia-complete-symbol): Return nil
  if Semantic is not active.
modified:
  lisp/ChangeLog
  lisp/bindings.el
  lisp/cedet/semantic.el
  lisp/cedet/semantic/ia.el
  lisp/minibuffer.el
  lisp/progmodes/etags.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-04-28 18:42:20 +0000
+++ b/lisp/ChangeLog    2010-04-28 19:04:16 +0000
@@ -1,3 +1,22 @@
+2010-04-28  Chong Yidong  <address@hidden>
+
+       * bindings.el (complete-symbol): Move into minibuffer.el.
+
+       * minibuffer.el (complete-tag): Move from etags.el.  If tags
+       completion cannot be performed, return nil instead of signalling
+       an error.
+       (completion-at-point): Make it an alias for complete-symbol.
+       (complete-symbol): Move from bindings.el, and replace with the
+       body of completion-at-point.
+
+       * progmodes/etags.el (complete-tag): Move to minibuffer.el.
+
+       * cedet/semantic.el (semantic-mode): When enabled, add
+       semantic-ia-complete-symbol to completion-at-point-functions.
+
+       * cedet/semantic/ia.el (semantic-ia-complete-symbol): Return nil
+       if Semantic is not active.
+
 2010-04-28  Michael Albinus  <address@hidden>
 
        * net/tramp.el (tramp-remote-selinux-p): New defun.

=== modified file 'lisp/bindings.el'
--- a/lisp/bindings.el  2010-04-05 23:38:53 +0000
+++ b/lisp/bindings.el  2010-04-28 19:04:16 +0000
@@ -671,29 +671,6 @@
 
 (define-key esc-map "\t" 'complete-symbol)
 
-(defun complete-symbol (arg)
-  "Perform tags completion on the text around point.
-If a tags table is loaded, call `complete-tag'.
-Otherwise, if Semantic is active, call `semantic-ia-complete-symbol'.
-
-With a prefix argument, this command does completion within
-the collection of symbols listed in the index of the manual for the
-language you are using."
-  (interactive "P")
-  (cond (arg
-        (info-complete-symbol))
-       ((or tags-table-list tags-file-name)
-        (complete-tag))
-       ((and (fboundp 'semantic-ia-complete-symbol)
-             (fboundp 'semantic-active-p)
-             (semantic-active-p))
-        (semantic-ia-complete-symbol))
-       (t
-        (error "%s"
-               (substitute-command-keys
-                "No completions available; use \\[visit-tags-table] \
-or \\[semantic-mode]")))))
-
 ;; Reduce total amount of space we must allocate during this function
 ;; that we will not need to keep permanently.
 (garbage-collect)

=== modified file 'lisp/cedet/semantic.el'
--- a/lisp/cedet/semantic.el    2010-02-16 14:35:45 +0000
+++ b/lisp/cedet/semantic.el    2010-04-28 19:04:16 +0000
@@ -1080,6 +1080,10 @@
            (require 'semantic/db-ebrowse)
            (semanticdb-load-ebrowse-caches)))
        (add-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
+       ;; Add semantic-ia-complete-symbol to
+       ;; completion-at-point-functions, so that it is run from
+       ;; M-TAB.
+       (add-hook 'completion-at-point-functions 'semantic-ia-complete-symbol)
        (if global-ede-mode
            (define-key cedet-menu-map [cedet-menu-separator] '("--")))
        (dolist (b (buffer-list))
@@ -1087,6 +1091,7 @@
            (semantic-new-buffer-fcn))))
     ;; Disable all Semantic features.
     (remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
+    (remove-hook 'completion-at-point-functions 'semantic-ia-complete-symbol)
     (define-key cedet-menu-map [cedet-menu-separator] nil)
     (define-key cedet-menu-map [semantic-options-separator] nil)
     ;; FIXME: handle semanticdb-load-ebrowse-caches

=== modified file 'lisp/cedet/semantic/ia.el'
--- a/lisp/cedet/semantic/ia.el 2010-01-13 08:35:10 +0000
+++ b/lisp/cedet/semantic/ia.el 2010-04-28 19:04:16 +0000
@@ -110,56 +110,52 @@
 If POS is nil, default to point.
 Completion options are calculated with 
`semantic-analyze-possible-completions'."
   (interactive "d")
-  (or pos (setq pos (point)))
-  ;; Calculating completions is a two step process.
-  ;;
-  ;; The first analyzer the current context, which finds tags
-  ;; for all the stuff that may be references by the code around
-  ;; POS.
-  ;;
-  ;; The second step derives completions from that context.
-  (let* ((a (semantic-analyze-current-context pos))
-        (syms (semantic-ia-get-completions a pos))
-        (pre (car (reverse (oref a prefix))))
-        )
-    ;; If PRE was actually an already completed symbol, it doesn't
-    ;; come in as a string, but as a tag instead.
-    (if (semantic-tag-p pre)
-       ;; We will try completions on it anyway.
-       (setq pre (semantic-tag-name pre)))
-    ;; Complete this symbol.
-    (if (null syms)
-       (progn
-         ;(message "No smart completions found.  Trying 
senator-complete-symbol.")
+  (when (semantic-active-p)
+    (or pos (setq pos (point)))
+    ;; Calculating completions is a two step process.
+    ;;
+    ;; The first analyzer the current context, which finds tags for
+    ;; all the stuff that may be references by the code around POS.
+    ;;
+    ;; The second step derives completions from that context.
+    (let* ((a (semantic-analyze-current-context pos))
+          (syms (semantic-ia-get-completions a pos))
+          (pre (car (reverse (oref a prefix)))))
+      ;; If PRE was actually an already completed symbol, it doesn't
+      ;; come in as a string, but as a tag instead.
+      (if (semantic-tag-p pre)
+         ;; We will try completions on it anyway.
+         (setq pre (semantic-tag-name pre)))
+      ;; Complete this symbol.
+      (if (null syms)
          (if (semantic-analyze-context-p a)
              ;; This is a clever hack.  If we were unable to find any
              ;; smart completions, lets divert to how senator derives
              ;; completions.
              ;;
-             ;; This is a way of making this fcn more useful since the
-             ;; smart completion engine sometimes failes.
-             (semantic-complete-symbol)))
-      ;; Use try completion to seek a common substring.
-      (let ((tc (try-completion (or pre "")  syms)))
-       (if (and (stringp tc) (not (string= tc (or pre ""))))
-           (let ((tok (semantic-find-first-tag-by-name
-                       tc syms)))
-             ;; Delete what came before...
-             (when (and (car (oref a bounds)) (cdr (oref a bounds)))
-               (delete-region (car (oref a bounds))
-                              (cdr (oref a bounds)))
-               (goto-char (car (oref a bounds))))
-             ;; We have some new text.  Stick it in.
-             (if tok
-                 (semantic-ia-insert-tag tok)
-               (insert tc)))
-         ;; We don't have new text.  Show all completions.
-         (when (cdr (oref a bounds))
-           (goto-char (cdr (oref a bounds))))
-         (with-output-to-temp-buffer "*Completions*"
-           (display-completion-list
-            (mapcar semantic-ia-completion-format-tag-function syms))
-           ))))))
+             ;; This is a way of making this fcn more useful since
+             ;; the smart completion engine sometimes failes.
+             (semantic-complete-symbol))
+       ;; Use try completion to seek a common substring.
+       (let ((tc (try-completion (or pre "")  syms)))
+         (if (and (stringp tc) (not (string= tc (or pre ""))))
+             (let ((tok (semantic-find-first-tag-by-name
+                         tc syms)))
+               ;; Delete what came before...
+               (when (and (car (oref a bounds)) (cdr (oref a bounds)))
+                 (delete-region (car (oref a bounds))
+                                (cdr (oref a bounds)))
+                 (goto-char (car (oref a bounds))))
+               ;; We have some new text.  Stick it in.
+               (if tok
+                   (semantic-ia-insert-tag tok)
+                 (insert tc)))
+           ;; We don't have new text.  Show all completions.
+           (when (cdr (oref a bounds))
+             (goto-char (cdr (oref a bounds))))
+           (with-output-to-temp-buffer "*Completions*"
+             (display-completion-list
+              (mapcar semantic-ia-completion-format-tag-function syms)))))))))
 
 (defcustom semantic-ia-completion-menu-format-tag-function
   'semantic-uml-concise-prototype-nonterminal

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2010-04-19 18:33:11 +0000
+++ b/lisp/minibuffer.el        2010-04-28 19:04:16 +0000
@@ -1157,7 +1157,7 @@
           (call-interactively 'minibuffer-complete)
         (delete-overlay ol)))))
 
-(defvar completion-at-point-functions nil
+(defvar completion-at-point-functions '(complete-tag)
   "Special hook to find the completion table for the thing at point.
 It is called without any argument and should return either nil,
 or a function of no argument to perform completion (discouraged),
@@ -1169,22 +1169,56 @@
  `:predicate'           a predicate that completion candidates need to satisfy.
  `:annotation-function' the value to use for `completion-annotate-function'.")
 
-(defun completion-at-point ()
-  "Complete the thing at point according to local mode."
+(declare-function tags-lazy-completion-table "etags.el" ())
+
+(defun complete-tag ()
+  "Perform tags completion on the text around point.
+If no tags table is loaded, do nothing and return nil.
+Otherwise, complete to the set of names listed in the tags table.
+The string to complete is chosen in the same way as the default
+for `find-tag'."
   (interactive)
-  (let ((res (run-hook-with-args-until-success
-              'completion-at-point-functions)))
-    (cond
-     ((functionp res) (funcall res))
-     (res
-      (let* ((plist (nthcdr 3 res))
-             (start (nth 0 res))
-             (end (nth 1 res))
-             (completion-annotate-function
-              (or (plist-get plist :annotation-function)
-                  completion-annotate-function)))
-        (completion-in-region start end (nth 2 res)
-                              (plist-get plist :predicate)))))))
+  (when (or tags-table-list tags-file-name)
+    (require 'etags)
+    (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+                                     tags-case-fold-search
+                                   case-fold-search))
+         (pattern (funcall (or find-tag-default-function
+                               (get major-mode 'find-tag-default-function)
+                               'find-tag-default)))
+         (comp-table (tags-lazy-completion-table))
+         beg)
+      (when pattern
+       (search-backward pattern)
+       (setq beg (point))
+       (forward-char (length pattern))
+       (completion-in-region beg (point) comp-table)))))
+
+(defun complete-symbol (&optional arg)
+  "Perform completion on the text around point.
+The completion method is determined by `completion-at-point-functions'.
+
+With a prefix argument, this command does completion within
+the collection of symbols listed in the index of the manual for the
+language you are using."
+  (interactive "P")
+  (if arg
+      (info-complete-symbol)
+    (let ((res (run-hook-with-args-until-success
+               'completion-at-point-functions)))
+      (cond
+       ((functionp res) (funcall res))
+       (res
+       (let* ((plist (nthcdr 3 res))
+              (start (nth 0 res))
+              (end (nth 1 res))
+              (completion-annotate-function
+               (or (plist-get plist :annotation-function)
+                   completion-annotate-function)))
+         (completion-in-region start end (nth 2 res)
+                               (plist-get plist :predicate))))))))
+
+(defalias 'completion-at-point 'complete-symbol)
 
 ;;; Key bindings.
 
@@ -1361,7 +1395,9 @@
                     (substitute-in-file-name string)
                   (error string)))
            (comp (completion-file-name-table
-                  str (or pred read-file-name-predicate) action)))
+                  str
+                 (with-no-warnings (or pred read-file-name-predicate))
+                 action)))
 
       (cond
        ((stringp comp)

=== modified file 'lisp/progmodes/etags.el'
--- a/lisp/progmodes/etags.el   2010-01-13 08:35:10 +0000
+++ b/lisp/progmodes/etags.el   2010-04-28 19:04:16 +0000
@@ -2027,33 +2027,6 @@
   (interactive)
   (quit-window t (selected-window)))
 
-;;;###autoload
-(defun complete-tag ()
-  "Perform tags completion on the text around point.
-Completes to the set of names listed in the current tags table.
-The string to complete is chosen in the same way as the default
-for \\[find-tag] (which see)."
-  (interactive)
-  (or tags-table-list
-      tags-file-name
-      (error "%s"
-            (substitute-command-keys
-             "No tags table loaded; try \\[visit-tags-table]")))
-  (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
-                                   tags-case-fold-search
-                                 case-fold-search))
-       (pattern (funcall (or find-tag-default-function
-                             (get major-mode 'find-tag-default-function)
-                             'find-tag-default)))
-        (comp-table (tags-lazy-completion-table))
-       beg)
-    (or pattern
-       (error "Nothing to complete"))
-    (search-backward pattern)
-    (setq beg (point))
-    (forward-char (length pattern))
-    (completion-in-region beg (point) comp-table)))
-
 (dolist (x '("^No tags table in use; use .* to select one$"
             "^There is no default tag$"
             "^No previous tag locations$"