From: Chong Yidong Date: Wed, 28 Apr 2010 19:04:16 +0000 (-0400) Subject: Unify complete-symbol with completion-at-point. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~348 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=48111a857162c91287bc77f11b1df83c4bfdf944;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 649fa409ff4..2a90aa1dc43 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,22 @@ +2010-04-28 Chong Yidong + + * 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 * net/tramp.el (tramp-remote-selinux-p): New defun. diff --git a/lisp/bindings.el b/lisp/bindings.el index a7f6643b2db..6534f44bf0c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -671,29 +671,6 @@ is okay. See `mode-line-format'.") (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) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 14b196bbe22..8df4feaa2bb 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -1080,6 +1080,10 @@ Semantic mode. (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 mode. (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 diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 2e926005ead..710b52f37d6 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -110,56 +110,52 @@ Supports caching." 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 diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2730350c3df..b44742c0bdc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1157,7 +1157,7 @@ Point needs to be somewhere between START and END." (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 @@ Currently supported properties are: `: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 @@ except that it passes the file name through `substitute-in-file-name'." (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) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 23e175cbe7d..bde75179be8 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2027,33 +2027,6 @@ see the doc of that variable if you want to add names to the list." (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$"