;;; Known Bugs:
;; 1) Strings that are watched don't update in the speedbar when their
-;; contents change unless the first character changes.
+;; contents change unless the first character changes.
;; 2) Cannot handle multiple debug sessions.
-;; 3) Initially, the assembler buffer does not display the cursor at the
-;; current line if the line is not visible in the window (but when testing
-;; gdb-assembler-custom with a lisp debugger it does!).
+;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
+;; 4) M-x gdb doesn't work if the corefile is specified in the command in the
+;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer).
+;; 5) If you wish to call procedures from your program in GDB
+;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations
+;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed.
;;; Problems with watch expressions, GDB/MI:
;; 1) They go out of scope when the inferior is re-run.
;; 3) VARNUM increments even when variable object is not created
;; (maybe trivial).
-;; Known Bugs:
-;; 1) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
-
;;; TODO:
;; 1) Use MI command -data-read-memory for memory window.
;; 2) Use tree-widget.el instead of the speedbar for watch-expressions?
;; 3) Mark breakpoint locations on scroll-bar of source buffer?
-;; 4) With gud-print and gud-pstar, print the variable name in the GUD
-;; buffer instead of the value's history number.
;;; Code:
(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)
-(defvar gdb-frame-address "main" "Initialization for Assembler buffer.")
+(defvar gdb-pc-address nil "Initialization for Assembler buffer.
+Set to \"main\" at start if gdb-show-main is t.")
+(defvar gdb-frame-address nil "Identity of frame for watch expression.")
(defvar gdb-previous-frame-address nil)
(defvar gdb-memory-address "main")
(defvar gdb-previous-frame nil)
(defvar gdb-current-language nil)
(defvar gdb-var-list nil
"List of variables in watch window.
-Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
-STATUS is nil (unchanged), `changed' or `out-of-scope'.")
-(defvar gdb-force-update t
- "Non-nil means that view of watch expressions will be updated in the speedbar.")
+Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP)
+where STATUS is nil (unchanged), `changed' or `out-of-scope', FP the frame
+address for root variables.")
(defvar gdb-main-file nil "Source file from which program execution begins.")
+(defvar gud-old-arrow nil)
(defvar gdb-overlay-arrow-position nil)
+(defvar gdb-stack-position nil)
(defvar gdb-server-prefix nil)
(defvar gdb-flush-pending-output nil)
(defvar gdb-location-alist nil
(defvar gdb-source-window nil)
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
+(defvar gdb-look-up-stack nil)
+(defvar gdb-frame-begin nil
+ "Non-nil when GDB generates frame-begin annotation.")
+(defvar gdb-printing t)
(defvar gdb-buffer-type nil
"One of the symbols bound in `gdb-buffer-rules'.")
:version "22.1")
(defcustom gdb-many-windows nil
- "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
+ "nil means just pop up the GUD buffer unless `gdb-show-main' is t.
In this case it starts with two windows: one displaying the GUD
buffer and the other with the source file with the main routine
-of the inferior. Non-nil means display the layout shown for
+of the debugged program. Non-nil means display the layout shown for
`gdba'."
:type 'boolean
:group 'gud
:version "22.1")
(defcustom gdb-use-separate-io-buffer nil
- "Non-nil means display output from the inferior in a separate buffer."
+ "Non-nil means display output from the debugged program in a separate buffer."
:type 'boolean
:group 'gud
:version "22.1")
(error nil))))
(defun gdb-use-separate-io-buffer (arg)
- "Toggle separate IO for inferior.
+ "Toggle separate IO for debugged program.
With arg, use separate IO iff arg is positive."
(interactive "P")
(setq gdb-use-separate-io-buffer
(if (null arg)
(not gdb-use-separate-io-buffer)
(> (prefix-numeric-value arg) 0)))
- (message (format "Separate inferior IO %sabled"
+ (message (format "Separate IO %sabled"
(if gdb-use-separate-io-buffer "en" "dis")))
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer))
(list t nil) nil "-c"
(concat gdb-cpp-define-alist-program " "
gdb-cpp-define-alist-flags)))))
- (define-list (split-string output "\n" t))
- (name))
+ (define-list (split-string output "\n" t)) (name))
(setq gdb-define-alist nil)
(dolist (define define-list)
(setq name (nth 1 (split-string define "[( ]")))
(goto-char (point-min))
(when (search-forward "read in on demand:" nil t)
(while (re-search-forward gdb-source-file-regexp nil t)
- (push (or (match-string 1) (match-string 2)) gdb-source-file-list))
+ (push (file-name-nondirectory (or (match-string 1) (match-string 2)))
+ gdb-source-file-list))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and buffer-file-name
(when gud-tooltip-mode
(make-local-variable 'gdb-define-alist)
(gdb-create-define-alist)
- (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))))
+ (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
+ (gdb-force-mode-line-update
+ (propertize "ready" 'face font-lock-variable-name-face)))
(defun gdb-find-watch-expression ()
(let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-1]
'gdb-mouse-set-clear-breakpoint)
- (define-key gud-minor-mode-map [left-fringe mouse-2]
- 'gdb-mouse-until)
+ (define-key gud-minor-mode-map [left-margin C-mouse-1]
+ 'gdb-mouse-toggle-breakpoint-margin)
+ (define-key gud-minor-mode-map [left-fringe C-mouse-1]
+ 'gdb-mouse-toggle-breakpoint-fringe)
+
(define-key gud-minor-mode-map [left-margin drag-mouse-1]
'gdb-mouse-until)
(define-key gud-minor-mode-map [left-fringe drag-mouse-1]
'gdb-mouse-until)
- (define-key gud-minor-mode-map [left-margin mouse-2]
+ (define-key gud-minor-mode-map [left-margin mouse-3]
+ 'gdb-mouse-until)
+ (define-key gud-minor-mode-map [left-fringe mouse-3]
'gdb-mouse-until)
+
(define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
'gdb-mouse-jump)
(define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
'gdb-mouse-jump)
- (define-key gud-minor-mode-map [left-fringe C-mouse-2]
+ (define-key gud-minor-mode-map [left-fringe C-mouse-3]
'gdb-mouse-jump)
- (define-key gud-minor-mode-map [left-margin C-mouse-2]
+ (define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- (define-key gud-minor-mode-map [left-margin mouse-3]
- 'gdb-mouse-toggle-breakpoint-margin)
- (define-key gud-minor-mode-map [left-fringe mouse-3]
- 'gdb-mouse-toggle-breakpoint-fringe)
(setq comint-input-sender 'gdb-send)
;; (re-)initialize
- (setq gdb-frame-address (if gdb-show-main "main" nil))
+ (setq gdb-pc-address (if gdb-show-main "main" nil))
(setq gdb-previous-frame-address nil
gdb-memory-address "main"
gdb-previous-frame nil
gdb-current-language nil
gdb-frame-number nil
gdb-var-list nil
- gdb-force-update t
+ gdb-main-file nil
gdb-first-post-prompt t
gdb-prompting nil
gdb-input-queue nil
gdb-signalled nil
gdb-source-window nil
gdb-inferior-status nil
- gdb-continuation nil)
+ gdb-continuation nil
+ gdb-look-up-stack nil
+ gdb-frame-begin nil
+ gdb-printing t
+ gud-old-arrow nil)
(setq gdb-buffer-type 'gdba)
(defun gdb-get-version ()
(goto-char (point-min))
- (if (and (re-search-forward gdb-error-regexp nil t)
- (string-match ".*(missing implementation)" (match-string 1)))
+ (if (re-search-forward "Undefined\\( mi\\)* command:" nil t)
(setq gdb-version "pre-6.4")
(setq gdb-version "6.4+"))
(gdb-init-2))
(if event (posn-set-point (event-end event)))
(require 'tooltip)
(save-selected-window
- (let ((expr (if arg
- (completing-read "Name of variable: "
- 'gud-gdb-complete-command)
- (tooltip-identifier-from-point (point)))))
+ (let ((expr
+ (if arg
+ (completing-read "Name of variable: "
+ 'gud-gdb-complete-command)
+ (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ (tooltip-identifier-from-point (point))))))
+ (speedbar 1)
(catch 'already-watched
(dolist (var gdb-var-list)
(unless (string-match "\\." (car var))
expr)
(match-string 2)
(match-string 3)
- nil nil)))
+ nil nil gdb-frame-address)))
(push var gdb-var-list)
- (speedbar 1)
(unless (string-equal
speedbar-initial-expansion-list-name "GUD")
(speedbar-change-initial-expansion-list "GUD"))
(gdb-enqueue-input
(list
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
- (concat "server interpreter mi \"-var-evaluate-expression "
+ (concat "server interpreter mi \"0-var-evaluate-expression "
(car var) "\"\n")
- (concat "-var-evaluate-expression " (car var) "\n"))
+ (concat "0-var-evaluate-expression " (car var) "\n"))
`(lambda () (gdb-var-evaluate-expression-handler
,(car var) nil)))))
(if (search-forward "Undefined command" nil t)
- (message-box "Watching expressions requires gdb 6.0 onwards")
+ (message-box "Watching expressions requires GDB 6.0 onwards")
(message-box "No symbol \"%s\" in current context." expr))))
+(defun gdb-speedbar-update ()
+ (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
+ ;; Dummy command to update speedbar even when idle.
+ (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
+ ;; Keep gdb-pending-triggers non-nil till end.
+ (push 'gdb-speedbar-timer gdb-pending-triggers)))
+
+(defun gdb-speedbar-timer-fn ()
+ (setq gdb-pending-triggers
+ (delq 'gdb-speedbar-timer gdb-pending-triggers))
+ (speedbar-timer-fn))
+
(defun gdb-var-evaluate-expression-handler (varnum changed)
(goto-char (point-min))
- (re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t)
+ (setq gdb-pending-triggers
+ (delq (string-to-number (match-string 1)) gdb-pending-triggers))
(let ((var (assoc varnum gdb-var-list)))
(when var
(if changed (setcar (nthcdr 5 var) 'changed))
- (setcar (nthcdr 4 var) (read (match-string 1))))))
+ (setcar (nthcdr 4 var) (read (match-string 2)))))
+ (gdb-speedbar-update))
(defun gdb-var-list-children (varnum)
(gdb-enqueue-input
(defconst gdb-var-list-children-regexp
"child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\
-numchild=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\".*?}")
+numchild=\"\\(.*?\\)\"\\(}\\|,.*?\\(type=\"\\(.*?\\)\"\\)?.*?}\\)")
(defun gdb-var-list-children-handler (varnum)
(goto-char (point-min))
(let ((varchild (list (match-string 1)
(match-string 2)
(match-string 3)
- (match-string 4)
+ (match-string 6)
nil nil)))
(if (assoc (car varchild) gdb-var-list)
(throw 'child-already-watched nil))
(gdb-enqueue-input
(list
(concat
- "server interpreter mi \"-var-evaluate-expression "
+ "server interpreter mi \"0-var-evaluate-expression "
(car varchild) "\"\n")
`(lambda () (gdb-var-evaluate-expression-handler
,(car varchild) nil)))))))
(dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil))
(goto-char (point-min))
- (while (re-search-forward gdb-var-update-regexp nil t)
- (let ((varnum (match-string 1)))
- (if (string-equal (match-string 2) "false")
- (let ((var (assoc varnum gdb-var-list)))
- (if var (setcar (nthcdr 5 var) 'out-of-scope)))
- (gdb-enqueue-input
- (list
- (concat "server interpreter mi \"-var-evaluate-expression "
- varnum "\"\n")
- `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))))))
- (setq gdb-pending-triggers
- (delq 'gdb-var-update gdb-pending-triggers))
- (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
- ;; Dummy command to update speedbar at right time.
- (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh))
- ;; Keep gdb-pending-triggers non-nil till end.
- (push 'gdb-speedbar-refresh gdb-pending-triggers)))
-
-(defun gdb-speedbar-refresh ()
+ (let ((n 0))
+ (while (re-search-forward gdb-var-update-regexp nil t)
+ (let ((varnum (match-string 1)))
+ (if (string-equal (match-string 2) "false")
+ (let ((var (assoc varnum gdb-var-list)))
+ (if var (setcar (nthcdr 5 var) 'out-of-scope)))
+ (setq n (1+ n))
+ (push n gdb-pending-triggers)
+ (gdb-enqueue-input
+ (list
+ (concat "server interpreter mi \"" (number-to-string n)
+ "-var-evaluate-expression " varnum "\"\n")
+ `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))))
(setq gdb-pending-triggers
- (delq 'gdb-speedbar-refresh gdb-pending-triggers))
- (with-current-buffer gud-comint-buffer
- (let ((speedbar-verbosity-level 0)
- (speedbar-shown-directories nil))
- (save-excursion
- (speedbar-refresh)))))
+ (delq 'gdb-var-update gdb-pending-triggers)))
(defun gdb-var-delete ()
"Delete watch expression at point from the speedbar."
(if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
'(gdbmi gdba))
(let ((text (speedbar-line-text)))
- (string-match "\\(\\S-+\\)" text)
+ ;; Can't use \\S-+ for whitespace because
+ ;; speedbar has a whacky syntax table.
+ (string-match "\\([^ \t]+\\)" text)
(let ((expr (match-string 1 text)) var varnum)
(catch 'expr-found
(dolist (var1 gdb-var-list)
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
- (cond ((string-match "+" text) ;expand this node
- (if (and
- (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
- (string-equal gdb-version "pre-6.4"))
- (gdb-var-list-children token)
- (gdb-var-list-children-1 token)))
- ((string-match "-" text) ;contract this node
- (dolist (var gdb-var-list)
- (if (string-match (concat token "\\.") (car var))
- (setq gdb-var-list (delq var gdb-var-list))))
- (speedbar-change-expand-button-char ?+)
- (speedbar-delete-subblock indent))
- (t (error "Ooops... not sure what to do")))
- (speedbar-center-buffer-smartly))
+ (if (and gud-comint-buffer (buffer-name gud-comint-buffer))
+ (progn
+ (cond ((string-match "+" text) ;expand this node
+ (if (and (eq (buffer-local-value
+ 'gud-minor-mode gud-comint-buffer) 'gdba)
+ (string-equal gdb-version "pre-6.4"))
+ (gdb-var-list-children token)
+ (gdb-var-list-children-1 token)))
+ ((string-match "-" text) ;contract this node
+ (dolist (var gdb-var-list)
+ (if (string-match (concat token "\\.") (car var))
+ (setq gdb-var-list (delq var gdb-var-list))))
+ (speedbar-change-expand-button-char ?+)
+ (speedbar-delete-subblock indent))
+ (t (error "Ooops... not sure what to do")))
+ (speedbar-center-buffer-smartly))
+ (message-box "GUD session has been killed")))
(defun gdb-get-target-string ()
(with-current-buffer gud-comint-buffer
(interactive)
(if gdb-use-separate-io-buffer
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-inferior-io))))
+ (gdb-get-buffer-create 'gdb-inferior-io) t)))
(defconst gdb-frame-parameters
'((height . 14) (width . 80)
(minibuffer . nil)))
(defun gdb-frame-separate-io-buffer ()
- "Display IO of inferior in a new frame."
+ "Display IO of debugged program in a new frame."
(interactive)
(if gdb-use-separate-io-buffer
(let ((special-display-regexps (append special-display-regexps '(".*")))
(let ((item (concat string "\n")))
(if gdb-enable-debug (push (cons 'send item) gdb-debug-ring))
(process-send-string proc item)))
- (if (string-match "\\\\$" string)
+ (if (and (string-match "\\\\$" string)
+ (not comint-input-sender-no-newline)) ;;Try to catch C-d.
(setq gdb-continuation (concat gdb-continuation string "\n"))
(let ((item (concat gdb-continuation string "\n")))
(gdb-enqueue-input item)
(if gdb-prompting
(progn
(gdb-send-item item)
- (setq gdb-prompting nil))
+ (setq gdb-prompting nil))
(push item gdb-input-queue))))
(defun gdb-dequeue-input ()
(defun gdb-resync()
(setq gdb-flush-pending-output t)
(setq gud-running nil)
- (gdb-force-mode-line-update "stopped")
+ (gdb-force-mode-line-update
+ (propertize "stopped"'face font-lock-warning-face))
(setq gdb-output-sink 'user)
(setq gdb-input-queue nil)
(setq gdb-pending-triggers nil)
(cons
(match-string 1 args)
(string-to-number (match-string 2 args))))
- (setq gdb-frame-address (match-string 3 args))
+ (setq gdb-pc-address (match-string 3 args))
;; cover for auto-display output which comes *before*
;; stopped annotation
(if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
"An annotation handler for `prompt'.
This sends the next command (if any) to gdb."
(when gdb-first-prompt
+ (gdb-force-mode-line-update
+ (propertize "initializing..." 'face font-lock-variable-name-face))
(gdb-init-1)
(setq gdb-first-prompt nil))
(let ((sink gdb-output-sink))
This says that I/O for the subprocess is now the program being debugged,
not GDB."
(setq gdb-active-process t)
+ (setq gdb-printing t)
(let ((sink gdb-output-sink))
(cond
((eq sink 'user)
(progn
(setq gud-running t)
(setq gdb-inferior-status "running")
- (gdb-force-mode-line-update gdb-inferior-status)
+ (setq gdb-signalled nil)
+ (gdb-force-mode-line-update
+ (propertize gdb-inferior-status 'face font-lock-type-face))
(gdb-remove-text-properties)
+ (setq gud-old-arrow gud-overlay-arrow-position)
(setq gud-overlay-arrow-position nil)
(setq gdb-overlay-arrow-position nil)
+ (setq gdb-stack-position nil)
(if gdb-use-separate-io-buffer
(setq gdb-output-sink 'inferior))))
(t
(defun gdb-signal (ignored)
(setq gdb-inferior-status "signal")
- (gdb-force-mode-line-update gdb-inferior-status)
+ (gdb-force-mode-line-update
+ (propertize gdb-inferior-status 'face font-lock-warning-face))
(gdb-stopping ignored))
(defun gdb-stopping (ignored)
(setq gdb-active-process nil)
(setq gud-overlay-arrow-position nil)
(setq gdb-overlay-arrow-position nil)
+ (setq gdb-stack-position nil)
+ (setq gud-old-arrow nil)
(setq gdb-inferior-status "exited")
- (gdb-force-mode-line-update gdb-inferior-status)
+ (gdb-force-mode-line-update
+ (propertize gdb-inferior-status 'face font-lock-warning-face))
(gdb-stopping ignored))
(defun gdb-signalled (ignored)
(setq gdb-signalled t))
(defun gdb-frame-begin (ignored)
+ (setq gdb-frame-begin t)
+ (setq gdb-printing nil)
(let ((sink gdb-output-sink))
(cond
((eq sink 'inferior)
(gdb-resync)
(error "Unexpected frame-begin annotation (%S)" sink)))))
+(defcustom gdb-same-frame focus-follows-mouse
+ "Non-nil means pop up GUD buffer in same frame."
+ :group 'gud
+ :type 'boolean
+ :version "22.1")
+
+(defcustom gdb-find-source-frame nil
+ "Non-nil means try to find a source frame further up stack e.g after signal."
+ :group 'gud
+ :type 'boolean
+ :version "22.1")
+
+(defun gdb-find-source-frame (arg)
+ "Toggle trying to find a source frame further up stack.
+With arg, look for a source frame further up stack iff arg is positive."
+ (interactive "P")
+ (setq gdb-find-source-frame
+ (if (null arg)
+ (not gdb-find-source-frame)
+ (> (prefix-numeric-value arg) 0)))
+ (message (format "Looking for source frame %sabled"
+ (if gdb-find-source-frame "en" "dis"))))
+
(defun gdb-stopped (ignored)
"An annotation handler for `stopped'.
It is just like `gdb-stopping', except that if we already set the output
sink to `user' in `gdb-stopping', that is fine."
(setq gud-running nil)
- (unless (or gud-overlay-arrow-position gud-last-frame
- (not gud-last-last-frame))
- (gud-display-line (car gud-last-last-frame) (cdr gud-last-last-frame)))
+ (unless (or gud-overlay-arrow-position gud-last-frame)
+ (if (and gdb-frame-begin gdb-printing)
+ (setq gud-overlay-arrow-position gud-old-arrow)
+ ;;Pop up GUD buffer to display current frame when it doesn't have source
+ ;;information i.e id not compiled with -g as with libc routines generally.
+ (if gdb-same-frame
+ (gdb-display-gdb-buffer)
+ (gdb-frame-gdb-buffer))
+ (if gdb-find-source-frame
+ ;;Try to find source further up stack e.g after signal.
+ (setq gdb-look-up-stack
+ (if (gdb-get-buffer 'gdb-stack-buffer)
+ 'keep
+ (progn
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-invalidate-frames)
+ 'delete))))))
(unless (member gdb-inferior-status '("exited" "signal"))
(setq gdb-inferior-status "stopped")
- (gdb-force-mode-line-update gdb-inferior-status))
+ (gdb-force-mode-line-update
+ (propertize gdb-inferior-status 'face font-lock-warning-face)))
(let ((sink gdb-output-sink))
(cond
((eq sink 'inferior)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
(gdb-invalidate-breakpoints)
;; Do this through gdb-get-selected-frame -> gdb-frame-handler
- ;; so gdb-frame-address is updated.
+ ;; so gdb-pc-address is updated.
;; (gdb-invalidate-assembler)
(if (string-equal gdb-version "pre-6.4")
;; FIXME: with GDB-6 on Darwin, this might very well work.
;; Only needed/used with speedbar/watch expressions.
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
- (setq gdb-force-update t)
(if (string-equal gdb-version "pre-6.4")
(gdb-var-update)
(gdb-var-update-1)))))
(goto-char (point-max))
(insert-before-markers string))
(if (not (string-equal string ""))
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)))
(defun gdb-clear-inferior-io ()
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(gdb-remove-breakpoint-icons (point-min) (point-max)))))
(with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
(save-excursion
+ (let ((buffer-read-only nil))
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
(forward-line 1)
- (if (looking-at "[^\t].*?breakpoint")
+ (if (looking-at gdb-breakpoint-regexp)
(progn
- (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
(setq bptno (match-string 1))
(setq flag (char-after (match-beginning 2)))
- (beginning-of-line)
- (if (re-search-forward " in \\(.*\\) at\\s-+" nil t)
- (progn
- (let ((buffer-read-only nil))
- (add-text-properties (match-beginning 1) (match-end 1)
- '(face font-lock-function-name-face)))
- (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
- (let ((line (match-string 2)) (buffer-read-only nil)
- (file (match-string 1)))
- (add-text-properties (line-beginning-position)
- (line-end-position)
- '(mouse-face highlight
- help-echo "mouse-2, RET: visit breakpoint"))
- (unless (file-exists-p file)
- (setq file (cdr (assoc bptno gdb-location-alist))))
- (if (and file
- (not (string-equal file "File not found")))
- (with-current-buffer
- (find-file-noselect file 'nowarn)
- (set (make-local-variable 'gud-minor-mode)
- 'gdba)
- (set (make-local-variable 'tool-bar-map)
- gud-tool-bar-map)
- ;; Only want one breakpoint icon at each
- ;; location.
- (save-excursion
- (goto-line (string-to-number line))
- (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
- (gdb-enqueue-input
- (list
- (concat gdb-server-prefix "list "
- (match-string-no-properties 1) ":1\n")
- 'ignore))
- (gdb-enqueue-input
- (list (concat gdb-server-prefix "info source\n")
- `(lambda () (gdb-get-location
- ,bptno ,line ,flag))))))))))
- (end-of-line)))))
+ (add-text-properties
+ (match-beginning 2) (match-end 2)
+ (if (eq flag ?y)
+ '(face font-lock-warning-face)
+ '(face font-lock-type-face)))
+ (let ((bl (point))
+ (el (line-end-position)))
+ (if (re-search-forward " in \\(.*\\) at\\s-+" el t)
+ (progn
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ '(face font-lock-function-name-face))
+ (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
+ (let ((line (match-string 2))
+ (file (match-string 1)))
+ (add-text-properties bl el
+ '(mouse-face highlight
+ help-echo "mouse-2, RET: visit breakpoint"))
+ (unless (file-exists-p file)
+ (setq file (cdr (assoc bptno gdb-location-alist))))
+ (if (and file
+ (not (string-equal file "File not found")))
+ (with-current-buffer
+ (find-file-noselect file 'nowarn)
+ (set (make-local-variable 'gud-minor-mode)
+ 'gdba)
+ (set (make-local-variable 'tool-bar-map)
+ gud-tool-bar-map)
+ ;; Only want one breakpoint icon at each
+ ;; location.
+ (save-excursion
+ (goto-line (string-to-number line))
+ (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
+ (gdb-enqueue-input
+ (list
+ (concat gdb-server-prefix "list "
+ (match-string-no-properties 1) ":1\n")
+ 'ignore))
+ (gdb-enqueue-input
+ (list (concat gdb-server-prefix "info source\n")
+ `(lambda () (gdb-get-location
+ ,bptno ,line ,flag)))))))
+ (if (re-search-forward
+ "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
+ el t)
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ '(face font-lock-function-name-face))
+ (end-of-line)
+ (re-search-backward "\\s-\\(\\S-*\\)"
+ bl t)
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ '(face font-lock-variable-name-face)))))))
+ (end-of-line))))))
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
(defun gdb-mouse-set-clear-breakpoint (event)
"Display status of user-settable breakpoints."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-breakpoints-buffer)))
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))
(defun gdb-frame-breakpoints-buffer ()
"Display status of user-settable breakpoints in a new frame."
(let* ((buffer (find-file-noselect
(if (file-exists-p file) file
(cdr (assoc bptno gdb-location-alist)))))
- (window (unless (gdb-display-source-buffer buffer)
+ (window (or (gdb-display-source-buffer buffer)
(display-buffer buffer))))
(setq gdb-source-window window)
(with-current-buffer buffer
(defun gdb-info-stack-custom ()
(with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
(save-excursion
- (let ((buffer-read-only nil)
- bl el)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (setq bl (line-beginning-position)
- el (line-end-position))
- (when (looking-at "#")
- (add-text-properties bl el
- '(mouse-face highlight
- help-echo "mouse-2, RET: Select frame")))
- (goto-char bl)
- (when (looking-at "^#\\([0-9]+\\)")
- (when (string-equal (match-string 1) gdb-frame-number)
- (put-text-property bl (+ bl 4)
- 'face '(:inverse-video t)))
- (when (re-search-forward
- (concat
- (if (string-equal (match-string 1) "0") "" " in ")
- "\\([^ ]+\\) (") el t)
- (put-text-property (match-beginning 1) (match-end 1)
- 'face font-lock-function-name-face)
- (setq bl (match-end 0))
- (while (re-search-forward "<\\([^>]+\\)>" el t)
+ (unless (eq gdb-look-up-stack 'delete)
+ (let ((buffer-read-only nil)
+ bl el)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (setq bl (line-beginning-position)
+ el (line-end-position))
+ (when (looking-at "#")
+ (add-text-properties bl el
+ '(mouse-face highlight
+ help-echo "mouse-2, RET: Select frame")))
+ (goto-char bl)
+ (when (looking-at "^#\\([0-9]+\\)")
+ (when (string-equal (match-string 1) gdb-frame-number)
+ (if (> (car (window-fringes)) 0)
+ (progn
+ (or gdb-stack-position
+ (setq gdb-stack-position (make-marker)))
+ (set-marker gdb-stack-position (point)))
+ (put-text-property bl (+ bl 4)
+ 'face '(:inverse-video t))))
+ (when (re-search-forward
+ (concat
+ (if (string-equal (match-string 1) "0") "" " in ")
+ "\\([^ ]+\\) (") el t)
(put-text-property (match-beginning 1) (match-end 1)
+ 'face font-lock-function-name-face)
+ (setq bl (match-end 0))
+ (while (re-search-forward "<\\([^>]+\\)>" el t)
+ (put-text-property (match-beginning 1) (match-end 1)
'face font-lock-function-name-face))
- (goto-char bl)
- (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
- (put-text-property (match-beginning 1) (match-end 1)
- 'face font-lock-variable-name-face))))
- (forward-line 1))))))
+ (goto-char bl)
+ (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face font-lock-variable-name-face))))
+ (forward-line 1))))
+ (when gdb-look-up-stack
+ (goto-char (point-min))
+ (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t)
+ (let ((start (line-beginning-position))
+ (file (match-string 1))
+ (line (match-string 2)))
+ (re-search-backward "^#*\\([0-9]+\\)" start t)
+ (gdb-enqueue-input
+ (list (concat gdb-server-prefix "frame "
+ (match-string 1) "\n") 'gdb-set-hollow))
+ (gdb-enqueue-input
+ (list (concat gdb-server-prefix "frame 0\n") 'ignore)))))))
+ (if (eq gdb-look-up-stack 'delete)
+ (kill-buffer (gdb-get-buffer 'gdb-stack-buffer)))
+ (setq gdb-look-up-stack nil))
+
+(defun gdb-set-hollow ()
+ (if gud-last-last-frame
+ (with-current-buffer (gud-find-file (car gud-last-last-frame))
+ (setq fringe-indicator-alist
+ '((overlay-arrow . hollow-right-triangle))))))
(defun gdb-stack-buffer-name ()
(with-current-buffer gud-comint-buffer
"Display backtrace of current stack."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-stack-buffer)))
+ (gdb-get-buffer-create 'gdb-stack-buffer) t))
(defun gdb-frame-stack-buffer ()
"Display backtrace of current stack in a new frame."
(kill-all-local-variables)
(setq major-mode 'gdb-frames-mode)
(setq mode-name "Frames")
+ (setq gdb-stack-position nil)
+ (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
(setq buffer-read-only t)
(use-local-map gdb-frames-mode-map)
(run-mode-hooks 'gdb-frames-mode-hook)
(if event (posn-set-point (event-end event)))
(gdb-enqueue-input
(list (concat gdb-server-prefix "frame "
- (gdb-get-frame-number) "\n") 'ignore))
- (gud-display-frame))
+ (gdb-get-frame-number) "\n") 'ignore)))
\f
;; Threads buffer. This displays a selectable thread list.
(defun gdb-info-threads-custom ()
(with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
(let ((buffer-read-only nil))
- (goto-char (point-min))
- (while (< (point) (point-max))
- (unless (looking-at "No ")
- (add-text-properties (line-beginning-position) (line-end-position)
- '(mouse-face highlight
+ (save-excursion
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (unless (looking-at "No ")
+ (add-text-properties (line-beginning-position) (line-end-position)
+ '(mouse-face highlight
help-echo "mouse-2, RET: select thread")))
- (forward-line 1)))))
+ (forward-line 1))))))
(defun gdb-threads-buffer-name ()
(with-current-buffer gud-comint-buffer
"Display IDs of currently known threads."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-threads-buffer)))
+ (gdb-get-buffer-create 'gdb-threads-buffer) t))
(defun gdb-frame-threads-buffer ()
"Display IDs of currently known threads in a new frame."
"Display integer register contents."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-registers-buffer)))
+ (gdb-get-buffer-create 'gdb-registers-buffer) t))
(defun gdb-frame-registers-buffer ()
"Display integer register contents in a new frame."
'local-map
(gdb-make-header-line-mouse-map
'mouse-1
- #'(lambda () (interactive)
- (let ((gdb-memory-address
- ;; Let GDB do the arithmetic.
- (concat
- gdb-memory-address " - "
- (number-to-string
- (* gdb-memory-repeat-count
- (cond ((string= gdb-memory-unit "b") 1)
- ((string= gdb-memory-unit "h") 2)
- ((string= gdb-memory-unit "w") 4)
- ((string= gdb-memory-unit "g") 8)))))))
- (gdb-invalidate-memory)))))
+ (lambda () (interactive)
+ (let ((gdb-memory-address
+ ;; Let GDB do the arithmetic.
+ (concat
+ gdb-memory-address " - "
+ (number-to-string
+ (* gdb-memory-repeat-count
+ (cond ((string= gdb-memory-unit "b") 1)
+ ((string= gdb-memory-unit "h") 2)
+ ((string= gdb-memory-unit "w") 4)
+ ((string= gdb-memory-unit "g") 8)))))))
+ (gdb-invalidate-memory)))))
"|"
(propertize "+"
'face font-lock-warning-face
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1
- #'(lambda () (interactive)
- (let ((gdb-memory-address nil))
- (gdb-invalidate-memory)))))
+ (lambda () (interactive)
+ (let ((gdb-memory-address nil))
+ (gdb-invalidate-memory)))))
"]: "
(propertize gdb-memory-address
'face font-lock-warning-face
"Display memory contents."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-memory-buffer)))
+ (gdb-get-buffer-create 'gdb-memory-buffer) t))
(defun gdb-frame-memory-buffer ()
"Display memory contents in a new frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
+ (let* ((special-display-regexps (append special-display-regexps '(".*")))
+ (special-display-frame-alist
+ (cons '(left-fringe . 0)
+ (cons '(right-fringe . 0)
+ (cons '(width . 83) gdb-frame-parameters)))))
(display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
\f
(defvar gdb-locals-watch-map
(let ((map (make-sparse-keymap)))
- (define-key map "\r" '(lambda () (interactive)
- (beginning-of-line)
- (gud-watch)))
- (define-key map [mouse-2] '(lambda (event) (interactive "e")
- (mouse-set-point event)
- (beginning-of-line)
- (gud-watch)))
+ (suppress-keymap map)
+ (define-key map "\r" (lambda () (interactive)
+ (beginning-of-line)
+ (gud-watch)))
+ (define-key map [mouse-2] (lambda (event) (interactive "e")
+ (mouse-set-point event)
+ (beginning-of-line)
+ (gud-watch)))
map)
"Keymap to create watch expression of a complex data type local variable.")
"Display local variables of current stack and their values."
(interactive)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-locals-buffer)))
+ (gdb-get-buffer-create 'gdb-locals-buffer) t))
(defun gdb-frame-locals-buffer ()
"Display local variables of current stack and their values in a new frame."
\f
;;;; Window management
-(defun gdb-display-buffer (buf &optional size)
+(defun gdb-display-buffer (buf dedicated &optional size)
(let ((answer (get-buffer-window buf 0))
(must-split nil))
(if answer
(pop-to-buffer gud-comint-buffer) ;Select the right frame.
(let ((window (get-lru-window)))
(if (and window
- (not (eq window (get-buffer-window gud-comint-buffer))))
+ (not (memq window `(,(get-buffer-window gud-comint-buffer)
+ ,gdb-source-window))))
(progn
(set-window-buffer window buf)
(setq answer window))
(new-size (and size (< size cur-size) (- cur-size size))))
(setq answer (split-window largest new-size))
(set-window-buffer answer buf)
- (set-window-dedicated-p answer t)))
+ (set-window-dedicated-p answer dedicated)))
answer)))
\f
(define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
(define-key menu [inferior]
- '(menu-item "Inferior IO" gdb-display-separate-io-buffer
+ '(menu-item "Separate IO" gdb-display-separate-io-buffer
:enable gdb-use-separate-io-buffer))
(define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
(define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
(define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
(define-key menu [inferior]
- '(menu-item "Inferior IO" gdb-frame-separate-io-buffer
+ '(menu-item "Separate IO" gdb-frame-separate-io-buffer
:enable gdb-use-separate-io-buffer))
(define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
- (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer))
+ (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
(define-key menu [breakpoints]
'("Breakpoints" . gdb-frame-breakpoints-buffer))
(define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
(define-key gud-menu-map [ui]
`(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
+ (define-key menu [gdb-find-source-frame]
+ '(menu-item "Look For Source Frame" gdb-find-source-frame
+ :visible (eq gud-minor-mode 'gdba)
+ :help "Toggle look for source frame."
+ :button (:toggle . gdb-find-source-frame)))
(define-key menu [gdb-use-separate-io]
- '(menu-item "Separate inferior IO" gdb-use-separate-io-buffer
+ '(menu-item "Separate IO" gdb-use-separate-io-buffer
:visible (eq gud-minor-mode 'gdba)
- :help "Toggle separate IO for inferior."
+ :help "Toggle separate IO for debugged program."
:button (:toggle . gdb-use-separate-io-buffer)))
(define-key menu [gdb-many-windows]
'(menu-item "Display Other Windows" gdb-many-windows
"Display GUD buffer in a new frame."
(interactive)
(let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters)
+ (special-display-frame-alist
+ (remove '(menu-bar-lines) (remove '(tool-bar-lines)
+ gdb-frame-parameters)))
(same-window-regexps nil))
(display-buffer gud-comint-buffer)))
(switch-to-buffer
(if gud-last-last-frame
(gud-find-file (car gud-last-last-frame))
- (gud-find-file gdb-main-file)))
+ (if gdb-main-file
+ (gud-find-file gdb-main-file)
+ ;; Put buffer list in window if we
+ ;; can't find a source file.
+ (list-buffers-noselect))))
+ (setq gdb-source-window (selected-window))
(when gdb-use-separate-io-buffer
(split-window-horizontally)
(other-window 1)
(if gud-last-last-frame
(gud-find-file (car gud-last-last-frame))
(gud-find-file gdb-main-file)))
+ (setq gdb-source-window (selected-window))
(other-window 1))))
(defun gdb-reset ()
(setq gud-minor-mode nil)
(kill-local-variable 'tool-bar-map)
(kill-local-variable 'gdb-define-alist))))))
- (when (markerp gdb-overlay-arrow-position)
- (move-marker gdb-overlay-arrow-position nil)
- (setq gdb-overlay-arrow-position nil))
+ (setq gdb-overlay-arrow-position nil)
(setq overlay-arrow-variable-list
(delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
(setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
- (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
- (speedbar-refresh))
+ (setq gdb-stack-position nil)
+ (setq overlay-arrow-variable-list
+ (delq 'gdb-stack-position overlay-arrow-variable-list))
+ (if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
(setq gdb-var-list nil)
gud-comint-buffer
(memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
'(gdba gdbmi)))
- (if (member buffer-file-name gdb-source-file-list)
+ ;;Pre GDB 6.3 "info sources" doesn't give absolute file name.
+ (if (member (if (string-equal gdb-version "pre-6.4")
+ (file-name-nondirectory buffer-file-name)
+ buffer-file-name)
+ gdb-source-file-list)
(with-current-buffer (find-buffer-visiting buffer-file-name)
(set (make-local-variable 'gud-minor-mode)
(buffer-local-value 'gud-minor-mode gud-comint-buffer))
(pos 1) (address) (flag) (bptno))
(with-current-buffer buffer
(save-excursion
- (if (not (equal gdb-frame-address "main"))
+ (if (not (equal gdb-pc-address "main"))
(progn
(goto-char (point-min))
- (if (and gdb-frame-address
- (search-forward gdb-frame-address nil t))
+ (if (and gdb-pc-address
+ (search-forward gdb-pc-address nil t))
(progn
(setq pos (point))
(beginning-of-line)
'((overlay-arrow . hollow-right-triangle))))
(or gdb-overlay-arrow-position
(setq gdb-overlay-arrow-position (make-marker)))
- (set-marker gdb-overlay-arrow-position
- (point) (current-buffer))))))
+ (set-marker gdb-overlay-arrow-position (point))))))
;; remove all breakpoint-icons in assembler buffer before updating.
(gdb-remove-breakpoint-icons (point-min) (point-max))))
(with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
(goto-char (point-min))
(if (search-forward address nil t)
(gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
- (if (not (equal gdb-frame-address "main"))
+ (if (not (equal gdb-pc-address "main"))
(with-current-buffer buffer
(set-window-point (get-buffer-window buffer 0) pos)))))
(interactive)
(setq gdb-previous-frame nil)
(gdb-display-buffer
- (gdb-get-buffer-create 'gdb-assembler-buffer)))
+ (gdb-get-buffer-create 'gdb-assembler-buffer) t))
(defun gdb-frame-assembler-buffer ()
"Display disassembly view in a new frame."
(special-display-frame-alist gdb-frame-parameters))
(display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer))))
-;; modified because if gdb-frame-address has changed value a new command
+;; modified because if gdb-pc-address has changed value a new command
;; must be enqueued to update the buffer with the new output
(defun gdb-invalidate-assembler (&optional ignored)
(if (gdb-get-buffer 'gdb-assembler-buffer)
(string-equal gdb-selected-frame gdb-previous-frame))
(if (or (not (member 'gdb-invalidate-assembler
gdb-pending-triggers))
- (not (string-equal gdb-frame-address
+ (not (string-equal gdb-pc-address
gdb-previous-frame-address)))
(progn
;; take previous disassemble command, if any, off the queue
(gdb-enqueue-input
(list
(concat gdb-server-prefix "disassemble "
- (if (member gdb-frame-address '(nil "main")) nil "0x")
- gdb-frame-address "\n")
+ (if (member gdb-pc-address '(nil "main")) nil "0x")
+ gdb-pc-address "\n")
'gdb-assembler-handler))
(push 'gdb-invalidate-assembler gdb-pending-triggers)
- (setq gdb-previous-frame-address gdb-frame-address)
+ (setq gdb-previous-frame-address gdb-pc-address)
(setq gdb-previous-frame gdb-selected-frame)))))))
(defun gdb-get-selected-frame ()
(setq gdb-pending-triggers
(delq 'gdb-get-selected-frame gdb-pending-triggers))
(goto-char (point-min))
- (if (re-search-forward "Stack level \\([0-9]+\\)" nil t)
- (setq gdb-frame-number (match-string 1)))
+ (when (re-search-forward
+ "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t)
+ (setq gdb-frame-number (match-string 1))
+ (setq gdb-frame-address (match-string 2)))
(goto-char (point-min))
- (if (re-search-forward
- ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\) (\\(\\S-*?\\):[0-9]+?);? "
- nil t)
- (progn
- (setq gdb-selected-frame (match-string 2))
- (if (gdb-get-buffer 'gdb-locals-buffer)
- (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
- (setq mode-name (concat "Locals:" gdb-selected-frame))))
- (if (gdb-get-buffer 'gdb-assembler-buffer)
- (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
- (setq mode-name (concat "Machine:" gdb-selected-frame))))
- (setq gdb-frame-address (match-string 1))))
- (if gud-overlay-arrow-position
+ (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\
+\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; "
+ nil t)
+ (setq gdb-selected-frame (match-string 2))
+ (if (gdb-get-buffer 'gdb-locals-buffer)
+ (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
+ (setq mode-name (concat "Locals:" gdb-selected-frame))))
+ (if (gdb-get-buffer 'gdb-assembler-buffer)
+ (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
+ (setq mode-name (concat "Machine:" gdb-selected-frame))))
+ (setq gdb-pc-address (match-string 1))
+ (if (and (match-string 3) gud-overlay-arrow-position)
(let ((buffer (marker-buffer gud-overlay-arrow-position))
(position (marker-position gud-overlay-arrow-position)))
- (when (and buffer (string-equal (buffer-name buffer) (match-string 3)))
+ (when (and buffer
+ (string-equal (buffer-name buffer)
+ (file-name-nondirectory (match-string 3))))
(with-current-buffer buffer
(setq fringe-indicator-alist
(if (string-equal gdb-frame-number "0")
nil
'((overlay-arrow . hollow-right-triangle))))
- (set-marker gud-overlay-arrow-position position)))))
+ (set-marker gud-overlay-arrow-position position))))))
(goto-char (point-min))
- (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
+ (if (re-search-forward " source language \\(\\S-+\\)\." nil t)
(setq gdb-current-language (match-string 1)))
(gdb-invalidate-assembler))
(when gud-tooltip-mode
(make-local-variable 'gdb-define-alist)
(gdb-create-define-alist)
- (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
+ (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))
+ (gdb-force-mode-line-update
+ (propertize "ready" 'face font-lock-variable-name-face)))
; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdb-var-list-children-1 (varnum)
(defconst gdb-var-list-children-regexp-1
"child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\
-numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\),.*?type=\"\\(.+?\\)\".*?}")
+numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\)\
+\\(}\\|,.*?\\(type=\"\\(.+?\\)\"\\)?.*?}\\)")
(defun gdb-var-list-children-handler-1 (varnum)
(goto-char (point-min))
(let ((varchild (list (match-string 1)
(match-string 2)
(match-string 3)
- (match-string 5)
+ (match-string 7)
(read (match-string 4))
nil)))
(if (assoc (car varchild) gdb-var-list)
(throw 'child-already-watched nil))
(push varchild var-list))))
(push var var-list)))
- (setq gdb-var-list (nreverse var-list)))))
+ (setq gdb-var-list (nreverse var-list))))
+ (gdb-speedbar-update))
; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update-1 ()
(read (match-string 2)))))))
(setq gdb-pending-triggers
(delq 'gdb-var-update gdb-pending-triggers))
- (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
- ;; dummy command to update speedbar at right time
- (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh))
- ;; keep gdb-pending-triggers non-nil till end
- (push 'gdb-speedbar-refresh gdb-pending-triggers)))
+ (gdb-speedbar-update))
;; Registers buffer.
;;
gdb-pending-triggers))
(goto-char (point-min))
(if (re-search-forward gdb-error-regexp nil t)
- (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert (match-string 1))
- (goto-char (point-min))))
+ (let ((err (match-string 1)))
+ (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (put-text-property 0 (length err) 'face font-lock-warning-face err)
+ (insert err)
+ (goto-char (point-min)))))
(let ((register-list (reverse gdb-register-names))
(register nil) (register-string nil) (register-values nil))
(goto-char (point-min))
(defvar gdb-locals-watch-map-1
(let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "\r" 'gud-watch)
(define-key map [mouse-2] 'gud-watch)
map)
"Keymap to create watch expression of a complex data type local variable.")
+(defvar gdb-edit-locals-map-1
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "\r" 'gdb-edit-locals-value)
+ (define-key map [mouse-2] 'gdb-edit-locals-value)
+ map)
+ "Keymap to edit value of a simple data type local variable.")
+
+(defun gdb-edit-locals-value (&optional event)
+ "Assign a value to a variable displayed in the locals buffer."
+ (interactive (list last-input-event))
+ (save-excursion
+ (if event (posn-set-point (event-end event)))
+ (beginning-of-line)
+ (let* ((var (current-word))
+ (value (read-string (format "New value (%s): " var))))
+ (gdb-enqueue-input
+ (list (concat gdb-server-prefix"set variable " var " = " value "\n")
+ 'ignore)))))
+
;; Dont display values of arrays or structures.
;; These can be expanded using gud-watch.
(defun gdb-stack-list-locals-handler ()
(setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1
gdb-pending-triggers))
- (let (local locals-list)
- (goto-char (point-min))
- (while (re-search-forward gdb-stack-list-locals-regexp nil t)
- (let ((local (list (match-string 1)
- (match-string 2)
- nil)))
- (if (looking-at ",value=\\(\".*\"\\).*?}")
- (setcar (nthcdr 2 local) (read (match-string 1))))
- (push local locals-list)))
- (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
- (and buf (with-current-buffer buf
- (let* ((window (get-buffer-window buf 0))
- (start (window-start window))
- (p (window-point window))
- (buffer-read-only nil))
- (erase-buffer)
- (dolist (local locals-list)
- (setq name (car local))
- (if (or (not (nth 2 local))
- (string-match "\\0x" (nth 2 local)))
- (add-text-properties 0 (length name)
- `(mouse-face highlight
- help-echo "mouse-2: create watch expression"
- local-map ,gdb-locals-watch-map-1)
- name))
+ (goto-char (point-min))
+ (if (re-search-forward gdb-error-regexp nil t)
+ (let ((err (match-string 1)))
+ (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert err)
+ (goto-char (point-min)))))
+ (let (local locals-list)
+ (goto-char (point-min))
+ (while (re-search-forward gdb-stack-list-locals-regexp nil t)
+ (let ((local (list (match-string 1)
+ (match-string 2)
+ nil)))
+ (if (looking-at ",value=\\(\".*\"\\).*?}")
+ (setcar (nthcdr 2 local) (read (match-string 1))))
+ (push local locals-list)))
+ (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
+ (and buf (with-current-buffer buf
+ (let* ((window (get-buffer-window buf 0))
+ (start (window-start window))
+ (p (window-point window))
+ (buffer-read-only nil) (name) (value))
+ (erase-buffer)
+ (dolist (local locals-list)
+ (setq name (car local))
+ (setq value (nth 2 local))
+ (if (or (not value)
+ (string-match "^\\0x" value))
+ (add-text-properties 0 (length name)
+ `(mouse-face highlight
+ help-echo "mouse-2: create watch expression"
+ local-map ,gdb-locals-watch-map-1)
+ name)
+ (add-text-properties 0 (length value)
+ `(mouse-face highlight
+ help-echo "mouse-2: edit value"
+ local-map ,gdb-edit-locals-map-1)
+ value))
(insert
(concat name "\t" (nth 1 local)
- "\t" (nth 2 local) "\n")))
- (set-window-start window start)
- (set-window-point window p)))))))
+ "\t" value "\n")))
+ (set-window-start window start)
+ (set-window-point window p))))))))
(defun gdb-get-register-names ()
"Create a list of register names."