(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).

1 files changed, 104 insertions, 84 deletions

diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el
index 4ebd4ad4364..60310f071c9 100644
--- a/lisp/gdb-ui.el
+++ b/lisp/gdb-ui.el
@@ -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 @@ The following interactive lisp functions help control operation :
 			  (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 @@ This filter may simply queue output for a later time."
   :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 @@ This filter may simply queue output for a later time."
     ("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 @@ This filter may simply queue output for a later time."
 	 (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 @@ output from the current command if that happens to be appropriate."
   (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 @@ output from the current command if that happens to be appropriate."
     (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 @@ static char *magick[] = {
 	  (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 @@ current line."
 (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 @@ current line."
   (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 @@ BUFFER nil or omitted means use the current buffer."
 
 (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)
-	    (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.
+	(address) (flag))
     (save-excursion
       (set-buffer buffer)
-      (if (display-graphic-p)
-	  (remove-images (point-min) (point-max))
-	(remove-strings (point-min) (point-max))))
-    (save-excursion
+      (if (not (equal gdb-current-address "main"))
+	  (progn
+	    (remove-arrow)
+	    (goto-char (point-min))
+	    (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 @@ BUFFER nil or omitted means use the current buffer."
 	(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 @@ BUFFER nil or omitted means use the current buffer."
   (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 @@ BUFFER nil or omitted means use the current buffer."
   (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))))))