;;; 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 <zappo@gnu.org>
;; Keywords: syntax
;; 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:
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)
;; 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.
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)
(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
;;
(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)
)
(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))
(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)))
)))
)
-(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)
'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).
;; "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))
(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))))))
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))))
;;
(require 'semantic/util-modes)
+;; arch-tag: eaa7808d-83b9-43fe-adf0-4fb742dcb956
;;; semantic/util.el ends here