[PATCH: gdb/mi + doco] -var-update
Nick Roberts
nickrob@snap.net.nz
Fri Jul 15 15:11:00 GMT 2005
> > That way all the static functions currently in varobj.c will be
> > automatically accessible to the functions currently in mi-cmd-var.c.
>
> I bet you've got only the GDB module checked out. Varobj was not
> written for MI - it was written for Insight (gdb/gdbtk/).
You're right. That explains a lot, I didn't realise it was shared code.
> BTW, if it's OK with you, I would prefer that you add new testcases
> rather than modifying existing ones. Yes, the ones that are there are
> slightly redundant. But changing what a test case is testing is bad
> form for long-term results analysis.
OK. I'm not very comfortable with expect, but I'll give it a go.
> Now that this patch is in, I believe your current gdb-mi.el will work
> with CVS GDB. Is that right? If so, could you post it? I promise to
> look at it promptly.
Yes it does work, but not perfectly (if it did it could go straight into
the Emacs CVS repository). It has changed quite a lot since last time.
Unfortunately it still requires Emacs in CVS, but a release is planned.
Nick
2005-07-16 Nick Roberts <nickrob@snap.net.nz>
* mi/gdb-mi.el: Update for changes in Emacs 22.0.50. Bring more
features over from gdb-ui.el. Use "-var-update --all-values" for
faster re-display of watch expressions.
*** mi/gdb-mi.el.~1.1.~ 2004-07-27 09:52:34.000000000 +1200
--- mi/gdb-mi.el 2005-07-15 23:58:53.000000000 +1200
***************
*** 1,13 ****
! ;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)
!
! ;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
! ;; (could use "-interpreter-exec console cli-command")
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: Nick Roberts <nickrob@gnu.org>
;; Keywords: unix, tools
! ;; Copyright (C) 2004 Free Software Foundation, Inc.
;; This file is part of GNU GDB.
--- 1,10 ----
! ;;; gdb-mi.el
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: Nick Roberts <nickrob@gnu.org>
;; Keywords: unix, tools
! ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
;; This file is part of GNU GDB.
***************
*** 23,51 ****
;;; Commentary:
! ;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
! ;; onwards. You can interact with GDB through the GUD buffer in the usual way,
! ;; but there are also buffers which control the execution and describe the
! ;; state of your program. It separates the input/output of your program from
! ;; that of GDB and displays expressions and their current values in their own
! ;; buffers. It also uses features of Emacs 21 such as the fringe/display
! ;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
! ;; section in the Emacs info manual).
;; Start the debugger with M-x gdbmi.
;; This file uses GDB/MI as the primary interface to GDB. It is still under
! ;; development and is part of a process to migrate Emacs from annotations
! ;; (as used in gdb-ui.el) to GDB/MI.
!
;; Known Bugs:
;;
!
;;; Code:
(require 'gud)
(require 'gdb-ui)
!
;;;###autoload
(defun gdbmi (command-line)
--- 20,68 ----
;;; Commentary:
! ;; This mode acts as a graphical user interface to GDB and works with Emacs
! ;; 22.x and the version of GDB with which it is distributed. You can interact
! ;; with GDB through the GUD buffer in the usual way, but there are also
! ;; buffers which control the execution and describe the state of your program.
! ;; It separates the input/output of your program from that of GDB and displays
! ;; expressions and their current values in their own buffers. It also uses
! ;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
! ;; the toolbar (see the GDB Graphical Interface section in the Emacs info
! ;; manual).
;; Start the debugger with M-x gdbmi.
;; This file uses GDB/MI as the primary interface to GDB. It is still under
! ;; development and is part of a process to migrate Emacs from annotations (as
! ;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
! ;; access CLI using "-interpreter-exec console cli-command".
! ;;
;; Known Bugs:
;;
! ;; 1) To handle program input, if required, and to avoid extra output in the
! ;; GUD buffer you must not use run, step, next or continue etc but their MI
! ;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate
! ;; icon in the toolbar.
! ;;
! ;; 2) Some commands send extra prompts to the GUD buffer.
! ;;
! ;; TODO:
! ;; 1) Prefix MI commands with a token instead of queueing commands.
! ;; 2) Use MI command -data-read-memory for memory window.
! ;; 3) Use MI command -data-disassemble for disassembly window.
! ;; 4) Allow separate buffers for Inferior IO and GDB IO.
! ;; 5) Watch windows to work with threads.
! ;;
;;; Code:
(require 'gud)
(require 'gdb-ui)
!
! (defvar gdb-register-names nil "List of register names.")
! (defvar gdb-changed-registers nil
! "List of changed register numbers (strings).")
! (defvar gdb-last-command nil)
! (defvar gdb-prompt-name nil)
;;;###autoload
(defun gdbmi (command-line)
*************** GUD buffer (I/O of GDB) | Loca
*** 106,117 ****
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
;;
(gud-def gud-break (if (not (string-equal mode-name "Machine"))
! (gud-call "-break-insert %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
! (gud-call "-break-insert *%a" arg)))
"\C-b" "Set breakpoint at current line or address.")
;;
(gud-def gud-remove (if (not (string-equal mode-name "Machine"))
--- 123,145 ----
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
;;
+ (gud-def gud-step "-exec-step %p" "\C-s"
+ "Step one source line with display.")
+ (gud-def gud-stepi "-exec-step-instruction %p" "\C-i"
+ "Step one instruction with display.")
+ (gud-def gud-next "-exec-next %p" "\C-n"
+ "Step one line (skip functions).")
+ (gud-def gud-cont "-exec-continue" "\C-r"
+ "Continue with display.")
+ (gud-def gud-finish "-exec-finish" "\C-f"
+ "Finish executing current function.")
+ (gud-def gud-run "-exec-run" nil "Run the program.")
(gud-def gud-break (if (not (string-equal mode-name "Machine"))
! (gud-call "break %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
! (gud-call "break *%a" arg)))
"\C-b" "Set breakpoint at current line or address.")
;;
(gud-def gud-remove (if (not (string-equal mode-name "Machine"))
*************** GUD buffer (I/O of GDB) | Loca
*** 123,157 ****
"\C-d" "Remove breakpoint at current line or address.")
;;
(gud-def gud-until (if (not (string-equal mode-name "Machine"))
! (gud-call "until %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
! (gud-call "until *%a" arg)))
"\C-u" "Continue to current line or address.")
(define-key gud-minor-mode-map [left-margin mouse-1]
! 'gdb-mouse-toggle-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-1]
'gdb-mouse-toggle-breakpoint)
(setq comint-input-sender 'gdbmi-send)
;;
;; (re-)initialise
! (setq gdb-main-file nil)
! (setq gdb-current-address "main")
! (setq gdb-previous-address nil)
! (setq gdb-previous-frame nil)
! (setq gdb-current-frame "main")
! (setq gdb-view-source t)
! (setq gdb-selected-view 'source)
! (setq gdb-var-list nil)
! (setq gdb-var-changed nil)
! (setq gdb-prompting nil)
! (setq gdb-current-item nil)
! (setq gdb-pending-triggers nil)
! (setq gdb-output-sink 'user)
! (setq gdb-server-prefix nil)
;;
(setq gdb-buffer-type 'gdbmi)
;;
--- 151,193 ----
"\C-d" "Remove breakpoint at current line or address.")
;;
(gud-def gud-until (if (not (string-equal mode-name "Machine"))
! (gud-call "-exec-until %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
! (gud-call "-exec-until *%a" arg)))
"\C-u" "Continue to current line or address.")
(define-key gud-minor-mode-map [left-margin mouse-1]
! '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-margin mouse-3]
'gdb-mouse-toggle-breakpoint)
(setq comint-input-sender 'gdbmi-send)
;;
;; (re-)initialise
! (setq gdb-frame-address (if gdb-show-main "main" nil)
! gdb-previous-frame-address nil
! gdb-memory-address "main"
! gdb-previous-frame nil
! gdb-selected-frame nil
! gdb-frame-number nil
! gdb-var-list nil
! gdb-var-changed nil
! gdb-prompting nil
! gdb-input-queue nil
! gdb-current-item nil
! gdb-pending-triggers nil
! gdb-output-sink 'user
! gdb-server-prefix nil
! gdb-flush-pending-output nil
! gdb-location-alist nil
! gdb-find-file-unhook nil
! gdb-source-file-list nil
! gdb-last-command nil
! gdb-prompt-name nil)
;;
(setq gdb-buffer-type 'gdbmi)
;;
*************** GUD buffer (I/O of GDB) | Loca
*** 160,187 ****
;;
(if (eq window-system 'w32)
(gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
;; find source file and compilation directory here
! (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program
! (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program
! (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
;;
(run-hooks 'gdbmi-mode-hook))
; Force nil till fixed.
(defconst gdbmi-use-inferior-io-buffer nil)
! ; uses --all-values Needs GDB 6.1 onwards.
(defun gdbmi-var-list-children (varnum)
(gdb-enqueue-input
- (list (concat "-var-update " varnum "\n") 'ignore))
- (gdb-enqueue-input
(list (concat "-var-list-children --all-values "
varnum "\n")
`(lambda () (gdbmi-var-list-children-handler ,varnum)))))
(defconst gdbmi-var-list-children-regexp
! "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
! )
(defun gdbmi-var-list-children-handler (varnum)
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
--- 196,229 ----
;;
(if (eq window-system 'w32)
(gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
+ (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
;; find source file and compilation directory here
! (gdb-enqueue-input
! ; Needs GDB 6.2 onwards.
! (list "-file-list-exec-source-files\n" 'gdb-get-source-file-list))
! (gdb-enqueue-input
! ; Needs GDB 6.0 onwards.
! (list "-file-list-exec-source-file\n" 'gdb-get-source-file))
! (gdb-enqueue-input
! (list "-data-list-register-names\n" 'gdb-get-register-names))
! (gdb-enqueue-input
! (list "-gdb-show prompt\n" 'gdb-get-prompt))
;;
(run-hooks 'gdbmi-mode-hook))
; Force nil till fixed.
(defconst gdbmi-use-inferior-io-buffer nil)
! ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdbmi-var-list-children (varnum)
(gdb-enqueue-input
(list (concat "-var-list-children --all-values "
varnum "\n")
`(lambda () (gdbmi-var-list-children-handler ,varnum)))))
(defconst gdbmi-var-list-children-regexp
! "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",\
! value=\"\\(.*?\\)\"")
(defun gdbmi-var-list-children-handler (varnum)
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
*************** GUD buffer (I/O of GDB) | Loca
*** 208,256 ****
(push var var-list)))
(setq gdb-var-changed t)
(setq gdb-var-list (nreverse var-list))))))
-
- ;(defun gdbmi-send (proc string)
- ; "A comint send filter for gdb."
- ; (setq gdb-output-sink 'user)
- ; (setq gdb-prompting nil)
- ; (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))
(defun gdbmi-send (proc string)
"A comint send filter for gdb."
! (setq gdb-output-sink 'user)
! (setq gdb-prompting nil)
! (process-send-string proc (concat string "\n")))
! (defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
"Default command to execute an executable under the GDB-UI debugger."
:type 'string
:group 'gud)
! (defconst gdb-stopped-regexp
! "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")
! (defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")
! (defconst gdb-internals-regexp "&\".*\\n\"\n")
! (defconst gdb-gdb-regexp "(gdb) \n")
! (defconst gdb-running-regexp "^\\^running")
! (defun gdbmi-prompt ()
! "This handler terminates the any collection of output. It also
! sends the next command (if any) to gdb."
(unless gdb-pending-triggers
! (gdb-get-current-frame)
! (gdbmi-invalidate-frames)
! (gdbmi-invalidate-breakpoints)
! (gdbmi-invalidate-locals)
! (dolist (frame (frame-list))
! (when (string-equal (frame-parameter frame 'name) "Speedbar")
! (setq gdb-var-changed t) ; force update
! (dolist (var gdb-var-list)
! (setcar (nthcdr 5 var) nil))))
! (gdb-var-update))
(let ((sink gdb-output-sink))
(when (eq sink 'emacs)
(let ((handler
--- 250,342 ----
(push var var-list)))
(setq gdb-var-changed t)
(setq gdb-var-list (nreverse var-list))))))
+ ; Uses "-var-update --all-values". Needs CVS GDB (6.4+).
+ (defun gdbmi-var-update ()
+ (gdb-enqueue-input
+ (list "-var-update --all-values *\n" 'gdbmi-var-update-handler)))
+
+ (defconst gdbmi-var-update-regexp "name=\"\\(.*?\\)\",value=\"\\(.*?\\)\"")
+
+ (defun gdbmi-var-update-handler ()
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward gdbmi-var-update-regexp nil t)
+ (let ((varnum (match-string 1)))
+ (catch 'var-found1
+ (let ((num 0))
+ (dolist (var gdb-var-list)
+ (if (string-equal varnum (cadr var))
+ (progn
+ (setcar (nthcdr 5 var) t)
+ (setcar (nthcdr 4 var) (match-string 2))
+ (setcar (nthcdr num gdb-var-list) var)
+ (throw 'var-found1 nil)))
+ (setq num (+ num 1))))))
+ (setq gdb-var-changed t))))
+
(defun gdbmi-send (proc string)
"A comint send filter for gdb."
! (if gud-running
! (process-send-string proc (concat string "\n"))
! (with-current-buffer gud-comint-buffer
! (remove-text-properties (point-min) (point-max) '(face)))
! (setq gdb-output-sink 'user)
! (setq gdb-prompting nil)
! ;; mimic <RET> key to repeat previous command in GDB
! (if (string-match "\\S+" string)
! (setq gdb-last-command string)
! (if gdb-last-command (setq string gdb-last-command)))
! (if gdb-enable-debug-log
! (push (cons 'mi-send (concat string "\n")) gdb-debug-log))
! (process-send-string
! proc
! (if (string-match "^-" string)
! ;; MI command
! (concat string "\n")
! ;; CLI command
! (concat "-interpreter-exec console \"" string "\"\n")))))
! (defcustom gud-gdbmi-command-name "gdb -interp=mi"
"Default command to execute an executable under the GDB-UI debugger."
:type 'string
:group 'gud)
! (defconst gdb-gdb-regexp "(gdb) \n")
! (defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
! ;; fullname added GDB 6.4+.
! ;; Probably not needed. -stack-info-frame computes filename and line.
! (defconst gdb-stopped-regexp
! "\\*stopped,reason=.*?,file=\".*?\"\
! ,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n")
! (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
! (defconst gdb-done-regexp "\\^done,*\n*")
! (defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
!
! (defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
!
! (defun gdbmi-prompt1 ()
! "Queue any GDB commands that the user interface needs."
(unless gdb-pending-triggers
! (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
! (setq gdb-var-changed t) ; force update
! (dolist (var gdb-var-list)
! (setcar (nthcdr 5 var) nil))
! (gdbmi-var-update))
! (gdbmi-get-selected-frame)
! (gdbmi-invalidate-frames)
! (gdbmi-invalidate-breakpoints)
! (gdb-get-changed-registers)
! (gdbmi-invalidate-registers)
! (gdbmi-invalidate-locals)))
!
! (defun gdbmi-prompt2 ()
! "Handle any output and send next GDB command."
(let ((sink gdb-output-sink))
(when (eq sink 'emacs)
(let ((handler
*************** GUD buffer (I/O of GDB) | Loca
*** 267,325 ****
(defun gud-gdbmi-marker-filter (string)
"Filter GDB/MI output."
! (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
! ;; Recall the left over gud-marker-acc from last time
! (setq gud-marker-acc (concat gud-marker-acc string))
! ;; Start accumulating output for the GUD buffer
! (let ((output ""))
!
! (if (string-match gdb-running-regexp gud-marker-acc)
! (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
! gud-running t))
!
! ;; Remove the trimmings from the console stream.
! (while (string-match gdb-console-regexp gud-marker-acc)
! (setq
! gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
! (match-string 1 gud-marker-acc)
! (substring gud-marker-acc (match-end 0)))))
!
! ;; Remove log stream containing debugging messages being produced by GDB's
! ;; internals.
! (while (string-match gdb-internals-regexp gud-marker-acc)
! (setq
! gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0)))))
!
! (if (string-match gdb-stopped-regexp gud-marker-acc)
! (setq
!
! ;; Extract the frame position from the marker.
! gud-last-frame (cons (match-string 2 gud-marker-acc)
! (string-to-int (match-string 3 gud-marker-acc)))
!
! ;; Append any text before the marker to the output we're going
! ;; to return - we don't include the marker in this text.
! output (gdbmi-concat-output output
! (substring gud-marker-acc 0 (match-beginning 0)))
!
! ;; Set the accumulator to the remaining text.
! gud-marker-acc (substring gud-marker-acc (match-end 0))))
!
! (while (string-match gdb-gdb-regexp gud-marker-acc)
! (setq
!
! ;; Append any text up to and including prompt less \n to the output.
! output (gdbmi-concat-output output
! (substring gud-marker-acc 0 (- (match-end 0) 1)))
!
! ;; Set the accumulator to the remaining text.
! gud-marker-acc (substring gud-marker-acc (match-end 0)))
! (gdbmi-prompt))
!
! (setq output (gdbmi-concat-output output gud-marker-acc))
! (setq gud-marker-acc "")
! output))
(defun gdbmi-concat-output (so-far new)
(let ((sink gdb-output-sink))
--- 353,443 ----
(defun gud-gdbmi-marker-filter (string)
"Filter GDB/MI output."
! (if gdb-flush-pending-output
! nil
! (if gdb-enable-debug-log (push (cons 'recv (list string gdb-output-sink))
! gdb-debug-log))
! ;; Recall the left over gud-marker-acc from last time
! (setq gud-marker-acc (concat gud-marker-acc string))
! ;; Start accumulating output for the GUD buffer
! (let ((output ""))
!
! (if (string-match gdb-running-regexp gud-marker-acc)
! (setq
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0)))
! gud-running t))
!
! (if (string-match gdb-stopped-regexp gud-marker-acc)
! (setq
!
! ;; Extract the frame position from the marker.
! gud-last-frame (cons (match-string 1 gud-marker-acc)
! (string-to-number
! (match-string 2 gud-marker-acc)))
!
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0)))))
!
! ;; Filter error messages going to GUD buffer and
! ;; display in minibuffer.
! (if (eq gdb-output-sink 'user)
! (while (string-match gdb-error-regexp gud-marker-acc)
! (message (read (match-string 1 gud-marker-acc)))
! (setq
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0))))))
!
! (if (string-match gdb-done-regexp gud-marker-acc)
! (setq
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0)))))
!
! (when (string-match gdb-gdb-regexp gud-marker-acc)
! (setq
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (substring gud-marker-acc (match-end 0))))
!
! ;; Remove the trimmings from the console stream.
! (while (string-match gdb-console-regexp gud-marker-acc)
! (setq
! gud-marker-acc (concat
! (substring gud-marker-acc 0 (match-beginning 0))
! (read (match-string 1 gud-marker-acc))
! (substring gud-marker-acc (match-end 0)))))
!
! ;; Remove the trimmings from log stream containing debugging messages
! ;; being produced by GDB's internals and use warning face.
! (while (string-match gdb-internals-regexp gud-marker-acc)
! (setq
! gud-marker-acc
! (concat (substring gud-marker-acc 0 (match-beginning 0))
! (let ((error-message
! (read (match-string 1 gud-marker-acc))))
! (put-text-property
! 0 (length error-message)
! 'face font-lock-warning-face
! error-message)
! error-message)
! (substring gud-marker-acc (match-end 0)))))
!
! (setq output (gdbmi-concat-output output gud-marker-acc))
! (setq gud-marker-acc "")
! (gdbmi-prompt1)
! (unless gdb-input-queue
! (setq output (concat output gdb-prompt-name)))
! (gdbmi-prompt2))
!
! (when gud-running
! (setq output (gdbmi-concat-output output gud-marker-acc))
! (setq gud-marker-acc ""))
!
! output)))
(defun gdbmi-concat-output (so-far new)
(let ((sink gdb-output-sink))
*************** GUD buffer (I/O of GDB) | Loca
*** 354,366 ****
gdb-break-list-custom)
(defconst gdb-break-list-regexp
! "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
gdb-pending-triggers))
! (let ((breakpoint nil)
! (breakpoints-list nil))
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
(while (re-search-forward gdb-break-list-regexp nil t)
--- 472,484 ----
gdb-break-list-custom)
(defconst gdb-break-list-regexp
! "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\
! addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
gdb-pending-triggers))
! (let ((breakpoint) (breakpoints-list))
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
(while (re-search-forward gdb-break-list-regexp nil t)
*************** GUD buffer (I/O of GDB) | Loca
*** 393,399 ****
;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-break-list-custom ()
! (let ((flag)(address))
;;
;; remove all breakpoint-icons in source buffers but not assembler buffer
(dolist (buffer (buffer-list))
--- 511,517 ----
;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-break-list-custom ()
! (let ((flag) (bptno))
;;
;; remove all breakpoint-icons in source buffers but not assembler buffer
(dolist (buffer (buffer-list))
*************** GUD buffer (I/O of GDB) | Loca
*** 406,434 ****
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
(forward-line 1)
! (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
(progn
! (setq flag (char-after (match-beginning 1)))
! (let ((line (match-string 3)) (buffer-read-only nil)
! (file (match-string 2)))
(add-text-properties (point-at-bol) (point-at-eol)
! '(mouse-face highlight
! help-echo "mouse-2, RET: visit breakpoint"))
! (with-current-buffer
! (find-file-noselect
! (if (file-exists-p file) file
! (expand-file-name file gdb-cdir)))
! (save-current-buffer
! (set (make-local-variable 'gud-minor-mode) 'gdbmi)
! (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)))))))))
! (end-of-line)))
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
;; Frames buffer. This displays a perpetually correct bactrack trace.
;;
(def-gdb-auto-updated-buffer gdb-stack-buffer
--- 524,588 ----
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
(forward-line 1)
! (if (looking-at
! "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+\\S-+\\s-+\
! \\(\\S-+\\):\\([0-9]+\\)")
(progn
! (setq bptno (match-string 1))
! (setq flag (char-after (match-beginning 2)))
! (let ((line (match-string 4)) (buffer-read-only nil)
! (file (match-string 3)))
(add-text-properties (point-at-bol) (point-at-eol)
! '(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)
! (set (make-local-variable 'gud-minor-mode)
! 'gdbmi)
! (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 "list "
! (match-string-no-properties 3) ":1\n")
! 'ignore))
! (gdb-enqueue-input
! (list "-file-list-exec-source-file\n"
! `(lambda () (gdbmi-get-location
! ,bptno ,line ,flag))))))))))
! (end-of-line)))
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
+ (defun gdbmi-get-location (bptno line flag)
+ "Find the directory containing the relevant source file.
+ Put in buffer and place breakpoint icon."
+ (goto-char (point-min))
+ (catch 'file-not-found
+ (if (re-search-forward gdb-source-file-regexp nil t)
+ (delete (cons bptno "File not found") gdb-location-alist)
+ (push (cons bptno (match-string 1)) gdb-location-alist)
+ (gdb-resync)
+ (unless (assoc bptno gdb-location-alist)
+ (push (cons bptno "File not found") gdb-location-alist)
+ (message-box "Cannot find source file for breakpoint location.
+ Add directory to search path for source files using the GDB command, dir."))
+ (throw 'file-not-found nil))
+ (with-current-buffer
+ (find-file-noselect (match-string 1))
+ (save-current-buffer
+ (set (make-local-variable 'gud-minor-mode) 'gdbmi)
+ (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)))))
+
;; Frames buffer. This displays a perpetually correct bactrack trace.
;;
(def-gdb-auto-updated-buffer gdb-stack-buffer
*************** GUD buffer (I/O of GDB) | Loca
*** 438,444 ****
gdb-stack-list-frames-custom)
(defconst gdb-stack-list-frames-regexp
! "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(defun gdb-stack-list-frames-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
--- 592,599 ----
gdb-stack-list-frames-custom)
(defconst gdb-stack-list-frames-regexp
! "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\
! file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(defun gdb-stack-list-frames-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
*************** GUD buffer (I/O of GDB) | Loca
*** 480,497 ****
'(mouse-face highlight
help-echo "mouse-2, RET: Select frame"))
(beginning-of-line)
! (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
! (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
! (equal (match-string 1) gdb-current-frame))
(put-text-property (point-at-bol) (point-at-eol)
'face '(:inverse-video t)))
(forward-line 1))))))
;; Locals buffer.
! ;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
(def-gdb-auto-updated-buffer gdb-locals-buffer
gdbmi-invalidate-locals
! "-stack-list-locals 2\n"
gdb-stack-list-locals-handler
gdb-stack-list-locals-custom)
--- 635,651 ----
'(mouse-face highlight
help-echo "mouse-2, RET: Select frame"))
(beginning-of-line)
! (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
! (equal (match-string 1) gdb-selected-frame))
(put-text-property (point-at-bol) (point-at-eol)
'face '(:inverse-video t)))
(forward-line 1))))))
;; Locals buffer.
! ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
(def-gdb-auto-updated-buffer gdb-locals-buffer
gdbmi-invalidate-locals
! "-stack-list-locals --simple-values\n"
gdb-stack-list-locals-handler
gdb-stack-list-locals-custom)
*************** GUD buffer (I/O of GDB) | Loca
*** 516,522 ****
(push local locals-list))))
(let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
(and buf (with-current-buffer buf
! (let ((p (point))
(buffer-read-only nil))
(erase-buffer)
(dolist (local locals-list)
--- 670,676 ----
(push local locals-list))))
(let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
(and buf (with-current-buffer buf
! (let ((p (window-point (get-buffer-window buf 0)))
(buffer-read-only nil))
(erase-buffer)
(dolist (local locals-list)
*************** GUD buffer (I/O of GDB) | Loca
*** 527,568 ****
"(structure)"
"(array)"))
"\n")))
! (goto-char p)))))))
(defun gdb-stack-list-locals-custom ()
nil)
! (defun gdbmi-source-info ()
! "Find the source file where the program starts and displays it with related
! buffers."
(goto-char (point-min))
! (if (search-forward "source file is " nil t)
! (if (looking-at "\\S-*")
! (setq gdb-main-file (match-string 0)))
! (setq gdb-view-source nil))
! (if (search-forward "directory is " nil t)
! (if (looking-at "\\S-*:\\(\\S-*\\)")
! (setq gdb-cdir (match-string 1))
! (looking-at "\\S-*")
! (setq gdb-cdir (match-string 0))))
!
! ;temporary heuristic
! (if gdb-main-file
! (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
! (if gdb-many-windows
(gdb-setup-windows)
! (gdb-get-create-buffer 'gdb-breakpoints-buffer)
! (when gdb-show-main
! (switch-to-buffer gud-comint-buffer)
! (delete-other-windows)
! (split-window)
! (other-window 1)
! (switch-to-buffer
! (if gdb-view-source
! (gud-find-file gdb-main-file)
! (gdb-get-create-buffer 'gdb-assembler-buffer)))
! (other-window 1))))
(provide 'gdb-mi)
;;; gdbmi.el ends here
--- 681,828 ----
"(structure)"
"(array)"))
"\n")))
! (set-window-point (get-buffer-window buf 0) p)))))))
(defun gdb-stack-list-locals-custom ()
nil)
!
! ;; Registers buffer.
! ;;
! (def-gdb-auto-updated-buffer gdb-registers-buffer
! gdbmi-invalidate-registers
! "-data-list-register-values x\n"
! gdb-data-list-register-values-handler
! gdb-data-list-register-values-custom)
!
! (defconst gdb-data-list-register-values-regexp
! "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"")
!
! (defun gdb-data-list-register-values-handler ()
! (setq gdb-pending-triggers (delq 'gdbmi-invalidate-registers
! gdb-pending-triggers))
! (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
! (goto-char (point-min))
! (if (re-search-forward gdb-error-regexp nil t)
! (progn
! (let ((match nil))
! (setq match (match-string 1))
! (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
! (let ((buffer-read-only nil))
! (erase-buffer)
! (insert match)
! (goto-char (point-min))))))
! (let ((register-list (reverse gdb-register-names))
! (register nil) (register-string nil) (register-values nil))
! (goto-char (point-min))
! (while (re-search-forward gdb-data-list-register-values-regexp nil t)
! (setq register (pop register-list))
! (setq register-string (concat register "\t" (match-string 2) "\n"))
! (if (member (match-string 1) gdb-changed-registers)
! (put-text-property 0 (length register-string)
! 'face 'font-lock-warning-face
! register-string))
! (setq register-values
! (concat register-values register-string)))
! (let ((buf (gdb-get-buffer 'gdb-registers-buffer)))
! (with-current-buffer buf
! (let ((p (window-point (get-buffer-window buf 0)))
! (buffer-read-only nil))
! (erase-buffer)
! (insert register-values)
! (set-window-point (get-buffer-window buf 0) p))))))))
!
! (defun gdb-data-list-register-values-custom ())
!
! (defun gdb-get-changed-registers ()
! (if (and (gdb-get-buffer 'gdb-registers-buffer)
! (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
! (progn
! (gdb-enqueue-input
! (list
! "-data-list-changed-registers\n"
! 'gdb-get-changed-registers-handler))
! (push 'gdb-get-changed-registers gdb-pending-triggers))))
!
! (defun gdb-get-changed-registers-handler ()
! (setq gdb-pending-triggers
! (delq 'gdb-get-changed-registers gdb-pending-triggers))
! (setq gdb-changed-registers nil)
! (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
! (goto-char (point-min))
! (while (re-search-forward gdb-data-list-register-names-regexp nil t)
! (push (match-string 1) gdb-changed-registers))))
!
!
! (defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
!
! (defun gdb-get-register-names ()
! "Create a list of register names."
(goto-char (point-min))
! (setq gdb-register-names nil)
! (while (re-search-forward gdb-data-list-register-names-regexp nil t)
! (push (match-string 1) gdb-register-names)))
!
! ;; these functions/variables may go into gdb-ui.el in the near future
! ;; (from gdb-nui.el)
!
! (defvar gdb-source-file-list nil)
! (defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
! (defun gdb-get-source-file ()
! "Find the source file where the program starts and display it with related
! buffers, if required."
! (goto-char (point-min))
! (if (re-search-forward gdb-source-file-regexp nil t)
! (setq gdb-main-file (match-string 1)))
! (if gdb-many-windows
(gdb-setup-windows)
! (gdb-get-create-buffer 'gdb-breakpoints-buffer)
! (if gdb-show-main
! (let ((pop-up-windows t))
! (display-buffer (gud-find-file gdb-main-file))))))
!
! (defun gdb-get-source-file-list ()
! "Create list of source files for current GDB session."
! (goto-char (point-min))
! (while (re-search-forward gdb-source-file-regexp nil t)
! (push (match-string 1) gdb-source-file-list)))
+ (defun gdbmi-get-selected-frame ()
+ (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
+ (progn
+ (gdb-enqueue-input
+ (list "-stack-info-frame\n" 'gdbmi-frame-handler))
+ (push 'gdbmi-get-selected-frame
+ gdb-pending-triggers))))
+
+ (defun gdbmi-frame-handler ()
+ (setq gdb-pending-triggers
+ (delq 'gdbmi-get-selected-frame gdb-pending-triggers))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward gdb-stack-list-frames-regexp nil t)
+ (setq gdb-frame-number (match-string 1))
+ (setq gdb-frame-address (match-string 2))
+ (setq gdb-selected-frame (match-string 3))
+ (setq gud-last-frame
+ (cons (match-string 4) (string-to-number (match-string 5))))
+ (gud-display-frame)
+ (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)))))))
+
+ (defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
+
+ (defun gdb-get-prompt ()
+ "Find prompt for GDB session."
+ (goto-char (point-min))
+ (setq gdb-prompt-name nil)
+ (re-search-forward gdb-prompt-name-regexp nil t)
+ (setq gdb-prompt-name (match-string 1)))
+
(provide 'gdb-mi)
;;; gdbmi.el ends here
More information about the Gdb-patches
mailing list