diff options
| -rw-r--r-- | lisp/gud.el | 175 |
1 files changed, 175 insertions, 0 deletions
diff --git a/lisp/gud.el b/lisp/gud.el index a0d8611205a..bc42af53da9 100644 --- a/lisp/gud.el +++ b/lisp/gud.el @@ -171,6 +171,74 @@ we're in the GUD buffer)." ;; something else. It would be good if it also copied the Gud menubar entry. ;; ====================================================================== +;; speedbar support functions and variables. +(defvar gud-last-speedbar-buffer nil + "The last GUD buffer used.") + +(defvar gud-last-speedbar-stackframe nil + "Description of the currently displayed GUD stack. +t means that there is no stack, and we are in display-file mode.") + +(defvar gud-speedbar-menu-items + ;; Note to self. Add expand, and turn off items when not available. + '(["Jump to stack frame" speedbar-edit-line t]) + "Additional menu items to add the the speedbar frame.") + +(defun gud-speedbar-buttons (buffer) + "Create a speedbar display based on the current state of GUD. +If the GUD BUFFER is not running a supported debugger, then turn +off the specialized speedbar mode." + (if (and (save-excursion (goto-char (point-min)) + (looking-at "Current Stack")) + (equal gud-last-last-frame gud-last-speedbar-stackframe)) + nil + (setq gud-last-speedbar-buffer buffer) + (let* ((ff (save-excursion (set-buffer buffer) gud-find-file)) + ;;(lf (save-excursion (set-buffer buffer) gud-last-last-frame)) + (frames + (cond ((eq ff 'gud-gdb-find-file) + (gud-gdb-get-stackframe buffer) + ) + ;; Add more debuggers here! + (t + (speedbar-remove-localized-speedbar-support buffer) + nil)))) + (erase-buffer) + (if (not frames) + (insert "No Stack frames\n") + (insert "Current Stack:\n")) + (while frames + (insert (nth 1 (car frames)) ":\n") + (if (= (length (car frames)) 2) + (progn +; (speedbar-insert-button "[?]" +; 'speedbar-button-face +; nil nil nil t) + (speedbar-insert-button (car (car frames)) + 'speedbar-directory-face + nil nil nil t)) +; (speedbar-insert-button "[+]" +; 'speedbar-button-face +; 'speedbar-highlight-face +; 'gud-gdb-get-scope-data +; (car frames) t) + (speedbar-insert-button (car (car frames)) + 'speedbar-file-face + 'speedbar-highlight-face + (cond ((eq ff 'gud-gdb-find-file) + 'gud-gdb-goto-stackframe) + (t (error "Should never be here."))) + (car frames) t)) + (setq frames (cdr frames))) +; (let ((selected-frame +; (cond ((eq ff 'gud-gdb-find-file) +; (gud-gdb-selected-frame-info buffer)) +; (t (error "Should never be here.")))))) + ) + (setq gud-last-speedbar-stackframe gud-last-last-frame))) + + +;; ====================================================================== ;; gdb functions ;;; History of argument lists passed to gdb. @@ -387,6 +455,113 @@ available with older versions of GDB." (setq gud-gdb-complete-string string) ""))) +;; gdb speedbar functions + +(defun gud-gdb-goto-stackframe (text token indent) + "Goto the stackframe described by TEXT, TOKEN, and INDENT." + (speedbar-with-attached-buffer + (gud-basic-call (concat "frame " (nth 1 token))) + (sit-for 1))) + +(defvar gud-gdb-fetched-stack-frame nil + "Stack frames we are fetching from GDB.") + +(defvar gud-gdb-fetched-stack-frame-list nil + "List of stack frames we are fetching from GDB.") + +;(defun gud-gdb-get-scope-data (text token indent) +; ;; checkdoc-params: (indent) +; "Fetch data associated with a stack frame, and expand/contract it. +;Data to do this is retrieved from TEXT and TOKEN." +; (let ((args nil) (scope nil)) +; (gud-gdb-run-command-fetch-lines "info args") +; +; (gud-gdb-run-command-fetch-lines "info local") +; +; )) + +(defun gud-gdb-get-stackframe (buffer) + "Extract the current stack frame out of the GUD GDB BUFFER." + (let ((newlst nil) + (gud-gdb-fetched-stack-frame-list nil)) + (gud-gdb-run-command-fetch-lines "backtrace" buffer) + (if (string-match "No stack" (car gud-gdb-fetched-stack-frame-list)) + ;; Go into some other mode??? + nil + (while gud-gdb-fetched-stack-frame-list + (let ((e (car gud-gdb-fetched-stack-frame-list)) + (name nil) (num nil)) + (if (not (or + (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([0-9a-zA-Z_]+\\) (" e) + (string-match "^#\\([0-9]+\\) +\\([0-9a-zA-Z_]+\\) (" e))) + (if (not (string-match + "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e)) + nil + (setcar newlst + (list (nth 0 (car newlst)) + (nth 1 (car newlst)) + (match-string 1 e) + (match-string 2 e)))) + (setq num (match-string 1 e) + name (match-string 2 e)) + (setq newlst + (cons + (if (string-match + "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e) + (list name num (match-string 1 e) + (match-string 2 e)) + (list name num)) + newlst)))) + (setq gud-gdb-fetched-stack-frame-list + (cdr gud-gdb-fetched-stack-frame-list))) + (nreverse newlst)))) + +;(defun gud-gdb-selected-frame-info (buffer) +; "Learn GDB information for the currently selected stack frame in BUFFER." +; ) + +(defun gud-gdb-run-command-fetch-lines (command buffer) + "Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full. +BUFFER is the GUD buffer in which to run the command." + (save-excursion + (set-buffer buffer) + (if (save-excursion + (goto-char (point-max)) + (beginning-of-line) + (not (looking-at comint-prompt-regexp))) + nil + ;; Much of this copied from GDB complete, but I'm grabbing the stack + ;; frame instead. + (let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter)) + ;; Issue the command to GDB. + (gud-basic-call command) + (setq gud-gdb-complete-in-progress t ;; use this flag for our purposes. + gud-gdb-complete-string nil + gud-gdb-complete-list nil) + ;; Slurp the output. + (while gud-gdb-complete-in-progress + (accept-process-output (get-buffer-process gud-comint-buffer))) + (setq gud-gdb-fetched-stack-frame nil + gud-gdb-fetched-stack-frame-list + (nreverse gud-gdb-fetched-stack-frame-list)))))) + +(defun gud-gdb-speedbar-stack-filter (string) + ;; checkdoc-params: (string) + "Filter used to read in the current GDB stack." + (setq string (concat gud-gdb-fetched-stack-frame string)) + (while (string-match "\n" string) + (setq gud-gdb-fetched-stack-frame-list + (cons (substring string 0 (match-beginning 0)) + gud-gdb-fetched-stack-frame-list)) + (setq string (substring string (match-end 0)))) + (if (string-match comint-prompt-regexp string) + (progn + (setq gud-gdb-complete-in-progress nil) + string) + (progn + (setq gud-gdb-complete-string string) + ""))) + ;; ====================================================================== ;; sdb functions |