emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/progmodes/gdb-ui.el [lexbind]
Date: Tue, 06 Jul 2004 06:01:55 -0400

Index: emacs/lisp/progmodes/gdb-ui.el
diff -c emacs/lisp/progmodes/gdb-ui.el:1.4.2.7 
emacs/lisp/progmodes/gdb-ui.el:1.4.2.8
*** emacs/lisp/progmodes/gdb-ui.el:1.4.2.7      Tue Jul  6 09:23:47 2004
--- emacs/lisp/progmodes/gdb-ui.el      Tue Jul  6 09:31:24 2004
***************
*** 40,47 ****
  ;; Kingdon and uses GDB's annotation interface. You don't need to know about
  ;; annotations to use this mode as a debugger, but if you are interested
  ;; developing the mode itself, then see the Annotations section in the GDB
! ;; info manual. Some GDB/MI commands are also used through th CLI command
! ;; 'interpreter mi <mi-command>'.
  ;;
  ;; Known Bugs:
  ;;
--- 40,54 ----
  ;; Kingdon and uses GDB's annotation interface. You don't need to know about
  ;; annotations to use this mode as a debugger, but if you are interested
  ;; developing the mode itself, then see the Annotations section in the GDB
! ;; info manual. 
! ;;
! ;; GDB developers plan to make the annotation interface obsolete. A new
! ;; interface called GDB/MI (machine interface) has been designed to replace
! ;; it. Some GDB/MI commands are used in this file through the CLI command
! ;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
! ;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
! ;; primary interface to GDB. It is still under development and is part of a
! ;; process to migrate Emacs from annotations to GDB/MI.
  ;;
  ;; Known Bugs:
  ;;
***************
*** 53,59 ****
  (defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
  (defvar gdb-previous-address nil)
  (defvar gdb-previous-frame nil)
! (defvar gdb-current-frame "main")
  (defvar gdb-current-language nil)
  (defvar gdb-view-source t "Non-nil means that source code can be viewed.")
  (defvar gdb-selected-view 'source "Code type that user wishes to view.")
--- 60,66 ----
  (defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
  (defvar gdb-previous-address nil)
  (defvar gdb-previous-frame nil)
! (defvar gdb-current-frame nil)
  (defvar gdb-current-language nil)
  (defvar gdb-view-source t "Non-nil means that source code can be viewed.")
  (defvar gdb-selected-view 'source "Code type that user wishes to view.")
***************
*** 63,69 ****
  (defvar gdb-overlay-arrow-position nil)
  (defvar gdb-variables '()
    "A list of variables that are local to the GUD buffer.")
! 
  ;;;###autoload
  (defun gdba (command-line)
    "Run gdb on program FILE in buffer *gud-FILE*.
--- 70,77 ----
  (defvar gdb-overlay-arrow-position nil)
  (defvar gdb-variables '()
    "A list of variables that are local to the GUD buffer.")
! (defvar gdb-server-prefix nil)
!  
  ;;;###autoload
  (defun gdba (command-line)
    "Run gdb on program FILE in buffer *gud-FILE*.
***************
*** 73,79 ****
  If `gdb-many-windows' is nil (the default value) then gdb just
  pops up the GUD buffer unless `gdb-show-main' is t. In this case
  it starts with two windows: one displaying the GUD buffer and the
! other with the source file with the main routine of the debugee.
  
  If `gdb-many-windows' is t, regardless of the value of
  `gdb-show-main', the layout below will appear unless
--- 81,87 ----
  If `gdb-many-windows' is nil (the default value) then gdb just
  pops up the GUD buffer unless `gdb-show-main' is t. In this case
  it starts with two windows: one displaying the GUD buffer and the
! other with the source file with the main routine of the inferior.
  
  If `gdb-many-windows' is t, regardless of the value of
  `gdb-show-main', the layout below will appear unless
***************
*** 100,106 ****
                                    |
                                    |
  ---------------------------------------------------------------------
!  Source buffer                    | Input/Output (of debugee) buffer
                                    | (comint-mode)
                                    |
                                    |
--- 108,114 ----
                                    |
                                    |
  ---------------------------------------------------------------------
!  Source buffer                    | Input/Output (of inferior) buffer
                                    | (comint-mode)
                                    |
                                    |
***************
*** 174,185 ****
    (setq gdb-current-address "main")
    (setq gdb-previous-address nil)
    (setq gdb-previous-frame nil)
!   (setq gdb-current-frame "main")
    (setq gdb-view-source t)
    (setq gdb-selected-view 'source)
    (setq gdb-var-list nil)
    (setq gdb-var-changed nil)
    (setq gdb-first-prompt nil)
    ;;
    (mapc 'make-local-variable gdb-variables)
    (setq gdb-buffer-type 'gdba)
--- 182,198 ----
    (setq gdb-current-address "main")
    (setq gdb-previous-address nil)
    (setq gdb-previous-frame nil)
!   (setq gdb-current-frame nil)
    (setq gdb-view-source t)
    (setq gdb-selected-view 'source)
    (setq gdb-var-list nil)
    (setq gdb-var-changed nil)
    (setq gdb-first-prompt nil)
+   (setq gdb-prompting nil)
+   (setq gdb-current-item nil)
+   (setq gdb-pending-triggers nil)
+   (setq gdb-output-sink 'user)
+   (setq gdb-server-prefix "server ")
    ;;
    (mapc 'make-local-variable gdb-variables)
    (setq gdb-buffer-type 'gdba)
***************
*** 208,221 ****
    (require 'tooltip)
    (let ((expr (tooltip-identifier-from-point (point))))
      (if (and (string-equal gdb-current-language "c")
!            gdb-use-colon-colon-notation)
        (setq expr (concat gdb-current-frame "::" expr)))
      (catch 'already-watched
        (dolist (var gdb-var-list)
        (if (string-equal expr (car var)) (throw 'already-watched nil)))
        (set-text-properties 0 (length expr) nil expr)
        (gdb-enqueue-input
!        (list (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
             `(lambda () (gdb-var-create-handler ,expr))))))
    (select-window (get-buffer-window gud-comint-buffer 'visible)))
  
--- 221,237 ----
    (require 'tooltip)
    (let ((expr (tooltip-identifier-from-point (point))))
      (if (and (string-equal gdb-current-language "c")
!            gdb-use-colon-colon-notation gdb-current-frame)
        (setq expr (concat gdb-current-frame "::" expr)))
      (catch 'already-watched
        (dolist (var gdb-var-list)
        (if (string-equal expr (car var)) (throw 'already-watched nil)))
        (set-text-properties 0 (length expr) nil expr)
        (gdb-enqueue-input
!        (list 
!       (if (eq gud-minor-mode 'gdba)
!           (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
!         (concat"-var-create - * "  expr "\n"))
             `(lambda () (gdb-var-create-handler ,expr))))))
    (select-window (get-buffer-window gud-comint-buffer 'visible)))
  
***************
*** 308,319 ****
         (setq gdb-var-list (nreverse var-list))))))
  
  (defun gdb-var-update ()
!   (if (not (member 'gdb-var-update (gdb-get-pending-triggers)))
        (progn
!       (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
                                 'gdb-var-update-handler))
!       (gdb-set-pending-triggers (cons 'gdb-var-update
!                                       (gdb-get-pending-triggers))))))
  
  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
  
--- 324,338 ----
         (setq gdb-var-list (nreverse var-list))))))
  
  (defun gdb-var-update ()
!   (if (not (member 'gdb-var-update gdb-pending-triggers))
        (progn
!       (gdb-enqueue-input
!        (list 
!         (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
!             "server interpreter mi \"-var-update *\"\n"
!           "-var-update *\n")
                                 'gdb-var-update-handler))
!       (push 'gdb-var-update gdb-pending-triggers))))
  
  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
  
***************
*** 323,334 ****
      (while (re-search-forward gdb-var-update-regexp nil t)
        (let ((varnum (match-string 1)))
          (gdb-enqueue-input
!          (list (concat "server interpreter mi \"-var-evaluate-expression "
!                        varnum "\"\n")
                     `(lambda () (gdb-var-evaluate-expression-handler
                                  ,varnum t)))))))
!   (gdb-set-pending-triggers
!    (delq 'gdb-var-update (gdb-get-pending-triggers))))
  
  (defun gdb-var-delete ()
    "Delete watched expression from the speedbar."
--- 342,356 ----
      (while (re-search-forward gdb-var-update-regexp nil t)
        (let ((varnum (match-string 1)))
          (gdb-enqueue-input
!          (list
!           (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 
'gdba))
!               (concat "server interpreter mi \"-var-evaluate-expression "
!                       varnum "\"\n")
!             (concat "-var-evaluate-expression " varnum "\n"))
                     `(lambda () (gdb-var-evaluate-expression-handler
                                  ,varnum t)))))))
!   (setq gdb-pending-triggers
!    (delq 'gdb-var-update gdb-pending-triggers)))
  
  (defun gdb-var-delete ()
    "Delete watched expression from the speedbar."
***************
*** 341,348 ****
               (varnum (cadr var)))
          (unless (string-match "\\." varnum)
            (gdb-enqueue-input
!            (list (concat "server interpreter mi \"-var-delete "
!                          varnum "\"\n")
                   'ignore))
            (setq gdb-var-list (delq var gdb-var-list))
            (dolist (varchild gdb-var-list)
--- 363,373 ----
               (varnum (cadr var)))
          (unless (string-match "\\." varnum)
            (gdb-enqueue-input
!            (list 
!             (if (with-current-buffer gud-comint-buffer
!                   (eq gud-minor-mode 'gdba))
!                 (concat "server interpreter mi \"-var-delete " varnum "\"\n")
!               (concat "-var-delete " varnum "\n"))
                   'ignore))
            (setq gdb-var-list (delq var gdb-var-list))
            (dolist (varchild gdb-var-list)
***************
*** 356,363 ****
         (varnum (cadr var)) (value))
      (setq value (read-string "New value: "))
      (gdb-enqueue-input
!      (list (concat "server interpreter mi \"-var-assign "
!                  varnum " " value "\"\n")
           'ignore))))
  
  (defcustom gdb-show-changed-values t
--- 381,391 ----
         (varnum (cadr var)) (value))
      (setq value (read-string "New value: "))
      (gdb-enqueue-input
!      (list
!       (if (with-current-buffer gud-comint-buffer
!           (eq gud-minor-mode 'gdba))
!         (concat "server interpreter mi \"-var-assign " varnum " " value 
"\"\n")
!       (concat "-var-assign " varnum " " value "\n"))
           'ignore))))
  
  (defcustom gdb-show-changed-values t
***************
*** 372,420 ****
  TOKEN is data related to this node.
  INDENT is the current indentation depth."
    (cond ((string-match "+" text)        ;expand this node
!        (gdb-var-list-children token))
        ((string-match "-" text)        ;contract this node
         (dolist (var gdb-var-list)
           (if (string-match (concat token "\\.") (nth 1 var))
               (setq gdb-var-list (delq var gdb-var-list))))
         (setq gdb-var-changed t))))
- 
  
! ;; ======================================================================
! ;;
! ;; In this world, there are gdb variables (of unspecified
! ;; representation) and buffers associated with those objects.
! ;; The list of  variables is built up by the expansions of
! ;; def-gdb-variable
! 
! (defmacro def-gdb-var (root-symbol &optional default doc)
!   (let* ((root (symbol-name root-symbol))
!        (accessor (intern (concat "gdb-get-" root)))
!        (setter (intern (concat "gdb-set-" root)))
!        (name (intern (concat "gdb-" root))))
!     `(progn
!        (defvar ,name ,default ,doc)
!        (if (not (memq ',name gdb-variables))
!          (push ',name gdb-variables))
!        (defun ,accessor ()
!        (buffer-local-value ',name gud-comint-buffer))
!        (defun ,setter (val)
!        (with-current-buffer gud-comint-buffer
!          (setq ,name val))))))
! 
! (def-gdb-var buffer-type nil
    "One of the symbols bound in `gdb-buffer-rules'.")
  
! (def-gdb-var burst ""
!   "A string of characters from gdb that have not yet been processed.")
! 
! (def-gdb-var input-queue ()
    "A list of gdb command objects.")
  
! (def-gdb-var prompting nil
    "True when gdb is idle with no pending input.")
  
! (def-gdb-var output-sink 'user
    "The disposition of the output of the current gdb command.
  Possible values are these symbols:
  
--- 400,424 ----
  TOKEN is data related to this node.
  INDENT is the current indentation depth."
    (cond ((string-match "+" text)        ;expand this node
!        (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
!            (gdb-var-list-children token)
!          (gdbmi-var-list-children token)))
        ((string-match "-" text)        ;contract this node
         (dolist (var gdb-var-list)
           (if (string-match (concat token "\\.") (nth 1 var))
               (setq gdb-var-list (delq var gdb-var-list))))
         (setq gdb-var-changed t))))
  
! (defvar gdb-buffer-type nil
    "One of the symbols bound in `gdb-buffer-rules'.")
  
! (defvar gdb-input-queue ()
    "A list of gdb command objects.")
  
! (defvar gdb-prompting nil
    "True when gdb is idle with no pending input.")
  
! (defvar gdb-output-sink 'user
    "The disposition of the output of the current gdb command.
  Possible values are these symbols:
  
***************
*** 432,443 ****
             gdb mode sends to gdb on its own behalf.
      post-emacs -- ignore output until the prompt annotation is
                  received, then go to USER disposition.
- ")
  
! (def-gdb-var current-item nil
    "The most recent command item sent to gdb.")
  
! (def-gdb-var pending-triggers '()
    "A list of trigger functions that have run later than their output
  handlers.")
  
--- 436,449 ----
             gdb mode sends to gdb on its own behalf.
      post-emacs -- ignore output until the prompt annotation is
                  received, then go to USER disposition.
  
! gdba (gdb-ui.el) uses all five values,  gdbmi (gdb-mi.el) only two
! (user and emacs).")
! 
! (defvar gdb-current-item nil
    "The most recent command item sent to gdb.")
  
! (defvar gdb-pending-triggers '()
    "A list of trigger functions that have run later than their output
  handlers.")
  
***************
*** 481,488 ****
          (set (make-local-variable 'gdb-buffer-type) key)
          (if (cdr (cdr rules))
              (funcall (car (cdr (cdr rules)))))
!         (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer)
!         (set (make-local-variable 'gud-minor-mode) 'gdba)
          (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
          new))))
  
--- 487,494 ----
          (set (make-local-variable 'gdb-buffer-type) key)
          (if (cdr (cdr rules))
              (funcall (car (cdr (cdr rules)))))
!         (set (make-local-variable 'gud-minor-mode) 
!              (with-current-buffer gud-comint-buffer gud-minor-mode))
          (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
          new))))
  
***************
*** 550,556 ****
      (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
      map))
  
! (define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O"
    "Major mode for gdb inferior-io."
    :syntax-table nil :abbrev-table nil
    ;; We want to use comint because it has various nifty and familiar
--- 556,562 ----
      (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
      map))
  
! (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
    "Major mode for gdb inferior-io."
    :syntax-table nil :abbrev-table nil
    ;; We want to use comint because it has various nifty and familiar
***************
*** 622,641 ****
  ;; is a query, or other non-top-level prompt.
  
  (defun gdb-enqueue-input (item)
!   (if (gdb-get-prompting)
        (progn
        (gdb-send-item item)
!       (gdb-set-prompting nil))
!     (gdb-set-input-queue
!      (cons item (gdb-get-input-queue)))))
  
  (defun gdb-dequeue-input ()
!   (let ((queue (gdb-get-input-queue)))
      (and queue
         (let ((last (car (last queue))))
!          (unless (nbutlast queue) (gdb-set-input-queue '()))
           last))))
- 
  
  ;;
  ;; output -- things gdb prints to emacs
--- 628,645 ----
  ;; is a query, or other non-top-level prompt.
  
  (defun gdb-enqueue-input (item)
!   (if gdb-prompting
        (progn
        (gdb-send-item item)
!       (setq gdb-prompting nil))
!     (push item gdb-input-queue)))
  
  (defun gdb-dequeue-input ()
!   (let ((queue gdb-input-queue))
      (and queue
         (let ((last (car (last queue))))
!          (unless (nbutlast queue) (setq gdb-input-queue '()))
           last))))
  
  ;;
  ;; output -- things gdb prints to emacs
***************
*** 664,669 ****
--- 668,674 ----
      ("commands" gdb-subprompt)
      ("overload-choice" gdb-subprompt)
      ("query" gdb-subprompt)
+     ;; Need this prompt for GDB 6.1
      ("nquery" gdb-subprompt)
      ("prompt-for-continue" gdb-subprompt)
      ("post-prompt" gdb-post-prompt)
***************
*** 693,779 ****
    (setq gdb-view-source t)
    ;; cover for auto-display output which comes *before*
    ;; stopped annotation
!   (if (eq (gdb-get-output-sink) 'inferior) (gdb-set-output-sink 'user)))
  
  (defun gdb-send-item (item)
    (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
!   (gdb-set-current-item item)
!   (if (stringp item)
!       (progn
!       (gdb-set-output-sink 'user)
!       (process-send-string (get-buffer-process gud-comint-buffer) item))
!     (progn
        (gdb-clear-partial-output)
!       (gdb-set-output-sink 'pre-emacs)
        (process-send-string (get-buffer-process gud-comint-buffer)
!                          (car item)))))
  
  (defun gdb-pre-prompt (ignored)
    "An annotation handler for `pre-prompt'. This terminates the collection of
  output from a previous command if that happens to be in effect."
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'emacs)
!       (gdb-set-output-sink 'post-emacs))
       (t
!       (gdb-set-output-sink 'user)
        (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
  
  (defun gdb-prompt (ignored)
    "An annotation handler for `prompt'.
  This sends the next command (if any) to gdb."
    (when gdb-first-prompt (gdb-ann3))
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'post-emacs)
!       (gdb-set-output-sink 'user)
        (let ((handler
!            (car (cdr (gdb-get-current-item)))))
        (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
          (funcall handler))))
       (t
!       (gdb-set-output-sink 'user)
        (error "Phase error in gdb-prompt (got %s)" sink))))
    (let ((input (gdb-dequeue-input)))
      (if input
        (gdb-send-item input)
        (progn
!       (gdb-set-prompting t)
        (gud-display-frame)))))
  
  (defun gdb-subprompt (ignored)
    "An annotation handler for non-top-level prompts."
!   (gdb-set-prompting t))
  
  (defun gdb-starting (ignored)
    "An annotation handler for `starting'.  This says that I/O for the
  subprocess is now the program being debugged, not GDB."
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'user)
        (progn
        (setq gud-running t)
        (if gdb-use-inferior-io-buffer
!           (gdb-set-output-sink 'inferior))))
       (t (error "Unexpected `starting' annotation")))))
  
  (defun gdb-stopping (ignored)
    "An annotation handler for `exited' and other annotations which say that I/O
  for the subprocess is now GDB, not the program being debugged."
    (if gdb-use-inferior-io-buffer
!       (let ((sink (gdb-get-output-sink)))
        (cond
         ((eq sink 'inferior)
!         (gdb-set-output-sink 'user))
         (t (error "Unexpected stopping annotation"))))))
  
  (defun gdb-frame-begin (ignored)
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'inferior)
!       (gdb-set-output-sink 'user))
       ((eq sink 'user) t)
       ((eq sink 'emacs) t)
       (t (error "Unexpected frame-begin annotation (%S)" sink)))))
--- 698,792 ----
    (setq gdb-view-source t)
    ;; cover for auto-display output which comes *before*
    ;; stopped annotation
!   (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
  
  (defun gdb-send-item (item)
    (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
!   (setq gdb-current-item item)
!   (with-current-buffer gud-comint-buffer
!     (if (eq gud-minor-mode 'gdba)
!       (progn
!         (if (stringp item)
!             (progn
!               (setq gdb-output-sink 'user)
!               (process-send-string (get-buffer-process gud-comint-buffer) 
item))
!           (progn
!             (gdb-clear-partial-output)
!             (setq gdb-output-sink 'pre-emacs)
!             (process-send-string (get-buffer-process gud-comint-buffer)
!                                  (car item)))))
!       ; case: eq gud-minor-mode 'gdbmi
        (gdb-clear-partial-output)
!       (setq gdb-output-sink 'emacs)
        (process-send-string (get-buffer-process gud-comint-buffer)
!                        (car item)))))
  
  (defun gdb-pre-prompt (ignored)
    "An annotation handler for `pre-prompt'. This terminates the collection of
  output from a previous command if that happens to be in effect."
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'emacs)
!       (setq gdb-output-sink 'post-emacs))
       (t
!       (setq gdb-output-sink 'user)
        (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
  
  (defun gdb-prompt (ignored)
    "An annotation handler for `prompt'.
  This sends the next command (if any) to gdb."
    (when gdb-first-prompt (gdb-ann3))
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'post-emacs)
!       (setq gdb-output-sink 'user)
        (let ((handler
!            (car (cdr gdb-current-item))))
        (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
          (funcall handler))))
       (t
!       (setq gdb-output-sink 'user)
        (error "Phase error in gdb-prompt (got %s)" sink))))
    (let ((input (gdb-dequeue-input)))
      (if input
        (gdb-send-item input)
        (progn
!       (setq gdb-prompting t)
        (gud-display-frame)))))
  
  (defun gdb-subprompt (ignored)
    "An annotation handler for non-top-level prompts."
!   (setq gdb-prompting t))
  
  (defun gdb-starting (ignored)
    "An annotation handler for `starting'.  This says that I/O for the
  subprocess is now the program being debugged, not GDB."
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'user)
        (progn
        (setq gud-running t)
        (if gdb-use-inferior-io-buffer
!           (setq gdb-output-sink 'inferior))))
       (t (error "Unexpected `starting' annotation")))))
  
  (defun gdb-stopping (ignored)
    "An annotation handler for `exited' and other annotations which say that I/O
  for the subprocess is now GDB, not the program being debugged."
    (if gdb-use-inferior-io-buffer
!       (let ((sink gdb-output-sink))
        (cond
         ((eq sink 'inferior)
!         (setq gdb-output-sink 'user))
         (t (error "Unexpected stopping annotation"))))))
  
  (defun gdb-frame-begin (ignored)
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'inferior)
!       (setq gdb-output-sink 'user))
       ((eq sink 'user) t)
       ((eq sink 'emacs) t)
       (t (error "Unexpected frame-begin annotation (%S)" sink)))))
***************
*** 782,798 ****
    "An annotation handler for `stopped'.  It is just like gdb-stopping, except
  that if we already set the output sink to 'user in gdb-stopping, that is 
fine."
    (setq gud-running nil)
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'inferior)
!       (gdb-set-output-sink 'user))
       ((eq sink 'user) t)
       (t (error "Unexpected stopped annotation")))))
  
  (defun gdb-post-prompt (ignored)
    "An annotation handler for `post-prompt'. This begins the collection of
  output from the current command if that happens to be appropriate."
!   (if (not (gdb-get-pending-triggers))
        (progn
        (gdb-get-current-frame)
        (gdb-invalidate-frames)
--- 795,811 ----
    "An annotation handler for `stopped'.  It is just like gdb-stopping, except
  that if we already set the output sink to 'user in gdb-stopping, that is 
fine."
    (setq gud-running nil)
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'inferior)
!       (setq gdb-output-sink 'user))
       ((eq sink 'user) t)
       (t (error "Unexpected stopped annotation")))))
  
  (defun gdb-post-prompt (ignored)
    "An annotation handler for `post-prompt'. This begins the collection of
  output from the current command if that happens to be appropriate."
!   (if (not gdb-pending-triggers)
        (progn
        (gdb-get-current-frame)
        (gdb-invalidate-frames)
***************
*** 809,821 ****
              (dolist (var gdb-var-list)
                (setcar (nthcdr 5 var) nil))))
          (gdb-var-update))))
!   (let ((sink (gdb-get-output-sink)))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'pre-emacs)
!       (gdb-set-output-sink 'emacs))
       (t
!       (gdb-set-output-sink 'user)
        (error "Phase error in gdb-post-prompt (got %s)" sink)))))
  
  (defun gud-gdba-marker-filter (string)
--- 822,834 ----
              (dolist (var gdb-var-list)
                (setcar (nthcdr 5 var) nil))))
          (gdb-var-update))))
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'user) t)
       ((eq sink 'pre-emacs)
!       (setq gdb-output-sink 'emacs))
       (t
!       (setq gdb-output-sink 'user)
        (error "Phase error in gdb-post-prompt (got %s)" sink)))))
  
  (defun gud-gdba-marker-filter (string)
***************
*** 877,883 ****
      output))
  
  (defun gdb-concat-output (so-far new)
!   (let ((sink (gdb-get-output-sink )))
      (cond
       ((eq sink 'user) (concat so-far new))
       ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
--- 890,896 ----
      output))
  
  (defun gdb-concat-output (so-far new)
!   (let ((sink gdb-output-sink))
      (cond
       ((eq sink 'user) (concat so-far new))
       ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
***************
*** 939,957 ****
    `(defun ,name (&optional ignored)
       (if (and (,demand-predicate)
              (not (member ',name
!                          (gdb-get-pending-triggers))))
         (progn
           (gdb-enqueue-input
            (list ,gdb-command ',output-handler))
!          (gdb-set-pending-triggers
!           (cons ',name
!                 (gdb-get-pending-triggers)))))))
  
  (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
    `(defun ,name ()
!      (gdb-set-pending-triggers
        (delq ',trigger
!           (gdb-get-pending-triggers)))
       (let ((buf (gdb-get-buffer ',buf-key)))
         (and buf
            (with-current-buffer buf
--- 952,968 ----
    `(defun ,name (&optional ignored)
       (if (and (,demand-predicate)
              (not (member ',name
!                          gdb-pending-triggers)))
         (progn
           (gdb-enqueue-input
            (list ,gdb-command ',output-handler))
!          (push ',name gdb-pending-triggers)))))
  
  (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
    `(defun ,name ()
!      (setq gdb-pending-triggers
        (delq ',trigger
!           gdb-pending-triggers))
       (let ((buf (gdb-get-buffer ',buf-key)))
         (and buf
            (with-current-buffer buf
***************
*** 1083,1089 ****
      (dolist (buffer (buffer-list))
        (with-current-buffer buffer
        (if (and (eq gud-minor-mode 'gdba)
!                (not (string-match "^\*" (buffer-name))))
            (gdb-remove-breakpoint-icons (point-min) (point-max)))))
      (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
        (save-excursion
--- 1094,1100 ----
      (dolist (buffer (buffer-list))
        (with-current-buffer buffer
        (if (and (eq gud-minor-mode 'gdba)
!                (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
            (gdb-remove-breakpoint-icons (point-min) (point-max)))))
      (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
        (save-excursion
***************
*** 1181,1187 ****
    (setq mode-name "Breakpoints")
    (use-local-map gdb-breakpoints-mode-map)
    (setq buffer-read-only t)
!   (gdb-invalidate-breakpoints))
  
  (defun gdb-toggle-breakpoint ()
    "Enable/disable the breakpoint at current line."
--- 1192,1200 ----
    (setq mode-name "Breakpoints")
    (use-local-map gdb-breakpoints-mode-map)
    (setq buffer-read-only t)
!   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
!       (gdb-invalidate-breakpoints)
!     (gdbmi-invalidate-breakpoints)))
  
  (defun gdb-toggle-breakpoint ()
    "Enable/disable the breakpoint at current line."
***************
*** 1194,1201 ****
         (list
        (concat
         (if (eq ?y (char-after (match-beginning 2)))
!            "server disable "
!          "server enable ")
         (match-string 1) "\n")
        'ignore)))))
  
--- 1207,1214 ----
         (list
        (concat
         (if (eq ?y (char-after (match-beginning 2)))
!            gdb-server-prefix "disable "
!          gdb-server-prefix "enable ")
         (match-string 1) "\n")
        'ignore)))))
  
***************
*** 1206,1220 ****
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
        (error "Not recognized as break/watchpoint line")
      (gdb-enqueue-input
!      (list (concat "server delete " (match-string 1) "\n") 'ignore))))
  
  (defun gdb-goto-breakpoint ()
    "Display the breakpoint location specified at current line."
    (interactive)
    (save-excursion
      (beginning-of-line 1)
!     (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
!     (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
    (if (match-string 2)
        (let ((line (match-string 2))
            (file (match-string 1)))
--- 1219,1235 ----
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
        (error "Not recognized as break/watchpoint line")
      (gdb-enqueue-input
!      (list (concat gdb-server-prefix "delete " (match-string 1) "\n") 
'ignore))))
  
  (defun gdb-goto-breakpoint ()
    "Display the breakpoint location specified at current line."
    (interactive)
    (save-excursion
      (beginning-of-line 1)
!     (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))
!       (looking-at 
"[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*.\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
!       (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
!       (looking-at "\\(\\S-*\\):\\([0-9]+\\)")))
    (if (match-string 2)
        (let ((line (match-string 2))
            (file (match-string 1)))
***************
*** 1299,1309 ****
    (setq buffer-read-only t)
    (use-local-map gdb-frames-mode-map)
    (font-lock-mode -1)
!   (gdb-invalidate-frames))
  
  (defun gdb-get-frame-number ()
    (save-excursion
!     (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
           (n (or (and pos (match-string-no-properties 1)) "0")))
        n)))
  
--- 1314,1326 ----
    (setq buffer-read-only t)
    (use-local-map gdb-frames-mode-map)
    (font-lock-mode -1)
!   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
!       (gdb-invalidate-frames)
!     (gdbmi-invalidate-frames)))
  
  (defun gdb-get-frame-number ()
    (save-excursion
!     (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t))
           (n (or (and pos (match-string-no-properties 1)) "0")))
        n)))
  
***************
*** 1311,1317 ****
    "Select the frame and display the relevant source."
    (interactive)
    (gdb-enqueue-input
!    (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
    (gud-display-frame))
  
  (defun gdb-frames-mouse-select (event)
--- 1328,1334 ----
    "Select the frame and display the relevant source."
    (interactive)
    (gdb-enqueue-input
!    (list (concat gdb-server-prefix "frame " (gdb-get-frame-number) "\n") 
'ignore))
    (gud-display-frame))
  
  (defun gdb-frames-mouse-select (event)
***************
*** 1329,1335 ****
  
  (def-gdb-auto-updated-buffer gdb-threads-buffer
    gdb-invalidate-threads
!   "server info threads\n"
    gdb-info-threads-handler
    gdb-info-threads-custom)
  
--- 1346,1352 ----
  
  (def-gdb-auto-updated-buffer gdb-threads-buffer
    gdb-invalidate-threads
!   (concat gdb-server-prefix "info threads\n")
    gdb-info-threads-handler
    gdb-info-threads-custom)
  
***************
*** 1370,1376 ****
  (defun gdb-threads-mode ()
    "Major mode for gdb frames.
  
! \\{gdb-frames-mode-map}"
    (setq major-mode 'gdb-threads-mode)
    (setq mode-name "Threads")
    (setq buffer-read-only t)
--- 1387,1393 ----
  (defun gdb-threads-mode ()
    "Major mode for gdb frames.
  
! \\{gdb-threads-mode-map}"
    (setq major-mode 'gdb-threads-mode)
    (setq mode-name "Threads")
    (setq buffer-read-only t)
***************
*** 1404,1410 ****
  
  (def-gdb-auto-updated-buffer gdb-registers-buffer
    gdb-invalidate-registers
!   "server info registers\n"
    gdb-info-registers-handler
    gdb-info-registers-custom)
  
--- 1421,1427 ----
  
  (def-gdb-auto-updated-buffer gdb-registers-buffer
    gdb-invalidate-registers
!   (concat gdb-server-prefix "info registers\n")
    gdb-info-registers-handler
    gdb-info-registers-custom)
  
***************
*** 1458,1465 ****
  ;; Abbreviate for arrays and structures.
  ;; These can be expanded using gud-display.
  (defun gdb-info-locals-handler nil
!   (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
!                                 (gdb-get-pending-triggers)))
    (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
      (with-current-buffer buf
        (goto-char (point-min))
--- 1475,1482 ----
  ;; Abbreviate for arrays and structures.
  ;; These can be expanded using gud-display.
  (defun gdb-info-locals-handler nil
!   (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
!                                 gdb-pending-triggers))
    (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
      (with-current-buffer buf
        (goto-char (point-min))
***************
*** 1494,1503 ****
  
  \\{gdb-locals-mode-map}"
    (setq major-mode 'gdb-locals-mode)
!   (setq mode-name "Locals")
    (setq buffer-read-only t)
    (use-local-map gdb-locals-mode-map)
!   (gdb-invalidate-locals))
  
  (defun gdb-locals-buffer-name ()
    (with-current-buffer gud-comint-buffer
--- 1511,1522 ----
  
  \\{gdb-locals-mode-map}"
    (setq major-mode 'gdb-locals-mode)
!   (setq mode-name (concat "Locals:" gdb-current-frame))
    (setq buffer-read-only t)
    (use-local-map gdb-locals-mode-map)
!   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
!       (gdb-invalidate-locals)
!     (gdbmi-invalidate-locals)))
  
  (defun gdb-locals-buffer-name ()
    (with-current-buffer gud-comint-buffer
***************
*** 1567,1590 ****
      `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
    (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
    (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
    (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
    (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
    (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
!   (define-key menu [breakpoints] '("Breakpoints" . 
gdb-frame-breakpoints-buffer))
! ;  (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
! )
  
  (let ((menu (make-sparse-keymap "GDB-Windows")))
    (define-key gud-menu-map [displays]
      `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
    (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
    (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
    (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
    (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
    (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
!   (define-key menu [breakpoints] '("Breakpoints" . 
gdb-display-breakpoints-buffer))
! ;  (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
! )
  
  (let ((menu (make-sparse-keymap "View")))
     (define-key gud-menu-map [view]
--- 1586,1607 ----
      `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
    (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
    (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
+   (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
    (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
    (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
    (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
!   (define-key menu [breakpoints] '("Breakpoints" . 
gdb-frame-breakpoints-buffer)))
  
  (let ((menu (make-sparse-keymap "GDB-Windows")))
    (define-key gud-menu-map [displays]
      `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
    (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
+   (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
    (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
    (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
    (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
    (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
!   (define-key menu [breakpoints] '("Breakpoints" . 
gdb-display-breakpoints-buffer)))
  
  (let ((menu (make-sparse-keymap "View")))
     (define-key gud-menu-map [view]
***************
*** 1686,1692 ****
    "Nil (the default value) means just pop up the GUD buffer
  unless `gdb-show-main' is t. In this case it starts with two
  windows: one displaying the GUD buffer and the other with the
! source file with the main routine of the debugee. Non-nil means
  display the layout shown for `gdba'."
    :type 'boolean
    :group 'gud)
--- 1703,1709 ----
    "Nil (the default value) means just pop up the GUD buffer
  unless `gdb-show-main' is t. In this case it starts with two
  windows: one displaying the GUD buffer and the other with the
! source file with the main routine of the inferior. Non-nil means
  display the layout shown for `gdba'."
    :type 'boolean
    :group 'gud)
***************
*** 1730,1736 ****
    (dolist (buffer (buffer-list))
      (unless (eq buffer gud-comint-buffer)
        (with-current-buffer buffer
!       (if (memq gud-minor-mode '(gdba pdb))
            (if (string-match "\\`\\*.+\\*\\'" (buffer-name))
                (kill-buffer nil)
              (gdb-remove-breakpoint-icons (point-min) (point-max) t)
--- 1747,1753 ----
    (dolist (buffer (buffer-list))
      (unless (eq buffer gud-comint-buffer)
        (with-current-buffer buffer
!       (if (memq gud-minor-mode '(gdbmi gdba))
            (if (string-match "\\`\\*.+\\*\\'" (buffer-name))
                (kill-buffer nil)
              (gdb-remove-breakpoint-icons (point-min) (point-max) t)
***************
*** 1872,1878 ****
  
  (def-gdb-auto-updated-buffer gdb-assembler-buffer
    gdb-invalidate-assembler
!   (concat "server disassemble " gdb-current-address "\n")
    gdb-assembler-handler
    gdb-assembler-custom)
  
--- 1889,1895 ----
  
  (def-gdb-auto-updated-buffer gdb-assembler-buffer
    gdb-invalidate-assembler
!   (concat gdb-server-prefix "disassemble " gdb-current-address "\n")
    gdb-assembler-handler
    gdb-assembler-custom)
  
***************
*** 1956,1999 ****
        (progn
        (unless (string-equal gdb-current-frame gdb-previous-frame)
          (if (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
            (with-current-buffer gud-comint-buffer
!             (let ((queue (gdb-get-input-queue)) (item))
                (dolist (item queue)
                  (if (equal (cdr item) '(gdb-assembler-handler))
!                     (gdb-set-input-queue
!                      (delete item (gdb-get-input-queue)))))))
            (gdb-enqueue-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)
            (setq gdb-previous-frame gdb-current-frame)))))))
  
  (defun gdb-get-current-frame ()
!   (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
        (progn
        (gdb-enqueue-input
!        (list (concat "server info frame\n") 'gdb-frame-handler))
!       (gdb-set-pending-triggers
!        (cons 'gdb-get-current-frame
!              (gdb-get-pending-triggers))))))
  
  (defun gdb-frame-handler ()
!   (gdb-set-pending-triggers
!    (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
      (goto-char (point-min))
      (forward-line)
      (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ")
        (progn
          (setq gdb-current-frame (match-string 2))
          (let ((address (match-string 1)))
            ;; remove leading 0s from output of info frame command.
            (if (string-match "^0+\\(.*\\)" address)
--- 1973,2016 ----
        (progn
        (unless (string-equal gdb-current-frame gdb-previous-frame)
          (if (or (not (member 'gdb-invalidate-assembler
!                              gdb-pending-triggers))
                  (not (string-equal gdb-current-address
                                     gdb-previous-address)))
          (progn
            ;; take previous disassemble command off the queue
            (with-current-buffer gud-comint-buffer
!             (let ((queue gdb-input-queue) (item))
                (dolist (item queue)
                  (if (equal (cdr item) '(gdb-assembler-handler))
!                     (setq gdb-input-queue
!                           (delete item gdb-input-queue))))))
            (gdb-enqueue-input
!            (list (concat gdb-server-prefix "disassemble " gdb-current-address 
"\n")
                   'gdb-assembler-handler))
!           (push 'gdb-invalidate-assembler gdb-pending-triggers)
            (setq gdb-previous-address gdb-current-address)
            (setq gdb-previous-frame gdb-current-frame)))))))
  
  (defun gdb-get-current-frame ()
!   (if (not (member 'gdb-get-current-frame gdb-pending-triggers))
        (progn
        (gdb-enqueue-input
!        (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler))
!       (push 'gdb-get-current-frame
!              gdb-pending-triggers))))
  
  (defun gdb-frame-handler ()
!   (setq gdb-pending-triggers
!    (delq 'gdb-get-current-frame gdb-pending-triggers))
    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
      (goto-char (point-min))
      (forward-line)
      (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ")
        (progn
          (setq gdb-current-frame (match-string 2))
+         (if (gdb-get-buffer 'gdb-locals-buffer)
+             (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
+               (setq mode-name (concat "Locals:" gdb-current-frame))))
          (let ((address (match-string 1)))
            ;; remove leading 0s from output of info frame command.
            (if (string-match "^0+\\(.*\\)" address)




reply via email to

[Prev in Thread] Current Thread [Next in Thread]