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