cgit.sxemacs.org Git - packages/blob - xemacs-packages/speedbar/sb-gud.el

   1 ;;; sb-gud --- Speedbar support for the Grand Unified Debugger
   2
   3 ;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation
   4 ;;
   5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
   6 ;; Version: 0.1
   7 ;; Keywords: tools, gud
   8 ;; X-RCS: $Id: sb-gud.el,v 1.11 2003/09/17 16:58:28 ponced Exp $
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, you can either send email to this
  24 ;; program's author (see below) or write to:
  25 ;;
  26 ;;              The Free Software Foundation, Inc.
  27 ;;              675 Mass Ave.
  28 ;;              Cambridge, MA 02139, USA.
  29 ;;
  30 ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
  31 ;;
  32
  33 ;;; Commentary:
  34 ;;
  35 ;;   Speedbar provides a frame in which files, and locations in
  36 ;; files are displayed.  These functions provide gud specific support,
  37 ;; showing stacks, files, and the like in the side-bar.
  38 ;;
  39 ;;   To enable in emacs 20.2 or earlier, add this to your .emacs file.
  40 ;;   (autoload 'gud-speedbar-buttons "sb-gud"
  41 ;;             "GUD specific speedbar button generator.")
  42 ;;
  43 ;;   This file requires speedbar.
  44
  45 ;;; Change log:
  46 ;; 0.1   - First revision
  47 ;; 0.1.1 - Removed dependency on speedbspec.
  48 ;; 0.1.2 - Changed to handle keymap feature.
  49
  50 (require 'speedbar)
  51
  52 ;;; Code:
  53 (defvar gud-last-speedbar-buffer nil
  54   "The last GUD buffer used.")
  55
  56 (defvar gud-last-speedbar-stackframe nil
  57   "Description of the currently displayed GUD stack.
  58 t means that there is no stack, and we are in display-file mode.")
  59
  60 (defvar gud-speedbar-key-map nil
  61   "Keymap used when in the buffers display mode.")
  62
  63 (defun gud-install-speedbar-variables ()
  64   "Install those variables used by speedbar to enhance gud/gdb."
  65   (if gud-speedbar-key-map
  66       nil
  67     (setq gud-speedbar-key-map (speedbar-make-specialized-keymap))
  68
  69     (define-key gud-speedbar-key-map "j" 'speedbar-edit-line)
  70     (define-key gud-speedbar-key-map "e" 'speedbar-edit-line)
  71     (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)))
  72
  73 (defvar gud-speedbar-menu-items
  74   ;; Note to self.  Add expand, and turn off items when not available.
  75   '(["Jump to stack frame" speedbar-edit-line t])
  76   "Additional menu items to add the the speedbar frame.")
  77
  78 ;; Make sure our special speedbar mode is loaded
  79 (if (featurep 'speedbar)
  80     (gud-install-speedbar-variables)
  81   (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
  82
  83 ;;;###autoload
  84 (defun gud-speedbar-buttons (buffer)
  85   "Create a speedbar display based on the current state of GUD.
  86 If the GUD BUFFER is not running a supported debugger, then turn
  87 off the specialized speedbar mode."
  88   (if (and (save-excursion (goto-char (point-min))
  89                            (looking-at "\\(//\\)?Current Stack"))
  90            (equal gud-last-last-frame gud-last-speedbar-stackframe))
  91       nil
  92     (setq gud-last-speedbar-buffer buffer)
  93     (let* ((ff (save-excursion (set-buffer buffer) gud-find-file))
  94            ;;(lf (save-excursion (set-buffer buffer) gud-last-last-frame))
  95            (frames
  96             (cond ((eq ff 'gud-gdb-find-file)
  97                    (gud-gdb-get-stackframe buffer)
  98                    )
  99                   ;; Add more debuggers here!
 100                   (t
 101                    (speedbar-remove-localized-speedbar-support buffer)
 102                    nil))))
 103       (erase-buffer)
 104       (if (not frames)
 105           (speedbar-insert-label "No Stack frames")
 106         (speedbar-insert-label "Current Stack:"))
 107       (while frames
 108         (insert (nth 1 (car frames)) ":\n")
 109         (if (= (length (car frames)) 2)
 110             (progn
 111 ;             (speedbar-insert-button "[?]"
 112 ;                                     'speedbar-button-face
 113 ;                                     nil nil nil t)
 114               (speedbar-insert-button (car (car frames))
 115                                       'speedbar-directory-face
 116                                       nil nil nil t))
 117 ;         (speedbar-insert-button "[+]"
 118 ;                                 'speedbar-button-face
 119 ;                                 'speedbar-highlight-face
 120 ;                                 'gud-gdb-get-scope-data
 121 ;                                 (car frames) t)
 122           (speedbar-insert-button (car (car frames))
 123                                   'speedbar-file-face
 124                                   'speedbar-highlight-face
 125                                   (cond ((eq ff 'gud-gdb-find-file)
 126                                          'gud-gdb-goto-stackframe)
 127                                         (t (error "Should never be here")))
 128                                   (car frames) t))
 129         (setq frames (cdr frames)))
 130       (let ((selected-frame
 131              (cond ((eq ff 'gud-gdb-find-file)
 132                     (gud-gdb-selected-frame-info buffer))
 133                    (t (error "Should never be here")))))))
 134     (setq gud-last-speedbar-stackframe gud-last-last-frame)))
 135
 136 (defun gud-gdb-goto-stackframe (text token indent)
 137   "Goto the stackframe described by TEXT, TOKEN, and INDENT."
 138   (speedbar-with-attached-buffer
 139    (gud-basic-call (concat "frame " (nth 1 token)))
 140    (sit-for 1)))
 141
 142 (defvar gud-gdb-fetched-stack-frame nil
 143   "Stack frames we are fetching from GDB.")
 144
 145 (defvar gud-gdb-fetched-stack-frame-list nil
 146   "List of stack frames we are fetching from GDB.")
 147
 148 ;(defun gud-gdb-get-scope-data (text token indent)
 149 ;  ;; checkdoc-params: (indent)
 150 ;  "Fetch data associated with a stack frame, and expand/contract it.
 151 ;Data to do this is retrieved from TEXT and TOKEN."
 152 ;  (let ((args nil) (scope nil))
 153 ;    (gud-gdb-run-command-fetch-lines "info args")
 154 ;
 155 ;    (gud-gdb-run-command-fetch-lines "info local")
 156 ;
 157 ;    ))
 158
 159 (defun gud-gdb-get-stackframe (buffer)
 160   "Extract the current stack frame out of the GUD GDB BUFFER."
 161   (let ((newlst nil)
 162         (gud-gdb-fetched-stack-frame-list nil))
 163     (gud-gdb-run-command-fetch-lines "backtrace" buffer)
 164     (if (and (car gud-gdb-fetched-stack-frame-list)
 165              (string-match "No stack" (car gud-gdb-fetched-stack-frame-list)))
 166         ;; Go into some other mode???
 167         nil
 168       (while gud-gdb-fetched-stack-frame-list
 169         (let ((e (car gud-gdb-fetched-stack-frame-list))
 170               (name nil) (num nil))
 171           (if (not (or
 172                     (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e)
 173                     (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e)))
 174               (if (not (string-match
 175                         "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e))
 176                   nil
 177                 (setcar newlst
 178                         (list (nth 0 (car newlst))
 179                               (nth 1 (car newlst))
 180                               (match-string 1 e)
 181                               (match-string 2 e))))
 182             (setq num (match-string 1 e)
 183                   name (match-string 2 e))
 184             (setq newlst
 185                   (cons
 186                    (if (string-match
 187                         "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e)
 188                        (list name num (match-string 1 e)
 189                              (match-string 2 e))
 190                      (list name num))
 191                    newlst))))
 192         (setq gud-gdb-fetched-stack-frame-list
 193               (cdr gud-gdb-fetched-stack-frame-list)))
 194       (nreverse newlst))))
 195
 196 ;(defun gud-gdb-selected-frame-info (buffer)
 197 ;  "Learn GDB information for the currently selected stack frame in BUFFER."
 198 ;  )
 199
 200 (defun gud-gdb-run-command-fetch-lines (command buffer)
 201   "Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full.
 202 BUFFER is the GUD buffer in which to run the command."
 203   (save-excursion
 204     (set-buffer buffer)
 205     (if (save-excursion
 206           (goto-char (point-max))
 207           (beginning-of-line)
 208           (not (looking-at comint-prompt-regexp)))
 209         nil
 210       ;; Much of this copied from GDB complete, but I'm grabbing the stack
 211       ;; frame instead.
 212       (let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter))
 213         ;; Issue the command to GDB.
 214         (gud-basic-call command)
 215         (setq gud-gdb-complete-in-progress t ;; use this flag for our purposes.
 216               gud-gdb-complete-string nil
 217               gud-gdb-complete-list nil)
 218         ;; Slurp the output.
 219         (while gud-gdb-complete-in-progress
 220           (accept-process-output (get-buffer-process gud-comint-buffer)))
 221         (setq gud-gdb-fetched-stack-frame nil
 222               gud-gdb-fetched-stack-frame-list
 223               (nreverse gud-gdb-fetched-stack-frame-list))))))
 224
 225 (defun gud-gdb-speedbar-stack-filter (string)
 226   ;; checkdoc-params: (string)
 227   "Filter used to read in the current GDB stack."
 228   (setq string (concat gud-gdb-fetched-stack-frame string))
 229   (while (string-match "\n" string)
 230     (setq gud-gdb-fetched-stack-frame-list
 231           (cons (substring string 0 (match-beginning 0))
 232                 gud-gdb-fetched-stack-frame-list))
 233     (setq string (substring string (match-end 0))))
 234   (if (string-match comint-prompt-regexp string)
 235       (progn
 236         (setq gud-gdb-complete-in-progress nil)
 237         string)
 238     (progn
 239       (setq gud-gdb-complete-string string)
 240       "")))
 241
 242 (provide 'sb-gud)
 243 ;;; sb-gud.el ends here