]> code.delx.au - gnu-emacs/blobdiff - lisp/cedet/semantic/util.el
Update copyright year to 2016
[gnu-emacs] / lisp / cedet / semantic / util.el
index 126c587a80162e53f1b439d7b94d454613d19db7..2b40e94677d6482018813498a54ed63da1fea9b7 100644 (file)
@@ -1,7 +1,6 @@
 ;;; 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.
+;;; Copyright (C) 1999-2005, 2007-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: syntax
@@ -67,8 +66,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)
@@ -76,8 +74,7 @@ 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
@@ -94,14 +91,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 +131,6 @@ buffer, or a filename.  If SOMETHING is nil return nil."
 (semantic-alias-obsolete 'semantic-something-to-stream
                         'semantic-something-to-tag-table "23.2")
 
-;;; 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." "23.2")
-
 ;;; Completion APIs
 ;;
 ;; These functions provide minibuffer reading/completion for lists of
@@ -287,8 +242,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)
@@ -312,7 +266,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))
@@ -321,11 +276,12 @@ 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-reset-functions
+                     semantic-lex-syntax-modifications
                      )))
          (dolist (V vars)
            (semantic-describe-buffer-var-helper V buff)))
@@ -340,7 +296,9 @@ If TAG is not specified, use the tag at point."
                      semantic-after-toplevel-cache-change-hook
                      semantic-before-toplevel-cache-flush-hook
                      semantic-dump-parse
-
+                     semantic-type-relation-separator-character
+                     semantic-command-separation-character
+                     semantic-new-buffer-fcn-was-run
                      )))
          (dolist (V vars)
            (semantic-describe-buffer-var-helper V buff)))
@@ -350,34 +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 ((strm (cdr (semantic-fetch-tags)))
-       (res nil))
-    (setq res (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)
@@ -421,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).
@@ -488,7 +419,8 @@ determining which symbols are considered."
            (setq list (sort list 'string<))
            (if (> (length list) 1)
                (with-output-to-temp-buffer "*Completions*"
-                 (display-completion-list list pattern))
+                 (display-completion-list
+                  (completion-hilit-commonality list (length pattern) nil)))
              ;; Bury any out-of-date completions buffer.
              (let ((win (get-buffer-window "*Completions*" 0)))
                (if win (with-selected-window win (bury-buffer))))))
@@ -505,5 +437,4 @@ determining which symbols are considered."
 ;;
 (require 'semantic/util-modes)
 
-;; arch-tag: eaa7808d-83b9-43fe-adf0-4fb742dcb956
 ;;; semantic/util.el ends here