Add 2011 to FSF/AIST copyright years.
[bpt/emacs.git] / lisp / cedet / semantic / analyze / debug.el
index db89f66..6499f61 100644 (file)
@@ -1,6 +1,6 @@
 ;;; semantic/analyze/debug.el --- Debug the analyzer
 
-;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+;;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 
@@ -32,6 +32,8 @@
 ;; For semantic-find-tags-by-class:
 (eval-when-compile (require 'semantic/find))
 
+(declare-function ede-get-locator-object "ede/files")
+
 ;;; Code:
 
 (defun semantic-analyze-debug-assist ()
@@ -52,6 +54,8 @@
 
     ))
 
+;; @TODO - If this happens, but the last found type is
+;; a datatype, then the below is wrong
 (defun semantic-analyzer-debug-found-prefix (ctxt)
   "Debug the prefix found by the analyzer output CTXT."
   (let* ((pf (oref ctxt prefix))
@@ -95,15 +99,14 @@ Argument COMP are possible completions here."
        )
     (with-output-to-temp-buffer (help-buffer)
       (with-current-buffer standard-output
-       (princ "Unable to find prefix ")
+       (princ "Unable to find symbol ")
        (princ prefix)
        (princ ".\n\n")
 
        ;; NOTE: This line is copied from semantic-analyze-current-context.
        ;;       You will need to update both places.
        (condition-case err
-           (save-excursion
-             (set-buffer origbuf)
+           (with-current-buffer origbuf
              (let* ((position (or (cdr-safe (oref ctxt bounds)) (point)))
                     (prefixtypes nil) ; Used as type return
                     (scope (semantic-calculate-scope position))
@@ -216,7 +219,7 @@ Argument COMP are possible completions here."
     (when (not dt) (error "Missing Innertype debugger is confused"))
     (with-output-to-temp-buffer (help-buffer)
       (with-current-buffer standard-output
-       (princ "Cannot find prefix \"")
+       (princ "Cannot find symbol \"")
        (princ prefixitem)
        (princ "\" in datatype:
   ")
@@ -244,13 +247,11 @@ with the command:
          (princ "\nSemantic has found the datatype ")
          (semantic-analyzer-debug-insert-tag dt)
          (if (or (not (semantic-equivalent-tag-p ots dt))
-                 (not (save-excursion
-                        (set-buffer orig-buffer)
+                 (not (with-current-buffer orig-buffer
                         (car (semantic-analyze-dereference-metatype
                          ots (oref ctxt scope))))))
              (let ((lasttype ots)
-                   (nexttype (save-excursion
-                               (set-buffer orig-buffer)
+                   (nexttype (with-current-buffer orig-buffer
                                (car (semantic-analyze-dereference-metatype
                                 ots (oref ctxt scope))))))
                (if (eq nexttype lasttype)
@@ -272,8 +273,7 @@ with the command:
                  (princ "\n")
                  (setq lasttype nexttype
                        nexttype
-                       (save-excursion
-                         (set-buffer orig-buffer)
+                       (with-current-buffer orig-buffer
                          (car (semantic-analyze-dereference-metatype
                           nexttype (oref ctxt scope)))))
                  )
@@ -389,22 +389,19 @@ or implementing a version specific to ")
   (let ((inc (semantic-find-tags-by-class 'include table))
        ;;(path (semanticdb-find-test-translate-path-no-loading))
        (unk
-        (save-excursion
-          (set-buffer (semanticdb-get-buffer table))
+        (with-current-buffer (semanticdb-get-buffer table)
           semanticdb-find-lost-includes))
        (ip
-        (save-excursion
-          (set-buffer (semanticdb-get-buffer table))
+        (with-current-buffer (semanticdb-get-buffer table)
           semantic-dependency-system-include-path))
        (edeobj
-        (save-excursion
-          (set-buffer (semanticdb-get-buffer table))
-          ede-object))
+        (with-current-buffer (semanticdb-get-buffer table)
+          (and (boundp 'ede-object)
+               ede-object)))
        (edeproj
-        (save-excursion
-          (set-buffer (semanticdb-get-buffer table))
-          ede-object-project))
-       )
+        (with-current-buffer (semanticdb-get-buffer table)
+          (and (boundp 'ede-object-project)
+               ede-object-project))))
 
     (princ "\n\nInclude Path Summary:")
     (when edeobj
@@ -555,24 +552,25 @@ PARENT is a possible parent (by nesting) tag."
   (let ((str (semantic-format-tag-prototype tag parent)))
     (if (and (semantic-tag-with-position-p tag)
             (semantic-tag-file-name tag))
-       (insert-button str
-                      'mouse-face 'custom-button-pressed-face
-                      'tag tag
-                      'action
-                      `(lambda (button)
-                         (let ((buff nil)
-                               (pnt nil))
-                           (save-excursion
-                             (semantic-go-to-tag
-                              (button-get button 'tag))
-                             (setq buff (current-buffer))
-                             (setq pnt (point)))
-                           (if (get-buffer-window buff)
-                               (select-window (get-buffer-window buff))
-                             (pop-to-buffer buff t))
-                           (goto-char pnt)
-                           (pulse-line-hook-function)))
-                      )
+       (with-current-buffer standard-output
+         (insert-button str
+                        'mouse-face 'custom-button-pressed-face
+                        'tag tag
+                        'action
+                        `(lambda (button)
+                           (let ((buff nil)
+                                 (pnt nil))
+                             (save-excursion
+                               (semantic-go-to-tag
+                                (button-get button 'tag))
+                               (setq buff (current-buffer))
+                               (setq pnt (point)))
+                             (if (get-buffer-window buff)
+                                 (select-window (get-buffer-window buff))
+                               (pop-to-buffer buff t))
+                             (goto-char pnt)
+                             (pulse-line-hook-function)))
+                        ))
       (princ "\"")
       (princ str)
       (princ "\""))
@@ -586,35 +584,29 @@ PARENT is a possible parent (by nesting) tag."
 Look for key expressions, and add push-buttons near them."
   (let ((orig-buffer (make-marker)))
     (set-marker orig-buffer (point) (current-buffer))
-    (save-excursion
-      ;; Get a buffer ready.
-      (set-buffer "*Help*")
-      (toggle-read-only -1)
-      (goto-char (point-min))
-      (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer)
-      ;; First, add do-in buttons to recommendations.
-      (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
-       (let ((fcn (match-string 1)))
-         (when (not (fboundp (intern-soft fcn)))
-           (error "Help Err: Can't find %s" fcn))
-         (end-of-line)
-         (insert "   ")
-         (insert-button "[ Do It ]"
-                        'mouse-face 'custom-button-pressed-face
-                        'do-fcn fcn
-                        'action `(lambda (arg)
-                                   (let ((M semantic-analyzer-debug-orig))
-                                     (set-buffer (marker-buffer M))
-                                     (goto-char M))
-                                   (call-interactively (quote ,(intern-soft fcn))))
-                        )
-         ))
+    ;; Get a buffer ready.
+    (with-current-buffer "*Help*"
+      (let ((inhibit-read-only t))
+       (goto-char (point-min))
+       (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer)
+       ;; First, add do-in buttons to recommendations.
+       (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
+         (let ((fcn (match-string 1)))
+           (when (not (fboundp (intern-soft fcn)))
+             (error "Help Err: Can't find %s" fcn))
+           (end-of-line)
+           (insert "   ")
+           (insert-button "[ Do It ]"
+                          'mouse-face 'custom-button-pressed-face
+                          'do-fcn fcn
+                          'action `(lambda (arg)
+                                     (let ((M semantic-analyzer-debug-orig))
+                                       (set-buffer (marker-buffer M))
+                                       (goto-char M))
+                                     (call-interactively (quote ,(intern-soft fcn))))))))
       ;; Do something else?
-
       ;; Clean up the mess
-      (toggle-read-only 1)
-      (set-buffer-modified-p nil)
-      )))
+      (set-buffer-modified-p nil))))
 
 (provide 'semantic/analyze/debug)