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.
This commit is contained in:
Nick Roberts
parent
05747abbf7
commit
44236a56a4
614
gdb/mi/gdb-mi.el
614
gdb/mi/gdb-mi.el
|
|
@ -1,13 +1,10 @@
|
|||
;;; 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")
|
||||
;;; gdb-mi.el
|
||||
|
||||
;; Author: Nick Roberts <nickrob@gnu.org>
|
||||
;; Maintainer: Nick Roberts <nickrob@gnu.org>
|
||||
;; Keywords: unix, tools
|
||||
|
||||
;; Copyright (C) 2004 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU GDB.
|
||||
|
||||
|
|
@ -23,29 +20,49 @@
|
|||
|
||||
;;; 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).
|
||||
;; 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.
|
||||
|
||||
;; 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)
|
||||
|
|
@ -106,12 +123,23 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
(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-insert %f:%l" arg)
|
||||
(gud-call "break %f:%l" arg)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(forward-char 2)
|
||||
(gud-call "-break-insert *%a" arg)))
|
||||
(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"))
|
||||
|
|
@ -123,35 +151,43 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
"\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)
|
||||
(gud-call "-exec-until %f:%l" arg)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(forward-char 2)
|
||||
(gud-call "until *%a" arg)))
|
||||
(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-toggle-breakpoint)
|
||||
'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-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-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)
|
||||
;;
|
||||
|
|
@ -160,28 +196,34 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
;;
|
||||
(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 (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))
|
||||
(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 --all-values Needs GDB 6.1 onwards.
|
||||
; Uses "-var-list-children --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=\"\\(.*?\\)\""
|
||||
)
|
||||
"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",\
|
||||
value=\"\\(.*?\\)\"")
|
||||
|
||||
(defun gdbmi-var-list-children-handler (varnum)
|
||||
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
|
||||
|
|
@ -208,49 +250,93 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
(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 "\"")))
|
||||
|
||||
; 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."
|
||||
(setq gdb-output-sink 'user)
|
||||
(setq gdb-prompting nil)
|
||||
(process-send-string proc (concat string "\n")))
|
||||
(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/gdb/gdb -interp=mi"
|
||||
(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-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")
|
||||
(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
|
||||
|
||||
(defun gdbmi-prompt ()
|
||||
"This handler terminates the any collection of output. It also
|
||||
sends the next command (if any) to gdb."
|
||||
;; 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
|
||||
(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))
|
||||
(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
|
||||
|
|
@ -267,59 +353,91 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
|
||||
(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 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 (substring gud-marker-acc (match-end 0))
|
||||
gud-running t))
|
||||
(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))
|
||||
|
||||
;; 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)))))
|
||||
(if (string-match gdb-stopped-regexp gud-marker-acc)
|
||||
(setq
|
||||
|
||||
;; 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)))))
|
||||
;; 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)))
|
||||
|
||||
(if (string-match gdb-stopped-regexp gud-marker-acc)
|
||||
(setq
|
||||
gud-marker-acc
|
||||
(concat (substring gud-marker-acc 0 (match-beginning 0))
|
||||
(substring gud-marker-acc (match-end 0)))))
|
||||
|
||||
;; 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)))
|
||||
;; 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))))))
|
||||
|
||||
;; 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)))
|
||||
(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)))))
|
||||
|
||||
;; 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
|
||||
(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))))
|
||||
|
||||
;; 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)))
|
||||
;; 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)))))
|
||||
|
||||
;; Set the accumulator to the remaining text.
|
||||
gud-marker-acc (substring gud-marker-acc (match-end 0)))
|
||||
(gdbmi-prompt))
|
||||
;; 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 "")
|
||||
output))
|
||||
(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))
|
||||
|
|
@ -354,13 +472,13 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
gdb-break-list-custom)
|
||||
|
||||
(defconst gdb-break-list-regexp
|
||||
"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
|
||||
"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))
|
||||
(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)
|
||||
|
|
@ -393,7 +511,7 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
|
||||
;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
|
||||
(defun gdb-break-list-custom ()
|
||||
(let ((flag)(address))
|
||||
(let ((flag) (bptno))
|
||||
;;
|
||||
;; remove all breakpoint-icons in source buffers but not assembler buffer
|
||||
(dolist (buffer (buffer-list))
|
||||
|
|
@ -406,29 +524,65 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
(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]+\\)")
|
||||
(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)))
|
||||
(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"))
|
||||
(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)))
|
||||
'(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
|
||||
|
|
@ -438,7 +592,8 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
gdb-stack-list-frames-custom)
|
||||
|
||||
(defconst gdb-stack-list-frames-regexp
|
||||
"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
|
||||
"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\
|
||||
file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
|
||||
|
||||
(defun gdb-stack-list-frames-handler ()
|
||||
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
|
||||
|
|
@ -480,18 +635,17 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
'(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))
|
||||
(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 2". Needs GDB 6.1 onwards.
|
||||
;; 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 2\n"
|
||||
"-stack-list-locals --simple-values\n"
|
||||
gdb-stack-list-locals-handler
|
||||
gdb-stack-list-locals-custom)
|
||||
|
||||
|
|
@ -516,7 +670,7 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
(push local locals-list))))
|
||||
(let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
|
||||
(and buf (with-current-buffer buf
|
||||
(let ((p (point))
|
||||
(let ((p (window-point (get-buffer-window buf 0)))
|
||||
(buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(dolist (local locals-list)
|
||||
|
|
@ -527,42 +681,148 @@ GUD buffer (I/O of GDB) | Locals buffer
|
|||
"(structure)"
|
||||
"(array)"))
|
||||
"\n")))
|
||||
(goto-char p)))))))
|
||||
(set-window-point (get-buffer-window buf 0) 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."
|
||||
|
||||
;; 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))
|
||||
(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))))
|
||||
(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)
|
||||
|
||||
;temporary heuristic
|
||||
(if gdb-main-file
|
||||
(setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
|
||||
(defvar gdb-source-file-list nil)
|
||||
(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
|
||||
|
||||
(if gdb-many-windows
|
||||
(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)
|
||||
(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))))
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in New Issue