[Emacs-diffs] Changes to emacs/lisp/gdb-ui.el

[Nick Roberts]

Index: emacs/lisp/gdb-ui.el
diff -c emacs/lisp/gdb-ui.el:1.28 emacs/lisp/gdb-ui.el:1.29
*** emacs/lisp/gdb-ui.el:1.28   Mon May 12 19:47:31 2003
--- emacs/lisp/gdb-ui.el        Sat May 17 06:17:57 2003
***************
*** 58,65 ****
    :type 'integer
    :group 'gud)
  
! (defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
! (defvar gdb-current-address nil)
  (defvar gdb-display-in-progress nil)
  (defvar gdb-dive nil)
  (defvar gdb-buffer-type nil)
--- 58,65 ----
    :type 'integer
    :group 'gud)
  
! (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,153 ****
                          (gud-call "clear *%a" arg)))
           "\C-d" "Remove breakpoint at 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-display-in-progress nil)
    (setq gdb-dive nil)
    ;;
--- 143,161 ----
                          (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-current-address "main")
!   (setq gdb-previous-address nil)
    (setq gdb-display-in-progress nil)
    (setq gdb-dive nil)
    ;;
***************
*** 508,516 ****
    :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)
      ("prompt" gdb-prompt)
      ("commands" gdb-subprompt)
      ("overload-choice" gdb-subprompt)
--- 516,522 ----
    :group 'gud)
  
  (defvar gdb-annotation-rules
!   '(("pre-prompt" gdb-pre-prompt)
      ("prompt" gdb-prompt)
      ("commands" gdb-subprompt)
      ("overload-choice" gdb-subprompt)
***************
*** 524,530 ****
      ("signal" gdb-stopping)
      ("breakpoint" gdb-stopping)
      ("watchpoint" gdb-stopping)
! ;    ("frame-begin" gdb-frame-begin)
      ("stopped" gdb-stopped)
      ("display-begin" gdb-display-begin)
      ("display-end" gdb-display-end)
--- 530,536 ----
      ("signal" gdb-stopping)
      ("breakpoint" gdb-stopping)
      ("watchpoint" gdb-stopping)
!     ("frame-begin" gdb-frame-begin)
      ("stopped" gdb-stopped)
      ("display-begin" gdb-display-begin)
      ("display-end" gdb-display-end)
***************
*** 555,561 ****
         (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))
  
--- 561,566 ----
***************
*** 663,671 ****
    (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-threads)))
    (let ((sink (gdb-get-output-sink)))
      (cond
--- 668,679 ----
    (if (not (gdb-get-pending-triggers))
        (progn
        (gdb-get-current-frame)
!       (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,1167 ****
      (goto-char (point-max))
      (insert-before-markers string))
    (if (not (string-equal string ""))
!       (gdb-display-buffer
!        (gdb-get-create-buffer 'gdb-inferior-io))))
  
  (defun gdb-clear-inferior-io ()
    (save-excursion
--- 1168,1175 ----
      (goto-char (point-max))
      (insert-before-markers string))
    (if (not (string-equal string ""))
!       (select-window 
!       (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))
  
  (defun gdb-clear-inferior-io ()
    (save-excursion
***************
*** 1351,1358 ****
          (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)))
                (beginning-of-line)
                (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
                    (progn
--- 1359,1366 ----
          (forward-line 1)
          (if (looking-at "[^\t].*breakpoint")
              (progn
!               (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,1524 ****
  (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)))))
  
  (defun gdb-stack-buffer-name ()
    (with-current-buffer gud-comint-buffer
--- 1520,1542 ----
  (defun gdb-info-frames-custom ()
    (save-excursion
      (set-buffer (gdb-get-buffer 'gdb-stack-buffer))
!     (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,1554 ****
--- 1567,1573 ----
    (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,2242 ****
  
  (def-gdb-auto-updated-buffer gdb-assembler-buffer
    gdb-invalidate-assembler
!   (concat "server disassemble " gdb-main-or-pc "\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.
      (save-excursion
        (set-buffer buffer)
!       (if (display-graphic-p)
!         (remove-images (point-min) (point-max))
!       (remove-strings (point-min) (point-max))))
!     (save-excursion
        (set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer))
        (goto-char (point-min))
        (while (< (point) (- (point-max) 1))
--- 2233,2260 ----
  
  (def-gdb-auto-updated-buffer gdb-assembler-buffer
    gdb-invalidate-assembler
!   (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))
!       (address) (flag))
      (save-excursion
        (set-buffer buffer)
!       (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,2276 ****
        (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)))
              (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))))
  
  (defvar gdb-assembler-mode-map
    (let ((map (make-sparse-keymap)))
--- 2262,2296 ----
        (if (looking-at "[^\t].*breakpoint")
            (progn
              (looking-at
!              "[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)
!               (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,2342 ****
    (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
  ;; 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))))
        (progn
        ;; take previous disassemble command off the queue
        (save-excursion
          (set-buffer gud-comint-buffer)
!         (let ((queue gdb-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-enqueue-idle-input
!        (list (concat "server disassemble " gdb-main-or-pc "\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))))
  
  (defun gdb-get-current-frame ()
    (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
--- 2323,2351 ----
    (switch-to-buffer-other-frame
     (gdb-get-create-buffer 'gdb-assembler-buffer)))
  
! ;; 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-current-address gdb-previous-address))))
        (progn
        ;; take previous disassemble command off the queue
        (save-excursion
          (set-buffer gud-comint-buffer)
!         (let ((queue (gdb-get-idle-input-queue)) (item))
            (dolist (item queue)
              (if (equal (cdr item) '(gdb-assembler-handler))
!                 (gdb-set-idle-input-queue 
!                  (delete item (gdb-get-idle-input-queue)))))))
        (gdb-enqueue-idle-input
!        (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-previous-address gdb-current-address))))
  
  (defun gdb-get-current-frame ()
    (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
***************
*** 2353,2360 ****
    (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-*\\)")
          (setq gdb-current-frame (match-string 1))))))
  
--- 2362,2380 ----
    (save-excursion
      (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer))
      (goto-char (point-min))
!     (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))))))