Mercurial > emacs
changeset 51028:323ddc93f3fe
(gdb-info-frames-custom): Reverse contrast of face for
selected frame.
(gdb-annotation-rules): Stop using frames-invalid and
breakpoints-invalid annotations. Update after post-prompt instead.
(gdb-post-prompt): Update frames and breakpoints here.
(gdb-invalidate-frame-and-assembler)
(gdb-invalidate-breakpoints-and-assembler): Remove.
(gdb-current-address): Remove.
(gdb-previous-address): New variable.
(gud-until): Extend to work in Assembler buffer
(gdb-append-to-inferior-io): Select IO buffer when there is
output.
(gdb-assembler-custom): Try to get line marker (arrow) to display
in window. Correct parsing for OS dependent output syntax of Gdb
command, where.
(gdb-frame-handler): Correct parsing for OS dependent output
syntax of Gdb command, frame.
(gdb-invalidate-assembler): Update assembler buffer correctly when
frame changes (revisited).
| author | Nick Roberts <nickrob@snap.net.nz> |
|---|---|
| date | Sat, 17 May 2003 10:17:57 +0000 |
| parents | 08b938c3a5fc |
| children | ffa1dc43c997 |
| files | lisp/gdb-ui.el |
| diffstat | 1 files changed, 104 insertions(+), 84 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gdb-ui.el Sat May 17 10:17:01 2003 +0000 +++ b/lisp/gdb-ui.el Sat May 17 10:17:57 2003 +0000 @@ -58,8 +58,8 @@ :type 'integer :group 'gud) -(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.") -(defvar gdb-current-address nil) +(defvar gdb-current-address nil "Initialisation for Assembler buffer.") +(defvar gdb-previous-address nil) (defvar gdb-display-in-progress nil) (defvar gdb-dive nil) (defvar gdb-buffer-type nil) @@ -143,11 +143,19 @@ (gud-call "clear *%a" arg))) "\C-d" "Remove breakpoint at current line or address.") ;; + (gud-def gud-until (if (not (string-equal mode-name "Assembler")) + (gud-call "until %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "until *%a" arg))) + "\C-u" "Continue up to current line or address.") + (setq comint-input-sender 'gdb-send) ;; ;; (re-)initialise - (setq gdb-main-or-pc "main") - (setq gdb-current-address nil) + (setq gdb-current-address "main") + (setq gdb-previous-address nil) (setq gdb-display-in-progress nil) (setq gdb-dive nil) ;; @@ -508,9 +516,7 @@ :group 'gud) (defvar gdb-annotation-rules - '(("frames-invalid" gdb-invalidate-frame-and-assembler) - ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler) - ("pre-prompt" gdb-pre-prompt) + '(("pre-prompt" gdb-pre-prompt) ("prompt" gdb-prompt) ("commands" gdb-subprompt) ("overload-choice" gdb-subprompt) @@ -524,7 +530,7 @@ ("signal" gdb-stopping) ("breakpoint" gdb-stopping) ("watchpoint" gdb-stopping) -; ("frame-begin" gdb-frame-begin) + ("frame-begin" gdb-frame-begin) ("stopped" gdb-stopped) ("display-begin" gdb-display-begin) ("display-end" gdb-display-end) @@ -555,7 +561,6 @@ (match-string 1 args) (string-to-int (match-string 2 args)))) (setq gdb-current-address (match-string 3 args)) - (setq gdb-main-or-pc gdb-current-address) ;;update with new frame for machine code if necessary (gdb-invalidate-assembler)) @@ -663,9 +668,12 @@ (if (not (gdb-get-pending-triggers)) (progn (gdb-get-current-frame) - (gdb-invalidate-registers ignored) - (gdb-invalidate-locals ignored) - (gdb-invalidate-display ignored) + (gdb-invalidate-frames) + (gdb-invalidate-breakpoints) + (gdb-invalidate-assembler) + (gdb-invalidate-registers) + (gdb-invalidate-locals) + (gdb-invalidate-display) (gdb-invalidate-threads))) (let ((sink (gdb-get-output-sink))) (cond @@ -1160,8 +1168,8 @@ (goto-char (point-max)) (insert-before-markers string)) (if (not (string-equal string "")) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-inferior-io)))) + (select-window + (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io))))) (defun gdb-clear-inferior-io () (save-excursion @@ -1351,8 +1359,8 @@ (forward-line 1) (if (looking-at "[^\t].*breakpoint") (progn - (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") - (setq flag (char-after (match-beginning 2))) + (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") + (setq flag (char-after (match-beginning 1))) (beginning-of-line) (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) (progn @@ -1512,13 +1520,23 @@ (defun gdb-info-frames-custom () (save-excursion (set-buffer (gdb-get-buffer 'gdb-stack-buffer)) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (put-text-property (progn (beginning-of-line) (point)) - (progn (end-of-line) (point)) - 'mouse-face 'highlight) - (forward-line 1))))) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'mouse-face 'highlight) + (beginning-of-line) + (if (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") + (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) + (if (equal (match-string 1) gdb-current-frame) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'face + `(:background ,(face-attribute 'default :foreground) + :foreground ,(face-attribute 'default :background))))) + (forward-line 1)))))) (defun gdb-stack-buffer-name () (with-current-buffer gud-comint-buffer @@ -1549,6 +1567,7 @@ (setq mode-name "Frames") (setq buffer-read-only t) (use-local-map gdb-frames-mode-map) + (font-lock-mode -1) (gdb-invalidate-frames)) (defun gdb-get-frame-number () @@ -2214,29 +2233,28 @@ (def-gdb-auto-updated-buffer gdb-assembler-buffer gdb-invalidate-assembler - (concat "server disassemble " gdb-main-or-pc "\n") + (concat "server disassemble " gdb-current-address "\n") gdb-assembler-handler gdb-assembler-custom) (defun gdb-assembler-custom () (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) - (gdb-arrow-position) (address) (flag)) - (if gdb-current-address - (progn - (save-excursion - (set-buffer buffer) + (address) (flag)) + (save-excursion + (set-buffer buffer) + (if (not (equal gdb-current-address "main")) + (progn (remove-arrow) (goto-char (point-min)) - (re-search-forward gdb-current-address) - (setq gdb-arrow-position (point)) - (put-arrow "=>" gdb-arrow-position nil 'left-margin)))) - ;; remove all breakpoint-icons in assembler buffer before updating. - (save-excursion - (set-buffer buffer) - (if (display-graphic-p) - (remove-images (point-min) (point-max)) - (remove-strings (point-min) (point-max)))) - (save-excursion + (if (re-search-forward gdb-current-address nil t) + (progn + (put-arrow "=>" (point) nil 'left-margin) + (set-window-point gdb-source-window (point)))))) + ;; remove all breakpoint-icons in assembler buffer before updating. + (save-excursion + (if (display-graphic-p) + (remove-images (point-min) (point-max)) + (remove-strings (point-min) (point-max)))) (set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)) (goto-char (point-min)) (while (< (point) (- (point-max) 1)) @@ -2244,33 +2262,35 @@ (if (looking-at "[^\t].*breakpoint") (progn (looking-at - "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)") - ;; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit) - (setq address (concat "0x" (match-string 3))) - (setq flag (char-after (match-beginning 2))) + "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)") + (setq flag (char-after (match-beginning 1))) + (let ((number (match-string 2))) + ;; remove leading 0s from output of info break. + (if (string-match "0x0+\\(.*\\)" number) + (setq address (concat "0x" (match-string 1 address))) + (setq address number))) (save-excursion (set-buffer buffer) - (goto-char (point-min)) - (if (re-search-forward address nil t) - (let ((start (progn (beginning-of-line) (- (point) 1))) - (end (progn (end-of-line) (+ (point) 1)))) - (if (display-graphic-p) - (progn - (remove-images start end) - (if (eq ?y flag) - (put-image breakpoint-enabled-icon (point) - "breakpoint icon enabled" - 'left-margin) - (put-image breakpoint-disabled-icon (point) - "breakpoint icon disabled" - 'left-margin))) - (remove-strings start end) - (if (eq ?y flag) - (put-string "B" (point) "enabled" 'left-margin) - (put-string "b" (point) "disabled" - 'left-margin)))))))))) - (if gdb-current-address - (set-window-point (get-buffer-window buffer) gdb-arrow-position)))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward address nil t) + (let ((start (progn (beginning-of-line) (- (point) 1))) + (end (progn (end-of-line) (+ (point) 1)))) + (if (display-graphic-p) + (progn + (remove-images start end) + (if (eq ?y flag) + (put-image breakpoint-enabled-icon (point) + "breakpoint icon enabled" + 'left-margin) + (put-image breakpoint-disabled-icon (point) + "breakpoint icon disabled" + 'left-margin))) + (remove-strings start end) + (if (eq ?y flag) + (put-string "B" (point) "enabled" 'left-margin) + (put-string "b" (point) "disabled" + 'left-margin))))))))))))) (defvar gdb-assembler-mode-map (let ((map (make-sparse-keymap))) @@ -2303,40 +2323,29 @@ (switch-to-buffer-other-frame (gdb-get-create-buffer 'gdb-assembler-buffer))) -(defun gdb-invalidate-frame-and-assembler (&optional ignored) - (gdb-invalidate-frames) - (gdb-invalidate-assembler)) - -(defun gdb-invalidate-breakpoints-and-assembler (&optional ignored) - (gdb-invalidate-breakpoints) - (gdb-invalidate-assembler)) - -(defvar gdb-prev-main-or-pc nil) - -;; modified because if gdb-main-or-pc has changed value a new command +;; modified because if gdb-current-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 (and (gdb-get-buffer 'gdb-assembler-buffer) (or (not (member 'gdb-invalidate-assembler (gdb-get-pending-triggers))) - (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc)))) + (not (string-equal gdb-current-address gdb-previous-address)))) (progn ;; take previous disassemble command off the queue (save-excursion (set-buffer gud-comint-buffer) - (let ((queue gdb-idle-input-queue) (item)) + (let ((queue (gdb-get-idle-input-queue)) (item)) (dolist (item queue) - (setq item (car queue)) (if (equal (cdr item) '(gdb-assembler-handler)) - (setq gdb-idle-input-queue - (delete item gdb-idle-input-queue)))))) + (gdb-set-idle-input-queue + (delete item (gdb-get-idle-input-queue))))))) (gdb-enqueue-idle-input - (list (concat "server disassemble " gdb-main-or-pc "\n") + (list (concat "server disassemble " gdb-current-address "\n") 'gdb-assembler-handler)) (gdb-set-pending-triggers (cons 'gdb-invalidate-assembler (gdb-get-pending-triggers))) - (setq gdb-prev-main-or-pc gdb-main-or-pc)))) + (setq gdb-previous-address gdb-current-address)))) (defun gdb-get-current-frame () (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers))) @@ -2353,8 +2362,19 @@ (save-excursion (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)) (goto-char (point-min)) - (if (looking-at "^#[0-9]*\\s-*0x\\S-* in \\(\\S-*\\)") - (setq gdb-current-frame (match-string 1)) + (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\) in \\(\\S-*\\)") + (progn + (setq gdb-current-frame (match-string 2)) + (let ((address (match-string 1))) + ;; remove leading 0s from output of frame command. + (if (string-match "0x0+\\(.*\\)" address) + (setq gdb-current-address (concat "0x" (match-string 1 address))) + (setq gdb-current-address address))) + (if (not (looking-at ".*) at ")) + (progn + (set-window-buffer gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + (gdb-invalidate-assembler)))) (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)") (setq gdb-current-frame (match-string 1))))))