]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/gdb-ui.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / progmodes / gdb-ui.el
index ac98c906e28980aafbca889adb1ec18cd640f300..45843ec696f90145a911498bd6a5715594f3d9b6 100644 (file)
 ;;; TODO:
 
 ;; 1) Use MI command -data-read-memory for memory window.
-;; 2) Use tree-widget.el instead of the speedbar for watch-expressions?
+;; 2) Use tree-buffer.el (from ECB) instead of the speedbar for
+;;    watch-expressions?  Handling of watch-expressions needs to be
+;;    overhauled to work for large arrays/structures by creating variable
+;;    objects for visible watch-expressions only.
 ;; 3) Mark breakpoint locations on scroll-bar of source buffer?
 
 ;;; Code:
 (defvar gdb-pc-address nil "Initialization for Assembler buffer.
 Set to \"main\" at start if `gdb-show-main' is t.")
 (defvar gdb-frame-address nil "Identity of frame for watch expression.")
-(defvar gdb-previous-frame-address nil)
+(defvar gdb-previous-frame-pc-address nil)
 (defvar gdb-memory-address "main")
 (defvar gdb-previous-frame nil)
 (defvar gdb-selected-frame nil)
@@ -196,8 +199,7 @@ gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
 (defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"")
 
 (defvar gdb-locals-font-lock-keywords-1
-  '(
-    ;; var = (struct struct_tag) value
+  '(;; var = (struct struct_tag) value
     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)"
       (1 font-lock-variable-name-face)
       (3 font-lock-keyword-face)
@@ -208,17 +210,14 @@ gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
       (3 font-lock-type-face))
     ;; var = val
     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]"
-      (1 font-lock-variable-name-face))
-    )
+      (1 font-lock-variable-name-face)))
   "Font lock keywords used in `gdb-local-mode'.")
 
 (defvar gdb-locals-font-lock-keywords-2
-  '(
-    ;; var = type value
+  '(;; var = type value
     ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)"
       (1 font-lock-variable-name-face)
-      (3 font-lock-type-face))
-    )
+      (3 font-lock-type-face)))
   "Font lock keywords used in `gdb-local-mode'.")
 
 ;; Variables for GDB 6.4+
@@ -485,6 +484,15 @@ otherwise do not."
 
 (defconst gdb-source-file-regexp "\\(.+?\\), \\|\\([^, \n].*$\\)")
 
+(defun gdb-init-buffer ()
+  (set (make-local-variable 'gud-minor-mode)
+       (buffer-local-value 'gud-minor-mode gud-comint-buffer))
+  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+  (when gud-tooltip-mode
+    (make-local-variable 'gdb-define-alist)
+    (gdb-create-define-alist)
+    (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
+
 (defun gdb-set-gud-minor-mode-existing-buffers ()
   "Create list of source files for current GDB session."
   (goto-char (point-min))
@@ -497,12 +505,7 @@ otherwise do not."
        (when (and buffer-file-name
                   (member (file-name-nondirectory buffer-file-name)
                           gdb-source-file-list))
-         (set (make-local-variable 'gud-minor-mode) 'gdba)
-         (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
-         (when gud-tooltip-mode
-           (make-local-variable 'gdb-define-alist)
-           (gdb-create-define-alist)
-           (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
+         (gdb-init-buffer)))))
   (gdb-force-mode-line-update
    (propertize "ready" 'face font-lock-variable-name-face)))
 
@@ -589,7 +592,7 @@ otherwise do not."
 
   ;; (re-)initialize
   (setq gdb-pc-address (if gdb-show-main "main" nil))
-  (setq gdb-previous-frame-address nil
+  (setq gdb-previous-frame-pc-address nil
        gdb-memory-address "main"
        gdb-previous-frame nil
        gdb-selected-frame nil
@@ -755,16 +758,16 @@ With arg, enter name of variable to be watched in the minibuffer."
                                        'gud-gdb-complete-command)
                     (if (and transient-mark-mode mark-active)
                         (buffer-substring (region-beginning) (region-end))
-                      (tooltip-identifier-from-point (point))))))
-             (speedbar 1)
-               (set-text-properties 0 (length expr) nil expr)
-               (gdb-enqueue-input
-                (list
-                 (if (eq minor-mode 'gdba)
-                     (concat
-                      "server interpreter mi \"-var-create - * "  expr "\"\n")
-                   (concat"-var-create - * "  expr "\n"))
-                 `(lambda () (gdb-var-create-handler ,expr)))))))
+                      (concat (if (eq major-mode 'gdb-registers-mode) "$")
+                              (tooltip-identifier-from-point (point)))))))
+             (set-text-properties 0 (length expr) nil expr)
+             (gdb-enqueue-input
+              (list
+               (if (eq minor-mode 'gdba)
+                   (concat
+                    "server interpreter mi \"-var-create - * "  expr "\"\n")
+                 (concat"-var-create - * "  expr "\n"))
+               `(lambda () (gdb-var-create-handler ,expr)))))))
       (message "gud-watch is a no-op in this mode."))))
 
 (defconst gdb-var-create-regexp
@@ -784,6 +787,7 @@ With arg, enter name of variable to be watched in the minibuffer."
                  (if (match-string 3) (read (match-string 3)))
                  nil gdb-frame-address)))
        (push var gdb-var-list)
+       (speedbar 1)
        (unless (string-equal
                 speedbar-initial-expansion-list-name "GUD")
          (speedbar-change-initial-expansion-list "GUD"))
@@ -810,6 +814,8 @@ With arg, enter name of variable to be watched in the minibuffer."
     (push 'gdb-speedbar-timer gdb-pending-triggers)))
 
 (defun gdb-speedbar-timer-fn ()
+  (if gdb-speedbar-auto-raise
+      (raise-frame speedbar-frame))
   (setq gdb-pending-triggers
        (delq 'gdb-speedbar-timer gdb-pending-triggers))
   (speedbar-timer-fn))
@@ -1468,7 +1474,7 @@ directives."
       (gdb-resync)
       (error "Unexpected frame-begin annotation (%S)" sink)))))
 
-(defcustom gdb-same-frame focus-follows-mouse
+(defcustom gdb-same-frame (not focus-follows-mouse)
   "Non-nil means pop up GUD buffer in same frame."
   :group 'gdb
   :type 'boolean
@@ -1562,7 +1568,8 @@ happens to be appropriate."
       (gdb-invalidate-locals-1))
 
     (gdb-invalidate-threads)
-    (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
+    (unless (or (null gdb-var-list)
+            (eq system-type 'darwin)) ;Breaks on Darwin's GDB-5.3.
       ;; FIXME: with GDB-6 on Darwin, this might very well work.
       ;; Only needed/used with speedbar/watch expressions.
       (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
@@ -1923,43 +1930,40 @@ static char *magick[] = {
     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
       (save-excursion
        (let ((buffer-read-only nil))
-       (goto-char (point-min))
-       (while (< (point) (- (point-max) 1))
-         (forward-line 1)
-         (if (looking-at gdb-breakpoint-regexp)
-             (progn
-               (setq bptno (or (match-string 1) (match-string 2)))
-               (setq flag (char-after (match-beginning 3)))
-               (if (match-string 1)
-                   (setq gdb-parent-bptno-enabled (eq flag ?y)))
-               (add-text-properties
-                (match-beginning 3) (match-end 3)
-                (if (eq flag ?y)
-                    '(face font-lock-warning-face)
-                  '(face font-lock-type-face)))
-               (let ((bl (point))
-                     (el (line-end-position)))
-                 (if (re-search-forward " in \\(.*\\) at\\s-+" el t)
-                     (progn
-                       (add-text-properties
-                        (match-beginning 1) (match-end 1)
-                        '(face font-lock-function-name-face))
-                       (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
+         (goto-char (point-min))
+         (while (< (point) (- (point-max) 1))
+           (forward-line 1)
+           (if (looking-at gdb-breakpoint-regexp)
+               (progn
+                 (setq bptno (or (match-string 1) (match-string 2)))
+                 (setq flag (char-after (match-beginning 3)))
+                 (if (match-string 1)
+                     (setq gdb-parent-bptno-enabled (eq flag ?y)))
+                 (add-text-properties
+                  (match-beginning 3) (match-end 3)
+                  (if (eq flag ?y)
+                      '(face font-lock-warning-face)
+                    '(face font-lock-type-face)))
+                 (let ((bl (point))
+                       (el (line-end-position)))
+                   (when (re-search-forward " in \\(.*\\) at" el t)
+                     (add-text-properties
+                      (match-beginning 1) (match-end 1)
+                      '(face font-lock-function-name-face)))
+                   (if (re-search-forward
+                        ".*\\s-+\\(\\S-+\\):\\([0-9]+\\)$" nil t)
                        (let ((line (match-string 2))
                              (file (match-string 1)))
                          (add-text-properties bl el
-                          '(mouse-face highlight
-                            help-echo "mouse-2, RET: visit breakpoint"))
+                              '(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)
-                               (set (make-local-variable 'gud-minor-mode)
-                                    'gdba)
-                               (set (make-local-variable 'tool-bar-map)
-                                    gud-tool-bar-map)
+                               (gdb-init-buffer)
                                ;; Only want one breakpoint icon at each
                                ;; location.
                                (save-excursion
@@ -1973,20 +1977,20 @@ static char *magick[] = {
                            (gdb-enqueue-input
                             (list (concat gdb-server-prefix "info source\n")
                                   `(lambda () (gdb-get-location
-                                               ,bptno ,line ,flag)))))))
-                   (if (re-search-forward
-                        "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
-                        el t)
+                                               ,bptno ,line ,flag))))))
+                     (if (re-search-forward
+                          "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
+                          el t)
+                         (add-text-properties
+                          (match-beginning 1) (match-end 1)
+                          '(face font-lock-function-name-face))
+                       (end-of-line)
+                       (re-search-backward "\\s-\\(\\S-*\\)"
+                                           bl t)
                        (add-text-properties
                         (match-beginning 1) (match-end 1)
-                        '(face font-lock-function-name-face))
-                     (end-of-line)
-                     (re-search-backward "\\s-\\(\\S-*\\)"
-                                         bl t)
-                     (add-text-properties
-                      (match-beginning 1) (match-end 1)
-                      '(face font-lock-variable-name-face)))))))
-         (end-of-line))))))
+                        '(face font-lock-variable-name-face)))))))
+           (end-of-line))))))
   (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))
 
   ;; Breakpoints buffer is always present.  Hack to just update
@@ -2157,6 +2161,7 @@ corresponding to the mode line clicked."
   (setq mode-name "Breakpoints")
   (use-local-map gdb-breakpoints-mode-map)
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (setq header-line-format gdb-breakpoints-header)
   (run-mode-hooks 'gdb-breakpoints-mode-hook)
   (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
@@ -2198,7 +2203,7 @@ corresponding to the mode line clicked."
   (if event (posn-set-point (event-end event)))
   (save-excursion
     (beginning-of-line 1)
-    (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
+    (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .*\\s-+\\(\\S-+\\):\\([0-9]+\\)$")
        (let ((bptno (match-string 1))
              (file  (match-string 2))
              (line  (match-string 3)))
@@ -2215,7 +2220,7 @@ corresponding to the mode line clicked."
       (error "No location specified."))))
 \f
 
-;; Frames buffer.  This displays a perpetually correct bactracktrace
+;; Frames buffer.  This displays a perpetually correct backtrace
 ;; (from the command `where').
 ;;
 ;; Alas, if your stack is deep, it is costly.
@@ -2256,20 +2261,20 @@ corresponding to the mode line clicked."
                    el (line-end-position))
              (when (looking-at "#")
                (add-text-properties bl el
-                                    '(mouse-face highlight
-                                                 help-echo "mouse-2, RET: Select frame")))
+                   '(mouse-face highlight
+                                help-echo "mouse-2, RET: Select frame")))
              (goto-char bl)
              (when (looking-at "^#\\([0-9]+\\)")
                (when (string-equal (match-string 1) gdb-frame-number)
-                 (if (> (car (window-fringes)) 0)
+                 (if (gud-tool-bar-item-visible-no-fringe)
                      (progn
-                       (or gdb-stack-position
-                           (setq gdb-stack-position (make-marker)))
-                       (set-marker gdb-stack-position (point))
-                       (setq move-to gdb-stack-position))
-                   (put-text-property bl (+ bl 4)
-                                      'face '(:inverse-video t))
-                   (setq move-to bl)))
+                       (put-text-property bl (+ bl 4)
+                                          'face '(:inverse-video t))
+                       (setq move-to bl))
+                   (or gdb-stack-position
+                       (setq gdb-stack-position (make-marker)))
+                   (set-marker gdb-stack-position (point))
+                   (setq move-to gdb-stack-position)))
                (when (re-search-forward "\\([^ ]+\\) (" el t)
                  (put-text-property (match-beginning 1) (match-end 1)
                                     'face font-lock-function-name-face)
@@ -2284,11 +2289,13 @@ corresponding to the mode line clicked."
              (forward-line 1))
            (forward-line -1)
            (when (looking-at "(More stack frames follow...)")
-             (add-text-properties (match-beginning 0) (match-end 0)
-                                  '(mouse-face highlight
-                                               gdb-max-frames t
-                                               help-echo
-                                               "mouse-2, RET: customize gdb-max-frames to see more frames")))))
+             (add-text-properties
+              (match-beginning 0) (match-end 0)
+              '(mouse-face highlight
+                gdb-max-frames t
+                help-echo
+                  "mouse-2, RET: customize gdb-max-frames to see more frames"
+                )))))
        (when gdb-look-up-stack
          (goto-char (point-min))
          (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t)
@@ -2369,6 +2376,7 @@ $pc directly from the GUD buffer.  This command isn't normally needed."
   (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
   (setq truncate-lines t)  ;; Make it easier to see overlay arrow.
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (gdb-thread-identification)
   (use-local-map gdb-frames-mode-map)
   (run-mode-hooks 'gdb-frames-mode-hook)
@@ -2469,6 +2477,7 @@ another GDB command e.g pwd, to see new frames")
   (setq major-mode 'gdb-threads-mode)
   (setq mode-name "Threads")
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (setq header-line-format gdb-breakpoints-header)
   (use-local-map gdb-threads-mode-map)
   (set (make-local-variable 'font-lock-defaults)
@@ -2553,6 +2562,37 @@ another GDB command e.g pwd, to see new frames")
     (define-key map "q" 'kill-this-buffer)
      map))
 
+(defvar gdb-locals-header
+ `(,(propertize "Locals"
+               'help-echo "mouse-1: select"
+               'mouse-face 'mode-line-highlight
+               'face 'mode-line
+               'local-map
+               (gdb-make-header-line-mouse-map
+                'mouse-1
+                (lambda (event) (interactive "e")
+                  (save-selected-window
+                    (select-window (posn-window (event-start event)))
+                    (set-window-dedicated-p (selected-window) nil)
+                    (switch-to-buffer
+                     (gdb-get-buffer-create 'gdb-locals-buffer))
+                    (set-window-dedicated-p (selected-window) t)))))
+   " "
+   ,(propertize "Registers"
+               'help-echo "mouse-1: select"
+               'mouse-face 'mode-line-highlight
+               'face 'mode-line
+               'local-map
+               (gdb-make-header-line-mouse-map
+                'mouse-1
+                (lambda (event) (interactive "e")
+                  (save-selected-window
+                    (select-window (posn-window (event-start event)))
+                    (set-window-dedicated-p (selected-window) nil)
+                    (switch-to-buffer
+                     (gdb-get-buffer-create 'gdb-registers-buffer))
+                    (set-window-dedicated-p (selected-window) t)))))))
+
 (defun gdb-registers-mode ()
   "Major mode for gdb registers.
 
@@ -2560,7 +2600,9 @@ another GDB command e.g pwd, to see new frames")
   (kill-all-local-variables)
   (setq major-mode 'gdb-registers-mode)
   (setq mode-name "Registers")
+  (setq header-line-format gdb-locals-header)
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (gdb-thread-identification)
   (use-local-map gdb-registers-mode-map)
   (run-mode-hooks 'gdb-registers-mode-hook)
@@ -2816,6 +2858,7 @@ another GDB command e.g pwd, to see new frames")
   (setq major-mode 'gdb-memory-mode)
   (setq mode-name "Memory")
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (use-local-map gdb-memory-mode-map)
   (setq header-line-format
        '(:eval
@@ -2949,13 +2992,14 @@ another GDB command e.g pwd, to see new frames")
   (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
     (with-current-buffer buf
       (goto-char (point-min))
+      ;; Need this in case "set print pretty" is on.
       (while (re-search-forward "^[ }].*\n" nil t)
        (replace-match "" nil nil))
       (goto-char (point-min))
       (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
        (replace-match gdb-struct-string nil nil))
       (goto-char (point-min))
-      (while (re-search-forward "\\s-*{.*\n" nil t)
+      (while (re-search-forward "\\s-*{[^.].*\n" nil t)
        (replace-match gdb-array-string nil nil))))
   (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
     (and buf
@@ -2968,8 +3012,7 @@ another GDB command e.g pwd, to see new frames")
                 (insert-buffer-substring (gdb-get-buffer-create
                                           'gdb-partial-output-buffer))
                (set-window-start window start)
-               (set-window-point window p))
-)))
+               (set-window-point window p)))))
   (run-hooks 'gdb-info-locals-hook))
 
 (defvar gdb-locals-mode-map
@@ -2985,9 +3028,11 @@ another GDB command e.g pwd, to see new frames")
   (kill-all-local-variables)
   (setq major-mode 'gdb-locals-mode)
   (setq mode-name (concat "Locals:" gdb-selected-frame))
+  (use-local-map gdb-locals-mode-map)
   (setq buffer-read-only t)
+  (buffer-disable-undo)
+  (setq header-line-format gdb-locals-header)
   (gdb-thread-identification)
-  (use-local-map gdb-locals-mode-map)
   (set (make-local-variable 'font-lock-defaults)
        '(gdb-locals-font-lock-keywords))
   (run-mode-hooks 'gdb-locals-mode-hook)
@@ -3015,28 +3060,16 @@ another GDB command e.g pwd, to see new frames")
 \f
 
 ;;;; Window management
-(defun gdb-display-buffer (buf dedicated &optional size)
-  (let ((answer (get-buffer-window buf 0))
-       (must-split nil))
+(defun gdb-display-buffer (buf dedicated &optional frame)
+  (let ((answer (get-buffer-window buf (or frame 0))))
     (if answer
-       (display-buffer buf nil 0)      ;Deiconify the frame if necessary.
-      ;; The buffer is not yet displayed.
-      (pop-to-buffer gud-comint-buffer)        ;Select the right frame.
+       (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
       (let ((window (get-lru-window)))
-       (if (and window
-                (not (memq window `(,(get-buffer-window gud-comint-buffer)
-                                    ,gdb-source-window))))
-           (progn
-             (set-window-buffer window buf)
-             (setq answer window))
-         (setq must-split t)))
-      (if must-split
-         (let* ((largest (get-largest-window))
-                (cur-size (window-height largest))
-                (new-size (and size (< size cur-size) (- cur-size size))))
-           (setq answer (split-window largest new-size))
-           (set-window-buffer answer buf)
-           (set-window-dedicated-p answer dedicated)))
+       (let* ((largest (get-largest-window))
+              (cur-size (window-height largest)))
+         (setq answer (split-window largest))
+         (set-window-buffer answer buf)
+         (set-window-dedicated-p answer dedicated)))
       answer)))
 
 \f
@@ -3118,7 +3151,7 @@ another GDB command e.g pwd, to see new frames")
   "Display GUD buffer."
   (interactive)
   (let ((same-window-regexps nil))
-    (pop-to-buffer gud-comint-buffer)))
+    (select-window (display-buffer gud-comint-buffer nil 0))))
 
 (defun gdb-set-window-buffer (name)
   (set-window-buffer (selected-window) (get-buffer name))
@@ -3239,9 +3272,7 @@ 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 0))
-      (save-current-buffer
-       (set (make-local-variable 'gud-minor-mode) 'gdba)
-       (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
+      (gdb-init-buffer)
       ;; only want one breakpoint icon at each location
       (save-excursion
        (goto-line (string-to-number line))
@@ -3263,9 +3294,7 @@ of the current session."
                    buffer-file-name)
                  gdb-source-file-list)
          (with-current-buffer (find-buffer-visiting buffer-file-name)
-           (set (make-local-variable 'gud-minor-mode)
-                (buffer-local-value 'gud-minor-mode gud-comint-buffer))
-           (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))
+           (gdb-init-buffer)))))
 
 ;;from put-image
 (defun gdb-put-string (putstring pos &optional dprop &rest sprops)
@@ -3437,7 +3466,7 @@ BUFFER nil or omitted means use the current buffer."
          (with-current-buffer buffer
            (save-excursion
              (goto-char (point-min))
-             (if (search-forward address nil t)
+             (if (re-search-forward (concat "^0x0*" address) nil t)
                  (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
     (if (not (equal gdb-pc-address "main"))
        (with-current-buffer buffer
@@ -3475,6 +3504,7 @@ BUFFER nil or omitted means use the current buffer."
   (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
   (setq fringes-outside-margins t)
   (setq buffer-read-only t)
+  (buffer-disable-undo)
   (gdb-thread-identification)
   (use-local-map gdb-assembler-mode-map)
   (gdb-invalidate-assembler)
@@ -3511,8 +3541,9 @@ BUFFER nil or omitted means use the current buffer."
                     (string-equal gdb-selected-frame gdb-previous-frame))
          (if (or (not (member 'gdb-invalidate-assembler
                               gdb-pending-triggers))
-                 (not (string-equal gdb-pc-address
-                                    gdb-previous-frame-address)))
+                 (not (equal (string-to-number gdb-pc-address)
+                             (string-to-number
+                              gdb-previous-frame-pc-address))))
          (progn
            ;; take previous disassemble command, if any, off the queue
            (with-current-buffer gud-comint-buffer
@@ -3523,21 +3554,23 @@ BUFFER nil or omitted means use the current buffer."
                            (delete item gdb-input-queue))))))
            (gdb-enqueue-input
             (list
-             (concat gdb-server-prefix "disassemble "
-                     (if (member gdb-pc-address '(nil "main")) nil "0x")
-                          gdb-pc-address "\n")
+             (concat gdb-server-prefix "disassemble " gdb-pc-address "\n")
                   'gdb-assembler-handler))
            (push 'gdb-invalidate-assembler gdb-pending-triggers)
-           (setq gdb-previous-frame-address gdb-pc-address)
+           (setq gdb-previous-frame-pc-address gdb-pc-address)
            (setq gdb-previous-frame gdb-selected-frame)))))))
 
 (defun gdb-get-selected-frame ()
   (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
       (progn
-       (gdb-enqueue-input
-        (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler))
-       (push 'gdb-get-selected-frame
-              gdb-pending-triggers))))
+       (if (string-equal gdb-version "pre-6.4")
+           (gdb-enqueue-input
+            (list (concat gdb-server-prefix "info frame\n")
+                  'gdb-frame-handler))
+         (gdb-enqueue-input
+           (list "server interpreter mi -stack-info-frame\n"
+                 'gdb-frame-handler-1)))
+       (push 'gdb-get-selected-frame gdb-pending-triggers))))
 
 (defun gdb-frame-handler ()
   (setq gdb-pending-triggers
@@ -3548,7 +3581,7 @@ BUFFER nil or omitted means use the current buffer."
     (setq gdb-frame-number (match-string 1))
     (setq gdb-frame-address (match-string 2)))
   (goto-char (point-min))
-  (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\
+  (when (re-search-forward ".*=\\s-+\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\
 \\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; "
      nil t)
     (setq gdb-selected-frame (match-string 2))
@@ -3591,16 +3624,45 @@ is set in them."
   (dolist (buffer (buffer-list))
     (with-current-buffer buffer
       (when (member buffer-file-name gdb-source-file-list)
-       (set (make-local-variable 'gud-minor-mode)
-            (buffer-local-value 'gud-minor-mode gud-comint-buffer))
-       (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
-       (when gud-tooltip-mode
-         (make-local-variable 'gdb-define-alist)
-         (gdb-create-define-alist)
-         (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))
+       (gdb-init-buffer))))
   (gdb-force-mode-line-update
    (propertize "ready" 'face font-lock-variable-name-face)))
 
+;; Used for -stack-info-frame but could be used for -stack-list-frames too.
+(defconst gdb-stack-list-frames-regexp
+".*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
+\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
+from=\"\\(.*?\\)\"\\)")
+
+(defun gdb-frame-handler-1 ()
+  (setq gdb-pending-triggers
+       (delq 'gdb-get-selected-frame gdb-pending-triggers))
+  (goto-char (point-min))
+    (when (re-search-forward gdb-stack-list-frames-regexp nil t)
+      (setq gdb-frame-number (match-string 1))
+      (setq gdb-pc-address (match-string 2))
+      (setq gdb-selected-frame (match-string 3))
+      (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)))))
+    (if (and (match-string 4) (match-string 5) gud-overlay-arrow-position)
+       (let ((buffer (marker-buffer gud-overlay-arrow-position))
+             (position (marker-position gud-overlay-arrow-position)))
+         (when (and buffer
+                    (string-equal (file-name-nondirectory
+                                   (buffer-file-name buffer))
+                                  (file-name-nondirectory (match-string 4))))
+           (with-current-buffer buffer
+             (setq fringe-indicator-alist
+                   (if (string-equal gdb-frame-number "0")
+                       nil
+                     '((overlay-arrow . hollow-right-triangle))))
+             (set-marker gud-overlay-arrow-position position)))))
+  (gdb-invalidate-assembler))
+
 ; Uses "-var-list-children --all-values".  Needs GDB 6.4 onwards.
 (defun gdb-var-list-children-1 (varnum)
   (gdb-enqueue-input