changeset 108159:56d11bda8235

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.
author Chong Yidong <cyd@stupidchicken.com>
date Wed, 28 Apr 2010 15:04:16 -0400
parents 94e4a7a7cadf
children 7fc92f732328
files lisp/ChangeLog lisp/bindings.el lisp/cedet/semantic.el lisp/cedet/semantic/ia.el lisp/minibuffer.el lisp/progmodes/etags.el
diffstat 6 files changed, 118 insertions(+), 112 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/ChangeLog	Wed Apr 28 15:04:16 2010 -0400
@@ -1,3 +1,22 @@
+2010-04-28  Chong Yidong  <cyd@stupidchicken.com>
+
+	* 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  <michael.albinus@gmx.de>
 
 	* net/tramp.el (tramp-remote-selinux-p): New defun.
--- a/lisp/bindings.el	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/bindings.el	Wed Apr 28 15:04:16 2010 -0400
@@ -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)
--- a/lisp/cedet/semantic.el	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/cedet/semantic.el	Wed Apr 28 15:04:16 2010 -0400
@@ -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
--- a/lisp/cedet/semantic/ia.el	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/cedet/semantic/ia.el	Wed Apr 28 15:04:16 2010 -0400
@@ -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
--- a/lisp/minibuffer.el	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/minibuffer.el	Wed Apr 28 15:04:16 2010 -0400
@@ -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)
--- a/lisp/progmodes/etags.el	Wed Apr 28 20:42:20 2010 +0200
+++ b/lisp/progmodes/etags.el	Wed Apr 28 15:04:16 2010 -0400
@@ -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$"