# HG changeset patch # User Dmitry Dzhus # Date 1246987346 0 # Node ID 47e338b0e07bf67f4fa5af3427b7962065611f0d # Parent 1373004c63eca566376ba4ca10770ce87b6c6bcd * progmodes/gdb-mi.el (gdb-init-1): Set correct mode name for disassembly buffer. (gdb-breakpoints-list-handler-custom): Replacement for gdb-break-list-handler. Using real parser instead of regexps now. (gdb-place-breakpoints): Replacement for gdb-break-list-custom. Use gdb-breakpoints-list instead of parsing breakpoints buffer to place breakpoints. (def-gdb-memory-unit): A new macro to define gdb-memory-unit-.. functions. (gdb-disassembly-handler-custom): Show overlay arrow. (gdb-disassembly-place-breakpoints): Show breakpoints in disassembly buffer. (gdb-toggle-breakpoint, gdb-delete-breakpoint) (gdb-goto-breakpoint): Using gdb-breakpoint text properties instead of parsing breakpoints buffer. Fixed old menu references in gud-menu-map. diff -r 1373004c63ec -r 47e338b0e07b lisp/ChangeLog --- a/lisp/ChangeLog Tue Jul 07 17:08:20 2009 +0000 +++ b/lisp/ChangeLog Tue Jul 07 17:22:26 2009 +0000 @@ -1,5 +1,22 @@ 2009-07-07 Dmitry Dzhus + * progmodes/gdb-mi.el (gdb-init-1): Set mode name for disassembly + buffer properly. + (gdb-breakpoints-list-handler-custom): Replacement for + gdb-break-list-handler. Using real parser instead of regexps now. + (gdb-place-breakpoints): Replacement for gdb-break-list-custom. + Use gdb-breakpoints-list instead of parsing breakpoints buffer to + place breakpoints. + (def-gdb-memory-unit): A new macro to define gdb-memory-unit-.. + functions. + (gdb-disassembly-handler-custom): Show overlay arrow. + (gdb-disassembly-place-breakpoints): Show breakpoints in + disassembly buffer. + (gdb-toggle-breakpoint, gdb-delete-breakpoint) + (gdb-goto-breakpoint): Using gdb-breakpoint text properties + instead of parsing breakpoints buffer. + Fixed old menu references in gud-menu-map. + * fadr.el: Removed. * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el diff -r 1373004c63ec -r 47e338b0e07b lisp/progmodes/gdb-mi.el --- a/lisp/progmodes/gdb-mi.el Tue Jul 07 17:08:20 2009 +0000 +++ b/lisp/progmodes/gdb-mi.el Tue Jul 07 17:22:26 2009 +0000 @@ -126,6 +126,12 @@ (defvar gdb-main-file nil "Source file from which program execution begins.") (defvar gdb-overlay-arrow-position nil) (defvar gdb-stack-position nil) +(defvar gdb-breakpoints-list nil + "List of breakpoints. + +`gdb-get-field' is used to access breakpoints data stored in this +variable. Each element contains the same fields as \"body\" +member of \"-break-info\".") (defvar gdb-location-alist nil "Alist of breakpoint numbers and full filenames. Only used for files that Emacs can't find.") @@ -382,7 +388,7 @@ (run-hooks 'gdb-mode-hook)) (defun gdb-init-1 () - (gud-def gud-break (if (not (string-equal mode-name "Machine")) + (gud-def gud-break (if (not (string-equal mode-name "Disassembly")) (gud-call "break %f:%l" arg) (save-excursion (beginning-of-line) @@ -390,7 +396,7 @@ (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-def gud-remove (if (not (string-equal mode-name "Disassembly")) (gud-call "clear %f:%l" arg) (save-excursion (beginning-of-line) @@ -398,7 +404,7 @@ (gud-call "clear *%a" arg))) "\C-d" "Remove breakpoint at current line or address.") ;; - (gud-def gud-until (if (not (string-equal mode-name "Machine")) + (gud-def gud-until (if (not (string-equal mode-name "Disassembly")) (gud-call "-exec-until %f:%l" arg) (save-excursion (beginning-of-line) @@ -1214,6 +1220,7 @@ (gdb-get-changed-registers) (gdb-invalidate-registers) (gdb-invalidate-locals) + (gdb-invalidate-disassembly) (gdb-invalidate-memory) (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) (dolist (var gdb-var-list) @@ -1530,61 +1537,50 @@ 'gdb-breakpoints-buffer-name 'gdb-breakpoints-mode) -(def-gdb-auto-update-trigger gdb-invalidate-breakpoints - (gdb-get-buffer 'gdb-breakpoints-buffer) - "-break-list\n" - gdb-break-list-handler) - -(defconst gdb-break-list-regexp -"bkpt={.*?number=\"\\(.*?\\)\".*?,type=\"\\(.*?\\)\".*?,disp=\"\\(.*?\\)\".*?,\ -enabled=\"\\(.\\)\".*?,addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\".*?,\ -file=\"\\(.*?\\)\".*?,fullname=\".*?\".*?,line=\"\\(.*?\\)\",\ -\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}") - -(defun gdb-break-list-handler () +(def-gdb-auto-updated-buffer gdb-breakpoints-buffer + gdb-invalidate-breakpoints "-break-list\n" + gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom) + +(defun gdb-breakpoints-list-handler-custom () (setq gdb-pending-triggers (delq 'gdb-invalidate-breakpoints gdb-pending-triggers)) - (let ((breakpoint) (breakpoints-list)) - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (goto-char (point-min)) - (while (re-search-forward gdb-break-list-regexp nil t) - (let ((breakpoint (list (match-string 1) - (match-string 2) - (match-string 3) - (match-string 4) - (match-string 5) - (match-string 6) - (match-string 7) - (match-string 8) - (match-string 9) - (match-string 10)))) - (push breakpoint breakpoints-list)))) - (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) - (and buf (with-current-buffer buf - (let ((p (point)) - (buffer-read-only nil)) - (erase-buffer) - (insert "Num Type Disp Enb Hits Addr What\n") - (dolist (breakpoint breakpoints-list) - (insert - (concat - (nth 0 breakpoint) " " - (nth 1 breakpoint) " " - (nth 2 breakpoint) " " - (propertize (nth 3 breakpoint) - 'face (if (eq (string-to-char (nth 3 breakpoint)) ?y) - font-lock-warning-face - font-lock-type-face)) " " - (nth 9 breakpoint) " " - (nth 4 breakpoint) " " - (if (nth 5 breakpoint) - (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n") - (concat (nth 8 breakpoint) "\n"))))) - (goto-char p)))))) - (gdb-break-list-custom)) + (let ((breakpoints-list (gdb-get-field + (json-partial-output "bkpt") + 'BreakpointTable 'body))) + (setq gdb-breakpoints-list breakpoints-list) + (insert "Num\tType\t\tDisp\tEnb\tHits\tAddr What\n") + (dolist (breakpoint breakpoints-list) + (insert + (concat + (gdb-get-field breakpoint 'number) "\t" + (gdb-get-field breakpoint 'type) "\t" + (gdb-get-field breakpoint 'disp) "\t" + (let ((flag (gdb-get-field breakpoint 'enabled))) + (if (string-equal flag "y") + (propertize "on" 'face font-lock-warning-face) + (propertize "off" 'face font-lock-type-face))) "\t" + (gdb-get-field breakpoint 'times) "\t" + (gdb-get-field breakpoint 'addr))) + (let ((at (gdb-get-field breakpoint 'at))) + (cond ((not at) + (progn + (insert + (concat " in " + (propertize (gdb-get-field breakpoint 'func) + 'face font-lock-function-name-face))) + (gdb-insert-frame-location breakpoint))) + (at (insert at)) + (t (insert (gdb-get-field breakpoint 'original-location))))) + (add-text-properties (line-beginning-position) + (line-end-position) + `(gdb-breakpoint ,breakpoint + mouse-face highlight + help-echo "mouse-2, RET: visit breakpoint")) + (newline)) + (gdb-place-breakpoints))) ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). -(defun gdb-break-list-custom () +(defun gdb-place-breakpoints () (let ((flag) (bptno)) ;; Remove all breakpoint-icons in source buffers but not assembler buffer. (dolist (buffer (buffer-list)) @@ -1592,49 +1588,30 @@ (if (and (eq gud-minor-mode 'gdbmi) (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) - (save-excursion - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at "[^\t].*?breakpoint") - (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) - (gdb-init-buffer) - ;; 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-input - (list (concat "list " - (match-string-no-properties 3) ":1\n") - 'ignore)) - (gdb-input - (list "-file-list-exec-source-file\n" - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))))))))))) - (end-of-line)))) + (dolist (breakpoint gdb-breakpoints-list) + (let ((line (gdb-get-field breakpoint 'line))) + (when line + (let ((file (gdb-get-field breakpoint 'file)) + (flag (gdb-get-field breakpoint 'enabled)) + (bptno (gdb-get-field breakpoint 'number))) + (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) + (gdb-init-buffer) + ;; Only want one breakpoint icon at each location. + (save-excursion + (goto-line (string-to-number line)) + (gdb-put-breakpoint-icon (string-equal flag "y") bptno))) + (gdb-input + (list (concat "list " file ":1\n") + 'ignore)) + (gdb-input + (list "-file-list-exec-source-file\n" + `(lambda () (gdb-get-location + ,bptno ,line ,flag))))))))))) (defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") @@ -1684,7 +1661,7 @@ (mouse-minibuffer-check event) (let ((posn (event-end event))) (with-selected-window (posn-window posn) - (if (or (buffer-file-name) (eq major-mode 'gdb-assembler-mode)) + (if (or (buffer-file-name) (eq major-mode 'gdb-disassembly-mode)) (if (numberp (posn-point posn)) (save-excursion (goto-char (posn-point posn)) @@ -1971,7 +1948,7 @@ (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (gdb-memory-set-address-1))) + (gdb-memory-set-address))) ;; Non-event version for use within keymap (defun gdb-memory-set-address () @@ -2074,29 +2051,26 @@ (vector (car selection)))))) (if binding (call-interactively binding))))) -(defun gdb-memory-unit-giant () - "Set the unit size to giant words (eight bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit 8) - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-word () - "Set the unit size to words (four bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit 4) - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-halfword () - "Set the unit size to halfwords (two bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit 2) - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-byte () - "Set the unit size to bytes." - (interactive) - (customize-set-variable 'gdb-memory-unit 1) - (gdb-invalidate-memory)) +(defmacro def-gdb-memory-unit (name unit-size doc) + "Define a function NAME to switch memory unit size to UNIT-SIZE. + +DOC is an optional documentation string." + `(defun ,name () ,(when doc doc) + (interactive) + (customize-set-variable 'gdb-memory-unit ,unit-size) + (gdb-invalidate-memory))) + +(def-gdb-memory-unit gdb-memory-unit-giant 8 + "Set the unit size to giant words (eight bytes).") + +(def-gdb-memory-unit gdb-memory-unit-word 4 + "Set the unit size to words (four bytes).") + +(def-gdb-memory-unit gdb-memory-unit-halfword 2 + "Set the unit size to halfwords (two bytes).") + +(def-gdb-memory-unit gdb-memory-unit-byte 1 + "Set the unit size to bytes.") (defmacro def-gdb-memory-show-page (name address-var &optional doc) "Define a function NAME which show new address in memory buffer. @@ -2254,9 +2228,10 @@ (interactive) (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))))) + `((left-fringe . 0) + (right-fringe . 0) + (width . 83) + ,@gdb-frame-parameters))) (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) @@ -2320,6 +2295,9 @@ (kill-all-local-variables) (setq major-mode 'gdb-disassembly-mode) (setq mode-name "Disassembly") + (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) + (setq fringes-outside-margins t) + (setq gdb-overlay-arrow-position (make-marker)) (use-local-map gdb-disassembly-mode-map) (setq buffer-read-only t) (buffer-disable-undo) @@ -2332,8 +2310,28 @@ (let* ((res (json-partial-output)) (instructions (gdb-get-field res 'asm_insns))) (dolist (instr instructions) + ;; Put overlay arrow + (when (string-equal (gdb-get-field instr 'address) + gdb-pc-address) + (progn + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle)))) + (set-marker gdb-overlay-arrow-position (point)))) (insert (apply 'format `("%s <%s+%s>:\t%s\n" - ,@(gdb-get-many-fields instr 'address 'func-name 'offset 'inst))))))) + ,@(gdb-get-many-fields instr 'address 'func-name 'offset 'inst)))))) + (gdb-disassembly-place-breakpoints)) + +(defun gdb-disassembly-place-breakpoints () + (dolist (breakpoint gdb-breakpoints-list) + (let ((bptno (gdb-get-field breakpoint 'number)) + (flag (gdb-get-field breakpoint 'enabled)) + (address (gdb-get-field breakpoint 'addr))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" address) nil t) + (gdb-put-breakpoint-icon (string-equal flag "y") bptno)))))) ;;; Breakpoints view @@ -2384,44 +2382,40 @@ (run-mode-hooks 'gdb-breakpoints-mode-hook) 'gdb-invalidate-breakpoints) -(defconst gdb-breakpoint-regexp - "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") - (defun gdb-toggle-breakpoint () - "Enable/disable breakpoint at current line." + "Enable/disable breakpoint at current line of breakpoints buffer." (interactive) (save-excursion - (beginning-of-line 1) - (if (looking-at gdb-breakpoint-regexp) - (gud-basic-call - (concat (if (eq ?y (char-after (match-beginning 2))) - "-break-disable " - "-break-enable ") - (match-string 1))) - (error "Not recognized as break/watchpoint line")))) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (gud-basic-call + (concat (if (string-equal "y" (gdb-get-field breakpoint 'enabled)) + "-break-disable " + "-break-enable ") + (gdb-get-field breakpoint 'number))) + (error "Not recognized as break/watchpoint line"))))) (defun gdb-delete-breakpoint () - "Delete the breakpoint at current line." + "Delete the breakpoint at current line of breakpoints buffer." (interactive) - (save-excursion - (beginning-of-line 1) - (if (looking-at gdb-breakpoint-regexp) - (gud-basic-call (concat "-break-delete " (match-string 1))) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (gud-basic-call (concat "-break-delete " (gdb-get-field breakpoint 'number))) (error "Not recognized as break/watchpoint line")))) (defun gdb-goto-breakpoint (&optional event) - "Display the breakpoint location specified at current line." + "Go to the location of breakpoint at current line of +breakpoints buffer." (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer. (let ((window (get-buffer-window gud-comint-buffer))) (if window (save-selected-window (select-window window)))) - (save-excursion - (beginning-of-line 1) - (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)") - (let ((bptno (match-string 1)) - (file (match-string 2)) - (line (match-string 3))) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (let ((bptno (gdb-get-field breakpoint 'number)) + (file (gdb-get-field breakpoint 'file)) + (line (gdb-get-field breakpoint 'line))) (save-selected-window (let* ((buffer (find-file-noselect (if (file-exists-p file) file @@ -2447,7 +2441,10 @@ gdb-stack-list-frames-handler) (defun gdb-insert-frame-location (frame) - "Insert \"file:line\" button or library name for FRAME object." + "Insert \"of file:line\" button or library name for structure FRAME. + +FRAME must have either \"file\" and \"line\" members or \"from\" +member." (let ((file (gdb-get-field frame 'fullname)) (line (gdb-get-field frame 'line)) (from (gdb-get-field frame 'from))) @@ -2861,7 +2858,7 @@ (let ((frame (gdb-get-field (json-partial-output) 'frame))) (when frame (setq gdb-frame-number (gdb-get-field frame 'level)) - (setq gdb-pc-address (gdb-get-field frame addr)) + (setq gdb-pc-address (gdb-get-field frame 'addr)) (setq gdb-selected-frame (gdb-get-field frame 'func)) (setq gdb-selected-file (gdb-get-field frame 'fullname)) (let ((line (gdb-get-field frame 'line))) @@ -2927,8 +2924,7 @@ :visible (eq gud-minor-mode 'gdbmi))) (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) -; (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) - (define-key menu [memory] '("Memory" . gdb-todo-memory)) + (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) (define-key menu [disassembly] '("Disassembly" . gdb-display-disassembly-buffer)) (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) @@ -2946,8 +2942,7 @@ :visible (eq gud-minor-mode 'gdbmi))) (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) -; (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) - (define-key menu [memory] '("Memory" . gdb-todo-memory)) + (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) (define-key menu [inferior]