X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/af7b5a91b2c7e4f3ee18f72192d7baa572d03735..5df4f04cd32af723742c81095b38ae83b3c2b462:/lisp/cedet/semantic/util.el diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 5d22cd068b..2775153e55 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, 2011 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: @@ -70,8 +67,7 @@ If FILE is not loaded, and semanticdb is not available, find the file and parse it." (save-match-data (if (find-buffer-visiting file) - (save-excursion - (set-buffer (find-buffer-visiting file)) + (with-current-buffer (find-buffer-visiting file) (semantic-fetch-tags)) ;; File not loaded (if (and (require 'semantic/db-mode) @@ -79,12 +75,11 @@ If FILE is not loaded, and semanticdb is not available, find the file ;; semanticdb is around, use it. (semanticdb-file-stream file) ;; Get the stream ourselves. - (save-excursion - (set-buffer (find-file-noselect file)) + (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. @@ -97,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) @@ -137,47 +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 - (save-match-data - (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 ;; @@ -290,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) @@ -315,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)) @@ -324,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))) @@ -353,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) @@ -434,7 +351,8 @@ 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). @@ -445,17 +363,13 @@ NOTFIRST indicates that this was not the first call in the recursive use." ;; "transparently". Here are some interactive commands based on ;; Senator. -(defvar semantic--completion-cache nil - "Internal variable used by `senator-complete-symbol'.") - -(defsubst semantic-symbol-start (pos) - "Return the start of the symbol at buffer position POS." - (car (nth 2 (semantic-ctxt-current-symbol-and-bounds pos)))) +;; 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)) @@ -463,7 +377,9 @@ This uses `semanticdb' when available." (error nil)) (or result ;; If the analyzer fails, then go into boring completion. - (if (and (featurep 'semantic/db) (semanticdb-minor-mode-p)) + (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)))))) @@ -473,6 +389,7 @@ This uses `semanticdb' when available." 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)))) @@ -519,4 +436,5 @@ determining which symbols are considered." ;; (require 'semantic/util-modes) +;; arch-tag: eaa7808d-83b9-43fe-adf0-4fb742dcb956 ;;; semantic/util.el ends here