X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/996bc9bf73f16625e00df0bb58ea98b2ca3ba317..dd9af436d98d87c8c214a80e728c68cc02674ca0:/lisp/cedet/semantic/util.el diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index dfb899e594..2b3f53a49d 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -1,7 +1,7 @@ ;;; semantic/util.el --- Utilities for use with semantic tag tables ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, -;;; 2008, 2009 Free Software Foundation, Inc. +;;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: syntax @@ -26,20 +26,17 @@ ;; Semantic utility API for use with semantic tag tables. ;; -(require 'assoc) (require 'semantic) +(eval-when-compile + (require 'semantic/db-find) + ;; For semantic-find-tags-by-class, semantic--find-tags-by-function, + ;; and semantic-brute-find-tag-standard: + (require 'semantic/find)) + (declare-function data-debug-insert-stuff-list "data-debug") (declare-function data-debug-insert-thing "data-debug") -(declare-function semanticdb-file-stream "semantic/db") -(declare-function semanticdb-abstract-table-child-p "semantic/db") -(declare-function semanticdb-refresh-table "semantic/db") -(declare-function semanticdb-get-tags "semantic/db") -(declare-function semanticdb-find-results-p "semantic/db-find") - -;; For semantic-find-tags-by-class, semantic--find-tags-by-function, -;; and semantic-brute-find-tag-standard: -(eval-when-compile (require 'semantic/find)) +(declare-function semantic-ctxt-current-symbol-and-bounds "semantic/ctxt") ;;; Code: @@ -68,22 +65,21 @@ If FILE is not loaded, check to see if `semanticdb' feature exists, and use it to get tags from files not in memory. If FILE is not loaded, and semanticdb is not available, find the file and parse it." - (if (find-buffer-visiting file) - (save-excursion - (set-buffer (find-buffer-visiting file)) - (semantic-fetch-tags)) - ;; File not loaded - (if (and (fboundp 'semanticdb-minor-mode-p) - (semanticdb-minor-mode-p)) - ;; semanticdb is around, use it. - (semanticdb-file-stream file) - ;; Get the stream ourselves. - (save-excursion - (set-buffer (find-file-noselect file)) - (semantic-fetch-tags))))) + (save-match-data + (if (find-buffer-visiting file) + (with-current-buffer (find-buffer-visiting file) + (semantic-fetch-tags)) + ;; File not loaded + (if (and (require 'semantic/db-mode) + (semanticdb-minor-mode-p)) + ;; semanticdb is around, use it. + (semanticdb-file-stream file) + ;; Get the stream ourselves. + (with-current-buffer (find-file-noselect file) + (semantic-fetch-tags)))))) (semantic-alias-obsolete 'semantic-file-token-stream - 'semantic-file-tag-table) + 'semantic-file-tag-table "23.2") (defun semantic-something-to-tag-table (something) "Convert SOMETHING into a semantic tag table. @@ -96,14 +92,12 @@ buffer, or a filename. If SOMETHING is nil return nil." something) ;; A buffer ((bufferp something) - (save-excursion - (set-buffer something) + (with-current-buffer something (semantic-fetch-tags))) ;; A Tag: Get that tag's buffer ((and (semantic-tag-with-position-p something) (semantic-tag-in-buffer-p something)) - (save-excursion - (set-buffer (semantic-tag-buffer something)) + (with-current-buffer (semantic-tag-buffer something) (semantic-fetch-tags))) ;; Tag with a file name in it ((and (semantic-tag-p something) @@ -136,46 +130,7 @@ buffer, or a filename. If SOMETHING is nil return nil." (t nil))) (semantic-alias-obsolete 'semantic-something-to-stream - 'semantic-something-to-tag-table) - -;;; Recursive searching through dependency trees -;; -;; This will depend on the general searching APIS defined above. -;; but will add full recursion through the dependencies list per -;; stream. -(defun semantic-recursive-find-nonterminal-by-name (name buffer) - "Recursively find the first occurrence of NAME. -Start search with BUFFER. Recurse through all dependencies till found. -The return item is of the form (BUFFER TOKEN) where BUFFER is the buffer -in which TOKEN (the token found to match NAME) was found. - -THIS ISN'T USED IN SEMANTIC. DELETE ME SOON." - (save-excursion - (set-buffer buffer) - (let* ((stream (semantic-fetch-tags)) - (includelist (or (semantic-find-tags-by-class 'include stream) - "empty.silly.thing")) - (found (semantic-find-first-tag-by-name name stream)) - (unfound nil)) - (while (and (not found) includelist) - (let ((fn (semantic-dependency-tag-file (car includelist)))) - (if (and fn (not (member fn unfound))) - (save-excursion - (set-buffer (find-file-noselect fn)) - (message "Scanning %s" (buffer-file-name)) - (setq stream (semantic-fetch-tags)) - (setq found (semantic-find-first-tag-by-name name stream)) - (if found - (setq found (cons (current-buffer) (list found))) - (setq includelist - (append includelist - (semantic-find-tags-by-class - 'include stream)))) - (setq unfound (cons fn unfound))))) - (setq includelist (cdr includelist))) - found))) -(make-obsolete 'semantic-recursive-find-nonterminal-by-name - "Do not use this function.") + 'semantic-something-to-tag-table "23.2") ;;; Completion APIs ;; @@ -288,8 +243,7 @@ If TAG is not specified, use the tag at point." (defun semantic-describe-buffer-var-helper (varsym buffer) "Display to standard out the value of VARSYM in BUFFER." (require 'data-debug) - (let ((value (save-excursion - (set-buffer buffer) + (let ((value (with-current-buffer buffer (symbol-value varsym)))) (cond ((and (consp value) @@ -313,7 +267,8 @@ If TAG is not specified, use the tag at point." ) (with-output-to-temp-buffer (help-buffer) - (help-setup-xref (list #'semantic-describe-buffer) (interactive-p)) + (help-setup-xref (list #'semantic-describe-buffer) + (called-interactively-p 'interactive)) (with-current-buffer standard-output (princ "Semantic Configuration in ") (princ (buffer-name buff)) @@ -322,26 +277,28 @@ If TAG is not specified, use the tag at point." (princ "Buffer specific configuration items:\n") (let ((vars '(major-mode semantic-case-fold - semantic-expand-nonterminal + semantic-tag-expand-function semantic-parser-name semantic-parse-tree-state semantic-lex-analyzer semantic-lex-reset-hooks + semantic-lex-syntax-modifications ))) (dolist (V vars) (semantic-describe-buffer-var-helper V buff))) (princ "\nGeneral configuration items:\n") (let ((vars '(semantic-inhibit-functions - semantic-init-hooks - semantic-init-db-hooks + semantic-init-hook + semantic-init-db-hook semantic-unmatched-syntax-hook semantic--before-fetch-tags-hook semantic-after-toplevel-bovinate-hook semantic-after-toplevel-cache-change-hook semantic-before-toplevel-cache-flush-hook semantic-dump-parse - + semantic-type-relation-separator-character + semantic-command-separation-character ))) (dolist (V vars) (semantic-describe-buffer-var-helper V buff))) @@ -351,44 +308,6 @@ If TAG is not specified, use the tag at point." ))) ) -(defun semantic-current-tag-interactive (p) - "Display the current token. -Argument P is the point to search from in the current buffer." - (interactive "d") - (require 'semantic/find) - (let ((tok (semantic-brute-find-innermost-tag-by-position - p (current-buffer)))) - (message (mapconcat 'semantic-abbreviate-nonterminal tok ",")) - (car tok)) - ) - -(defun semantic-hack-search () - "Display info about something under the cursor using generic methods." - (interactive) - (require 'semantic/find) - (let ( - ;(name (thing-at-point 'symbol)) - (strm (cdr (semantic-fetch-tags))) - (res nil)) -; (if name - (setq res -; (semantic-find-nonterminal-by-name name strm) -; (semantic-find-nonterminal-by-type name strm) -; (semantic-recursive-find-nonterminal-by-name name (current-buffer)) - (semantic-brute-find-tag-by-position (point) strm) - - ) -; ) - (if res - (progn - (pop-to-buffer "*SEMANTIC HACK RESULTS*") - (require 'pp) - (erase-buffer) - (insert (pp-to-string res) "\n") - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer)) - (message "nil")))) - (defun semantic-assert-valid-token (tok) "Assert that TOK is a valid token." (if (semantic-tag-p tok) @@ -432,13 +351,90 @@ NOTFIRST indicates that this was not the first call in the recursive use." 'unmatched))) (setq o (cons (car over) o))) (setq over (cdr over))) - (message "Remaining overlays: %S" o))) + (when (called-interactively-p 'any) + (message "Remaining overlays: %S" o)))) over) +;;; Interactive commands (from Senator). + +;; The Senator library from upstream CEDET is not included in the +;; built-in version of Emacs. The plan is to fold it into the +;; different parts of CEDET and Emacs, so that it works +;; "transparently". Here are some interactive commands based on +;; Senator. + +;; Symbol completion + +(defun semantic-find-tag-for-completion (prefix) + "Find all tags with name starting with PREFIX. +This uses `semanticdb' when available." + (let (result ctxt) + ;; Try the Semantic analyzer + (condition-case nil + (and (featurep 'semantic/analyze) + (setq ctxt (semantic-analyze-current-context)) + (setq result (semantic-analyze-possible-completions ctxt))) + (error nil)) + (or result + ;; If the analyzer fails, then go into boring completion. + (if (and (featurep 'semantic/db) + (semanticdb-minor-mode-p) + (require 'semantic/db-find)) + (semanticdb-fast-strip-find-results + (semanticdb-deep-find-tags-for-completion prefix)) + (semantic-deep-find-tags-for-completion prefix (current-buffer)))))) + +(defun semantic-complete-symbol (&optional predicate) + "Complete the symbol under point, using Semantic facilities. +When called from a program, optional arg PREDICATE is a predicate +determining which symbols are considered." + (interactive) + (require 'semantic/ctxt) + (let* ((start (car (nth 2 (semantic-ctxt-current-symbol-and-bounds + (point))))) + (pattern (regexp-quote (buffer-substring start (point)))) + collection completion) + (when start + (if (and semantic--completion-cache + (eq (nth 0 semantic--completion-cache) (current-buffer)) + (= (nth 1 semantic--completion-cache) start) + (save-excursion + (goto-char start) + (looking-at (nth 3 semantic--completion-cache)))) + ;; Use cached value. + (setq collection (nthcdr 4 semantic--completion-cache)) + ;; Perform new query. + (setq collection (semantic-find-tag-for-completion pattern)) + (setq semantic--completion-cache + (append (list (current-buffer) start 0 pattern) + collection)))) + (if (null collection) + (let ((str (if pattern (format " for \"%s\"" pattern) ""))) + (if (window-minibuffer-p (selected-window)) + (minibuffer-message (format " [No completions%s]" str)) + (message "Can't find completion%s" str))) + (setq completion (try-completion pattern collection predicate)) + (if (string= pattern completion) + (let ((list (all-completions pattern collection predicate))) + (setq list (sort list 'string<)) + (if (> (length list) 1) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list list pattern)) + ;; Bury any out-of-date completions buffer. + (let ((win (get-buffer-window "*Completions*" 0))) + (if win (with-selected-window win (bury-buffer)))))) + ;; Exact match + (delete-region start (point)) + (insert completion) + ;; Bury any out-of-date completions buffer. + (let ((win (get-buffer-window "*Completions*" 0))) + (if win (with-selected-window win (bury-buffer)))))))) + (provide 'semantic/util) ;;; Minor modes ;; (require 'semantic/util-modes) +;; arch-tag: eaa7808d-83b9-43fe-adf0-4fb742dcb956 ;;; semantic/util.el ends here