/[emacs]/emacs/lisp/progmodes/gdb-ui.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/gdb-ui.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4.2.7 by miles, Tue Jul 6 09:23:47 2004 UTC revision 1.4.2.8 by miles, Tue Jul 6 09:31:24 2004 UTC
# Line 40  Line 40 
40  ;; Kingdon and uses GDB's annotation interface. You don't need to know about  ;; Kingdon and uses GDB's annotation interface. You don't need to know about
41  ;; annotations to use this mode as a debugger, but if you are interested  ;; annotations to use this mode as a debugger, but if you are interested
42  ;; developing the mode itself, then see the Annotations section in the GDB  ;; developing the mode itself, then see the Annotations section in the GDB
43  ;; info manual. Some GDB/MI commands are also used through th CLI command  ;; info manual.
44  ;; 'interpreter mi <mi-command>'.  ;;
45    ;; GDB developers plan to make the annotation interface obsolete. A new
46    ;; interface called GDB/MI (machine interface) has been designed to replace
47    ;; it. Some GDB/MI commands are used in this file through the CLI command
48    ;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
49    ;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
50    ;; primary interface to GDB. It is still under development and is part of a
51    ;; process to migrate Emacs from annotations to GDB/MI.
52  ;;  ;;
53  ;; Known Bugs:  ;; Known Bugs:
54  ;;  ;;
# Line 53  Line 60 
60  (defvar gdb-current-address "main" "Initialisation for Assembler buffer.")  (defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
61  (defvar gdb-previous-address nil)  (defvar gdb-previous-address nil)
62  (defvar gdb-previous-frame nil)  (defvar gdb-previous-frame nil)
63  (defvar gdb-current-frame "main")  (defvar gdb-current-frame nil)
64  (defvar gdb-current-language nil)  (defvar gdb-current-language nil)
65  (defvar gdb-view-source t "Non-nil means that source code can be viewed.")  (defvar gdb-view-source t "Non-nil means that source code can be viewed.")
66  (defvar gdb-selected-view 'source "Code type that user wishes to view.")  (defvar gdb-selected-view 'source "Code type that user wishes to view.")
# Line 63  Line 70 
70  (defvar gdb-overlay-arrow-position nil)  (defvar gdb-overlay-arrow-position nil)
71  (defvar gdb-variables '()  (defvar gdb-variables '()
72    "A list of variables that are local to the GUD buffer.")    "A list of variables that are local to the GUD buffer.")
73    (defvar gdb-server-prefix nil)
74    
75  ;;;###autoload  ;;;###autoload
76  (defun gdba (command-line)  (defun gdba (command-line)
77    "Run gdb on program FILE in buffer *gud-FILE*.    "Run gdb on program FILE in buffer *gud-FILE*.
# Line 73  and source-file directory for your debug Line 81  and source-file directory for your debug
81  If `gdb-many-windows' is nil (the default value) then gdb just  If `gdb-many-windows' is nil (the default value) then gdb just
82  pops up the GUD buffer unless `gdb-show-main' is t. In this case  pops up the GUD buffer unless `gdb-show-main' is t. In this case
83  it starts with two windows: one displaying the GUD buffer and the  it starts with two windows: one displaying the GUD buffer and the
84  other with the source file with the main routine of the debugee.  other with the source file with the main routine of the inferior.
85    
86  If `gdb-many-windows' is t, regardless of the value of  If `gdb-many-windows' is t, regardless of the value of
87  `gdb-show-main', the layout below will appear unless  `gdb-show-main', the layout below will appear unless
# Line 100  detailed description of this mode. Line 108  detailed description of this mode.
108                                    |                                    |
109                                    |                                    |
110  ---------------------------------------------------------------------  ---------------------------------------------------------------------
111   Source buffer                    | Input/Output (of debugee) buffer   Source buffer                    | Input/Output (of inferior) buffer
112                                    | (comint-mode)                                    | (comint-mode)
113                                    |                                    |
114                                    |                                    |
# Line 174  detailed description of this mode. Line 182  detailed description of this mode.
182    (setq gdb-current-address "main")    (setq gdb-current-address "main")
183    (setq gdb-previous-address nil)    (setq gdb-previous-address nil)
184    (setq gdb-previous-frame nil)    (setq gdb-previous-frame nil)
185    (setq gdb-current-frame "main")    (setq gdb-current-frame nil)
186    (setq gdb-view-source t)    (setq gdb-view-source t)
187    (setq gdb-selected-view 'source)    (setq gdb-selected-view 'source)
188    (setq gdb-var-list nil)    (setq gdb-var-list nil)
189    (setq gdb-var-changed nil)    (setq gdb-var-changed nil)
190    (setq gdb-first-prompt nil)    (setq gdb-first-prompt nil)
191      (setq gdb-prompting nil)
192      (setq gdb-current-item nil)
193      (setq gdb-pending-triggers nil)
194      (setq gdb-output-sink 'user)
195      (setq gdb-server-prefix "server ")
196    ;;    ;;
197    (mapc 'make-local-variable gdb-variables)    (mapc 'make-local-variable gdb-variables)
198    (setq gdb-buffer-type 'gdba)    (setq gdb-buffer-type 'gdba)
# Line 208  speedbar." Line 221  speedbar."
221    (require 'tooltip)    (require 'tooltip)
222    (let ((expr (tooltip-identifier-from-point (point))))    (let ((expr (tooltip-identifier-from-point (point))))
223      (if (and (string-equal gdb-current-language "c")      (if (and (string-equal gdb-current-language "c")
224               gdb-use-colon-colon-notation)               gdb-use-colon-colon-notation gdb-current-frame)
225          (setq expr (concat gdb-current-frame "::" expr)))          (setq expr (concat gdb-current-frame "::" expr)))
226      (catch 'already-watched      (catch 'already-watched
227        (dolist (var gdb-var-list)        (dolist (var gdb-var-list)
228          (if (string-equal expr (car var)) (throw 'already-watched nil)))          (if (string-equal expr (car var)) (throw 'already-watched nil)))
229        (set-text-properties 0 (length expr) nil expr)        (set-text-properties 0 (length expr) nil expr)
230        (gdb-enqueue-input        (gdb-enqueue-input
231         (list (concat "server interpreter mi \"-var-create - * "  expr "\"\n")         (list
232            (if (eq gud-minor-mode 'gdba)
233                (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
234              (concat"-var-create - * "  expr "\n"))
235               `(lambda () (gdb-var-create-handler ,expr))))))               `(lambda () (gdb-var-create-handler ,expr))))))
236    (select-window (get-buffer-window gud-comint-buffer 'visible)))    (select-window (get-buffer-window gud-comint-buffer 'visible)))
237    
# Line 308  speedbar." Line 324  speedbar."
324         (setq gdb-var-list (nreverse var-list))))))         (setq gdb-var-list (nreverse var-list))))))
325    
326  (defun gdb-var-update ()  (defun gdb-var-update ()
327    (if (not (member 'gdb-var-update (gdb-get-pending-triggers)))    (if (not (member 'gdb-var-update gdb-pending-triggers))
328        (progn        (progn
329          (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"          (gdb-enqueue-input
330             (list
331              (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
332                  "server interpreter mi \"-var-update *\"\n"
333                "-var-update *\n")
334                                   'gdb-var-update-handler))                                   'gdb-var-update-handler))
335          (gdb-set-pending-triggers (cons 'gdb-var-update          (push 'gdb-var-update gdb-pending-triggers))))
                                         (gdb-get-pending-triggers))))))  
336    
337  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
338    
# Line 323  speedbar." Line 342  speedbar."
342      (while (re-search-forward gdb-var-update-regexp nil t)      (while (re-search-forward gdb-var-update-regexp nil t)
343          (let ((varnum (match-string 1)))          (let ((varnum (match-string 1)))
344            (gdb-enqueue-input            (gdb-enqueue-input
345             (list (concat "server interpreter mi \"-var-evaluate-expression "             (list
346                           varnum "\"\n")              (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
347                    (concat "server interpreter mi \"-var-evaluate-expression "
348                            varnum "\"\n")
349                  (concat "-var-evaluate-expression " varnum "\n"))
350                       `(lambda () (gdb-var-evaluate-expression-handler                       `(lambda () (gdb-var-evaluate-expression-handler
351                                    ,varnum t)))))))                                    ,varnum t)))))))
352    (gdb-set-pending-triggers    (setq gdb-pending-triggers
353     (delq 'gdb-var-update (gdb-get-pending-triggers))))     (delq 'gdb-var-update gdb-pending-triggers)))
354    
355  (defun gdb-var-delete ()  (defun gdb-var-delete ()
356    "Delete watched expression from the speedbar."    "Delete watched expression from the speedbar."
# Line 341  speedbar." Line 363  speedbar."
363                 (varnum (cadr var)))                 (varnum (cadr var)))
364            (unless (string-match "\\." varnum)            (unless (string-match "\\." varnum)
365              (gdb-enqueue-input              (gdb-enqueue-input
366               (list (concat "server interpreter mi \"-var-delete "               (list
367                             varnum "\"\n")                (if (with-current-buffer gud-comint-buffer
368                        (eq gud-minor-mode 'gdba))
369                      (concat "server interpreter mi \"-var-delete " varnum "\"\n")
370                    (concat "-var-delete " varnum "\n"))
371                     'ignore))                     'ignore))
372              (setq gdb-var-list (delq var gdb-var-list))              (setq gdb-var-list (delq var gdb-var-list))
373              (dolist (varchild gdb-var-list)              (dolist (varchild gdb-var-list)
# Line 356  speedbar." Line 381  speedbar."
381           (varnum (cadr var)) (value))           (varnum (cadr var)) (value))
382      (setq value (read-string "New value: "))      (setq value (read-string "New value: "))
383      (gdb-enqueue-input      (gdb-enqueue-input
384       (list (concat "server interpreter mi \"-var-assign "       (list
385                     varnum " " value "\"\n")        (if (with-current-buffer gud-comint-buffer
386                (eq gud-minor-mode 'gdba))
387              (concat "server interpreter mi \"-var-assign " varnum " " value "\"\n")
388            (concat "-var-assign " varnum " " value "\n"))
389             'ignore))))             'ignore))))
390    
391  (defcustom gdb-show-changed-values t  (defcustom gdb-show-changed-values t
# Line 372  TEXT is the text of the button we clicke Line 400  TEXT is the text of the button we clicke
400  TOKEN is data related to this node.  TOKEN is data related to this node.
401  INDENT is the current indentation depth."  INDENT is the current indentation depth."
402    (cond ((string-match "+" text)        ;expand this node    (cond ((string-match "+" text)        ;expand this node
403           (gdb-var-list-children token))           (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
404                 (gdb-var-list-children token)
405               (gdbmi-var-list-children token)))
406          ((string-match "-" text)        ;contract this node          ((string-match "-" text)        ;contract this node
407           (dolist (var gdb-var-list)           (dolist (var gdb-var-list)
408             (if (string-match (concat token "\\.") (nth 1 var))             (if (string-match (concat token "\\.") (nth 1 var))
409                 (setq gdb-var-list (delq var gdb-var-list))))                 (setq gdb-var-list (delq var gdb-var-list))))
410           (setq gdb-var-changed t))))           (setq gdb-var-changed t))))
   
411    
412  ;; ======================================================================  (defvar gdb-buffer-type nil
 ;;  
 ;; 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  
413    "One of the symbols bound in `gdb-buffer-rules'.")    "One of the symbols bound in `gdb-buffer-rules'.")
414    
415  (def-gdb-var burst ""  (defvar gdb-input-queue ()
   "A string of characters from gdb that have not yet been processed.")  
   
 (def-gdb-var input-queue ()  
416    "A list of gdb command objects.")    "A list of gdb command objects.")
417    
418  (def-gdb-var prompting nil  (defvar gdb-prompting nil
419    "True when gdb is idle with no pending input.")    "True when gdb is idle with no pending input.")
420    
421  (def-gdb-var output-sink 'user  (defvar gdb-output-sink 'user
422    "The disposition of the output of the current gdb command.    "The disposition of the output of the current gdb command.
423  Possible values are these symbols:  Possible values are these symbols:
424    
# Line 432  Possible values are these symbols: Line 436  Possible values are these symbols:
436               gdb mode sends to gdb on its own behalf.               gdb mode sends to gdb on its own behalf.
437      post-emacs -- ignore output until the prompt annotation is      post-emacs -- ignore output until the prompt annotation is
438                    received, then go to USER disposition.                    received, then go to USER disposition.
 ")  
439    
440  (def-gdb-var current-item nil  gdba (gdb-ui.el) uses all five values,  gdbmi (gdb-mi.el) only two
441    (user and emacs).")
442    
443    (defvar gdb-current-item nil
444    "The most recent command item sent to gdb.")    "The most recent command item sent to gdb.")
445    
446  (def-gdb-var pending-triggers '()  (defvar gdb-pending-triggers '()
447    "A list of trigger functions that have run later than their output    "A list of trigger functions that have run later than their output
448  handlers.")  handlers.")
449    
# Line 481  The key should be one of the cars in `gd Line 487  The key should be one of the cars in `gd
487            (set (make-local-variable 'gdb-buffer-type) key)            (set (make-local-variable 'gdb-buffer-type) key)
488            (if (cdr (cdr rules))            (if (cdr (cdr rules))
489                (funcall (car (cdr (cdr rules)))))                (funcall (car (cdr (cdr rules)))))
490            (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer)            (set (make-local-variable 'gud-minor-mode)
491            (set (make-local-variable 'gud-minor-mode) 'gdba)                 (with-current-buffer gud-comint-buffer gud-minor-mode))
492            (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)            (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
493            new))))            new))))
494    
# Line 550  The key should be one of the cars in `gd Line 556  The key should be one of the cars in `gd
556      (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)      (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
557      map))      map))
558    
559  (define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O"  (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
560    "Major mode for gdb inferior-io."    "Major mode for gdb inferior-io."
561    :syntax-table nil :abbrev-table nil    :syntax-table nil :abbrev-table nil
562    ;; We want to use comint because it has various nifty and familiar    ;; We want to use comint because it has various nifty and familiar
# Line 622  This filter may simply queue output for Line 628  This filter may simply queue output for
628  ;; is a query, or other non-top-level prompt.  ;; is a query, or other non-top-level prompt.
629    
630  (defun gdb-enqueue-input (item)  (defun gdb-enqueue-input (item)
631    (if (gdb-get-prompting)    (if gdb-prompting
632        (progn        (progn
633          (gdb-send-item item)          (gdb-send-item item)
634          (gdb-set-prompting nil))          (setq gdb-prompting nil))
635      (gdb-set-input-queue      (push item gdb-input-queue)))
      (cons item (gdb-get-input-queue)))))  
636    
637  (defun gdb-dequeue-input ()  (defun gdb-dequeue-input ()
638    (let ((queue (gdb-get-input-queue)))    (let ((queue gdb-input-queue))
639      (and queue      (and queue
640           (let ((last (car (last queue))))           (let ((last (car (last queue))))
641             (unless (nbutlast queue) (gdb-set-input-queue '()))             (unless (nbutlast queue) (setq gdb-input-queue '()))
642             last))))             last))))
   
643    
644  ;;  ;;
645  ;; output -- things gdb prints to emacs  ;; output -- things gdb prints to emacs
# Line 664  This filter may simply queue output for Line 668  This filter may simply queue output for
668      ("commands" gdb-subprompt)      ("commands" gdb-subprompt)
669      ("overload-choice" gdb-subprompt)      ("overload-choice" gdb-subprompt)
670      ("query" gdb-subprompt)      ("query" gdb-subprompt)
671        ;; Need this prompt for GDB 6.1
672      ("nquery" gdb-subprompt)      ("nquery" gdb-subprompt)
673      ("prompt-for-continue" gdb-subprompt)      ("prompt-for-continue" gdb-subprompt)
674      ("post-prompt" gdb-post-prompt)      ("post-prompt" gdb-post-prompt)
# Line 693  This filter may simply queue output for Line 698  This filter may simply queue output for
698    (setq gdb-view-source t)    (setq gdb-view-source t)
699    ;; cover for auto-display output which comes *before*    ;; cover for auto-display output which comes *before*
700    ;; stopped annotation    ;; stopped annotation
701    (if (eq (gdb-get-output-sink) 'inferior) (gdb-set-output-sink 'user)))    (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
702    
703  (defun gdb-send-item (item)  (defun gdb-send-item (item)
704    (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))    (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
705    (gdb-set-current-item item)    (setq gdb-current-item item)
706    (if (stringp item)    (with-current-buffer gud-comint-buffer
707        (progn      (if (eq gud-minor-mode 'gdba)
708          (gdb-set-output-sink 'user)          (progn
709          (process-send-string (get-buffer-process gud-comint-buffer) item))            (if (stringp item)
710      (progn                (progn
711                    (setq gdb-output-sink 'user)
712                    (process-send-string (get-buffer-process gud-comint-buffer) item))
713                (progn
714                  (gdb-clear-partial-output)
715                  (setq gdb-output-sink 'pre-emacs)
716                  (process-send-string (get-buffer-process gud-comint-buffer)
717                                       (car item)))))
718          ; case: eq gud-minor-mode 'gdbmi
719        (gdb-clear-partial-output)        (gdb-clear-partial-output)
720        (gdb-set-output-sink 'pre-emacs)        (setq gdb-output-sink 'emacs)
721        (process-send-string (get-buffer-process gud-comint-buffer)        (process-send-string (get-buffer-process gud-comint-buffer)
722                             (car item)))))                           (car item)))))
723    
724  (defun gdb-pre-prompt (ignored)  (defun gdb-pre-prompt (ignored)
725    "An annotation handler for `pre-prompt'. This terminates the collection of    "An annotation handler for `pre-prompt'. This terminates the collection of
726  output from a previous command if that happens to be in effect."  output from a previous command if that happens to be in effect."
727    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
728      (cond      (cond
729       ((eq sink 'user) t)       ((eq sink 'user) t)
730       ((eq sink 'emacs)       ((eq sink 'emacs)
731        (gdb-set-output-sink 'post-emacs))        (setq gdb-output-sink 'post-emacs))
732       (t       (t
733        (gdb-set-output-sink 'user)        (setq gdb-output-sink 'user)
734        (error "Phase error in gdb-pre-prompt (got %s)" sink)))))        (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
735    
736  (defun gdb-prompt (ignored)  (defun gdb-prompt (ignored)
737    "An annotation handler for `prompt'.    "An annotation handler for `prompt'.
738  This sends the next command (if any) to gdb."  This sends the next command (if any) to gdb."
739    (when gdb-first-prompt (gdb-ann3))    (when gdb-first-prompt (gdb-ann3))
740    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
741      (cond      (cond
742       ((eq sink 'user) t)       ((eq sink 'user) t)
743       ((eq sink 'post-emacs)       ((eq sink 'post-emacs)
744        (gdb-set-output-sink 'user)        (setq gdb-output-sink 'user)
745        (let ((handler        (let ((handler
746               (car (cdr (gdb-get-current-item)))))               (car (cdr gdb-current-item))))
747          (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)          (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
748            (funcall handler))))            (funcall handler))))
749       (t       (t
750        (gdb-set-output-sink 'user)        (setq gdb-output-sink 'user)
751        (error "Phase error in gdb-prompt (got %s)" sink))))        (error "Phase error in gdb-prompt (got %s)" sink))))
752    (let ((input (gdb-dequeue-input)))    (let ((input (gdb-dequeue-input)))
753      (if input      (if input
754          (gdb-send-item input)          (gdb-send-item input)
755        (progn        (progn
756          (gdb-set-prompting t)          (setq gdb-prompting t)
757          (gud-display-frame)))))          (gud-display-frame)))))
758    
759  (defun gdb-subprompt (ignored)  (defun gdb-subprompt (ignored)
760    "An annotation handler for non-top-level prompts."    "An annotation handler for non-top-level prompts."
761    (gdb-set-prompting t))    (setq gdb-prompting t))
762    
763  (defun gdb-starting (ignored)  (defun gdb-starting (ignored)
764    "An annotation handler for `starting'.  This says that I/O for the    "An annotation handler for `starting'.  This says that I/O for the
765  subprocess is now the program being debugged, not GDB."  subprocess is now the program being debugged, not GDB."
766    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
767      (cond      (cond
768       ((eq sink 'user)       ((eq sink 'user)
769        (progn        (progn
770          (setq gud-running t)          (setq gud-running t)
771          (if gdb-use-inferior-io-buffer          (if gdb-use-inferior-io-buffer
772              (gdb-set-output-sink 'inferior))))              (setq gdb-output-sink 'inferior))))
773       (t (error "Unexpected `starting' annotation")))))       (t (error "Unexpected `starting' annotation")))))
774    
775  (defun gdb-stopping (ignored)  (defun gdb-stopping (ignored)
776    "An annotation handler for `exited' and other annotations which say that I/O    "An annotation handler for `exited' and other annotations which say that I/O
777  for the subprocess is now GDB, not the program being debugged."  for the subprocess is now GDB, not the program being debugged."
778    (if gdb-use-inferior-io-buffer    (if gdb-use-inferior-io-buffer
779        (let ((sink (gdb-get-output-sink)))        (let ((sink gdb-output-sink))
780          (cond          (cond
781           ((eq sink 'inferior)           ((eq sink 'inferior)
782            (gdb-set-output-sink 'user))            (setq gdb-output-sink 'user))
783           (t (error "Unexpected stopping annotation"))))))           (t (error "Unexpected stopping annotation"))))))
784    
785  (defun gdb-frame-begin (ignored)  (defun gdb-frame-begin (ignored)
786    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
787      (cond      (cond
788       ((eq sink 'inferior)       ((eq sink 'inferior)
789        (gdb-set-output-sink 'user))        (setq gdb-output-sink 'user))
790       ((eq sink 'user) t)       ((eq sink 'user) t)
791       ((eq sink 'emacs) t)       ((eq sink 'emacs) t)
792       (t (error "Unexpected frame-begin annotation (%S)" sink)))))       (t (error "Unexpected frame-begin annotation (%S)" sink)))))
# Line 782  for the subprocess is now GDB, not the p Line 795  for the subprocess is now GDB, not the p
795    "An annotation handler for `stopped'.  It is just like gdb-stopping, except    "An annotation handler for `stopped'.  It is just like gdb-stopping, except
796  that if we already set the output sink to 'user in gdb-stopping, that is fine."  that if we already set the output sink to 'user in gdb-stopping, that is fine."
797    (setq gud-running nil)    (setq gud-running nil)
798    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
799      (cond      (cond
800       ((eq sink 'inferior)       ((eq sink 'inferior)
801        (gdb-set-output-sink 'user))        (setq gdb-output-sink 'user))
802       ((eq sink 'user) t)       ((eq sink 'user) t)
803       (t (error "Unexpected stopped annotation")))))       (t (error "Unexpected stopped annotation")))))
804    
805  (defun gdb-post-prompt (ignored)  (defun gdb-post-prompt (ignored)
806    "An annotation handler for `post-prompt'. This begins the collection of    "An annotation handler for `post-prompt'. This begins the collection of
807  output from the current command if that happens to be appropriate."  output from the current command if that happens to be appropriate."
808    (if (not (gdb-get-pending-triggers))    (if (not gdb-pending-triggers)
809        (progn        (progn
810          (gdb-get-current-frame)          (gdb-get-current-frame)
811          (gdb-invalidate-frames)          (gdb-invalidate-frames)
# Line 809  output from the current command if that Line 822  output from the current command if that
822                (dolist (var gdb-var-list)                (dolist (var gdb-var-list)
823                  (setcar (nthcdr 5 var) nil))))                  (setcar (nthcdr 5 var) nil))))
824            (gdb-var-update))))            (gdb-var-update))))
825    (let ((sink (gdb-get-output-sink)))    (let ((sink gdb-output-sink))
826      (cond      (cond
827       ((eq sink 'user) t)       ((eq sink 'user) t)
828       ((eq sink 'pre-emacs)       ((eq sink 'pre-emacs)
829        (gdb-set-output-sink 'emacs))        (setq gdb-output-sink 'emacs))
830       (t       (t
831        (gdb-set-output-sink 'user)        (setq gdb-output-sink 'user)
832        (error "Phase error in gdb-post-prompt (got %s)" sink)))))        (error "Phase error in gdb-post-prompt (got %s)" sink)))))
833    
834  (defun gud-gdba-marker-filter (string)  (defun gud-gdba-marker-filter (string)
# Line 877  output from the current command if that Line 890  output from the current command if that
890      output))      output))
891    
892  (defun gdb-concat-output (so-far new)  (defun gdb-concat-output (so-far new)
893    (let ((sink (gdb-get-output-sink )))    (let ((sink gdb-output-sink))
894      (cond      (cond
895       ((eq sink 'user) (concat so-far new))       ((eq sink 'user) (concat so-far new))
896       ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)       ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
# Line 939  output from the current command if that Line 952  output from the current command if that
952    `(defun ,name (&optional ignored)    `(defun ,name (&optional ignored)
953       (if (and (,demand-predicate)       (if (and (,demand-predicate)
954                (not (member ',name                (not (member ',name
955                             (gdb-get-pending-triggers))))                             gdb-pending-triggers)))
956           (progn           (progn
957             (gdb-enqueue-input             (gdb-enqueue-input
958              (list ,gdb-command ',output-handler))              (list ,gdb-command ',output-handler))
959             (gdb-set-pending-triggers             (push ',name gdb-pending-triggers)))))
             (cons ',name  
                   (gdb-get-pending-triggers)))))))  
960    
961  (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)  (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
962    `(defun ,name ()    `(defun ,name ()
963       (gdb-set-pending-triggers       (setq gdb-pending-triggers
964        (delq ',trigger        (delq ',trigger
965              (gdb-get-pending-triggers)))              gdb-pending-triggers))
966       (let ((buf (gdb-get-buffer ',buf-key)))       (let ((buf (gdb-get-buffer ',buf-key)))
967         (and buf         (and buf
968              (with-current-buffer buf              (with-current-buffer buf
# Line 1083  static char *magick[] = { Line 1094  static char *magick[] = {
1094      (dolist (buffer (buffer-list))      (dolist (buffer (buffer-list))
1095        (with-current-buffer buffer        (with-current-buffer buffer
1096          (if (and (eq gud-minor-mode 'gdba)          (if (and (eq gud-minor-mode 'gdba)
1097                   (not (string-match "^\*" (buffer-name))))                   (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
1098              (gdb-remove-breakpoint-icons (point-min) (point-max)))))              (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1099      (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)      (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1100        (save-excursion        (save-excursion
# Line 1181  static char *magick[] = { Line 1192  static char *magick[] = {
1192    (setq mode-name "Breakpoints")    (setq mode-name "Breakpoints")
1193    (use-local-map gdb-breakpoints-mode-map)    (use-local-map gdb-breakpoints-mode-map)
1194    (setq buffer-read-only t)    (setq buffer-read-only t)
1195    (gdb-invalidate-breakpoints))    (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1196          (gdb-invalidate-breakpoints)
1197        (gdbmi-invalidate-breakpoints)))
1198    
1199  (defun gdb-toggle-breakpoint ()  (defun gdb-toggle-breakpoint ()
1200    "Enable/disable the breakpoint at current line."    "Enable/disable the breakpoint at current line."
# Line 1194  static char *magick[] = { Line 1207  static char *magick[] = {
1207         (list         (list
1208          (concat          (concat
1209           (if (eq ?y (char-after (match-beginning 2)))           (if (eq ?y (char-after (match-beginning 2)))
1210               "server disable "               gdb-server-prefix "disable "
1211             "server enable ")             gdb-server-prefix "enable ")
1212           (match-string 1) "\n")           (match-string 1) "\n")
1213          'ignore)))))          'ignore)))))
1214    
# Line 1206  static char *magick[] = { Line 1219  static char *magick[] = {
1219    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1220        (error "Not recognized as break/watchpoint line")        (error "Not recognized as break/watchpoint line")
1221      (gdb-enqueue-input      (gdb-enqueue-input
1222       (list (concat "server delete " (match-string 1) "\n") 'ignore))))       (list (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))))
1223    
1224  (defun gdb-goto-breakpoint ()  (defun gdb-goto-breakpoint ()
1225    "Display the breakpoint location specified at current line."    "Display the breakpoint location specified at current line."
1226    (interactive)    (interactive)
1227    (save-excursion    (save-excursion
1228      (beginning-of-line 1)      (beginning-of-line 1)
1229      (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)      (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))
1230      (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))          (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*.\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
1231          (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1232          (looking-at "\\(\\S-*\\):\\([0-9]+\\)")))
1233    (if (match-string 2)    (if (match-string 2)
1234        (let ((line (match-string 2))        (let ((line (match-string 2))
1235              (file (match-string 1)))              (file (match-string 1)))
# Line 1299  static char *magick[] = { Line 1314  static char *magick[] = {
1314    (setq buffer-read-only t)    (setq buffer-read-only t)
1315    (use-local-map gdb-frames-mode-map)    (use-local-map gdb-frames-mode-map)
1316    (font-lock-mode -1)    (font-lock-mode -1)
1317    (gdb-invalidate-frames))    (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1318          (gdb-invalidate-frames)
1319        (gdbmi-invalidate-frames)))
1320    
1321  (defun gdb-get-frame-number ()  (defun gdb-get-frame-number ()
1322    (save-excursion    (save-excursion
1323      (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))      (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t))
1324             (n (or (and pos (match-string-no-properties 1)) "0")))             (n (or (and pos (match-string-no-properties 1)) "0")))
1325        n)))        n)))
1326    
# Line 1311  static char *magick[] = { Line 1328  static char *magick[] = {
1328    "Select the frame and display the relevant source."    "Select the frame and display the relevant source."
1329    (interactive)    (interactive)
1330    (gdb-enqueue-input    (gdb-enqueue-input
1331     (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))     (list (concat gdb-server-prefix "frame " (gdb-get-frame-number) "\n") 'ignore))
1332    (gud-display-frame))    (gud-display-frame))
1333    
1334  (defun gdb-frames-mouse-select (event)  (defun gdb-frames-mouse-select (event)
# Line 1329  static char *magick[] = { Line 1346  static char *magick[] = {
1346    
1347  (def-gdb-auto-updated-buffer gdb-threads-buffer  (def-gdb-auto-updated-buffer gdb-threads-buffer
1348    gdb-invalidate-threads    gdb-invalidate-threads
1349    "server info threads\n"    (concat gdb-server-prefix "info threads\n")
1350    gdb-info-threads-handler    gdb-info-threads-handler
1351    gdb-info-threads-custom)    gdb-info-threads-custom)
1352    
# Line 1370  static char *magick[] = { Line 1387  static char *magick[] = {
1387  (defun gdb-threads-mode ()  (defun gdb-threads-mode ()
1388    "Major mode for gdb frames.    "Major mode for gdb frames.
1389    
1390  \\{gdb-frames-mode-map}"  \\{gdb-threads-mode-map}"
1391    (setq major-mode 'gdb-threads-mode)    (setq major-mode 'gdb-threads-mode)
1392    (setq mode-name "Threads")    (setq mode-name "Threads")
1393    (setq buffer-read-only t)    (setq buffer-read-only t)
# Line 1404  static char *magick[] = { Line 1421  static char *magick[] = {
1421    
1422  (def-gdb-auto-updated-buffer gdb-registers-buffer  (def-gdb-auto-updated-buffer gdb-registers-buffer
1423    gdb-invalidate-registers    gdb-invalidate-registers
1424    "server info registers\n"    (concat gdb-server-prefix "info registers\n")
1425    gdb-info-registers-handler    gdb-info-registers-handler
1426    gdb-info-registers-custom)    gdb-info-registers-custom)
1427    
# Line 1458  static char *magick[] = { Line 1475  static char *magick[] = {
1475  ;; Abbreviate for arrays and structures.  ;; Abbreviate for arrays and structures.
1476  ;; These can be expanded using gud-display.  ;; These can be expanded using gud-display.
1477  (defun gdb-info-locals-handler nil  (defun gdb-info-locals-handler nil
1478    (gdb-set-pending-triggers (delq 'gdb-invalidate-locals    (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
1479                                    (gdb-get-pending-triggers)))                                    gdb-pending-triggers))
1480    (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))    (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1481      (with-current-buffer buf      (with-current-buffer buf
1482        (goto-char (point-min))        (goto-char (point-min))
# Line 1494  static char *magick[] = { Line 1511  static char *magick[] = {
1511    
1512  \\{gdb-locals-mode-map}"  \\{gdb-locals-mode-map}"
1513    (setq major-mode 'gdb-locals-mode)    (setq major-mode 'gdb-locals-mode)
1514    (setq mode-name "Locals")    (setq mode-name (concat "Locals:" gdb-current-frame))
1515    (setq buffer-read-only t)    (setq buffer-read-only t)
1516    (use-local-map gdb-locals-mode-map)    (use-local-map gdb-locals-mode-map)
1517    (gdb-invalidate-locals))    (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1518          (gdb-invalidate-locals)
1519        (gdbmi-invalidate-locals)))
1520    
1521  (defun gdb-locals-buffer-name ()  (defun gdb-locals-buffer-name ()
1522    (with-current-buffer gud-comint-buffer    (with-current-buffer gud-comint-buffer
# Line 1567  static char *magick[] = { Line 1586  static char *magick[] = {
1586      `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))      `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1587    (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))    (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1588    (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))    (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1589      (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1590    (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))    (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1591    (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))    (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1592    (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))    (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1593    (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))    (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)))
 ;  (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))  
 )  
1594    
1595  (let ((menu (make-sparse-keymap "GDB-Windows")))  (let ((menu (make-sparse-keymap "GDB-Windows")))
1596    (define-key gud-menu-map [displays]    (define-key gud-menu-map [displays]
1597      `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))      `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1598    (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))    (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1599      (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1600    (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))    (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1601    (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))    (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1602    (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))    (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1603    (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))    (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1604    (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))    (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)))
 ;  (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))  
 )  
1605    
1606  (let ((menu (make-sparse-keymap "View")))  (let ((menu (make-sparse-keymap "View")))
1607     (define-key gud-menu-map [view]     (define-key gud-menu-map [view]
# Line 1686  static char *magick[] = { Line 1703  static char *magick[] = {
1703    "Nil (the default value) means just pop up the GUD buffer    "Nil (the default value) means just pop up the GUD buffer
1704  unless `gdb-show-main' is t. In this case it starts with two  unless `gdb-show-main' is t. In this case it starts with two
1705  windows: one displaying the GUD buffer and the other with the  windows: one displaying the GUD buffer and the other with the
1706  source file with the main routine of the debugee. Non-nil means  source file with the main routine of the inferior. Non-nil means
1707  display the layout shown for `gdba'."  display the layout shown for `gdba'."
1708    :type 'boolean    :type 'boolean
1709    :group 'gud)    :group 'gud)
# Line 1730  This arrangement depends on the value of Line 1747  This arrangement depends on the value of
1747    (dolist (buffer (buffer-list))    (dolist (buffer (buffer-list))
1748      (unless (eq buffer gud-comint-buffer)      (unless (eq buffer gud-comint-buffer)
1749        (with-current-buffer buffer        (with-current-buffer buffer
1750          (if (memq gud-minor-mode '(gdba pdb))          (if (memq gud-minor-mode '(gdbmi gdba))
1751              (if (string-match "\\`\\*.+\\*\\'" (buffer-name))              (if (string-match "\\`\\*.+\\*\\'" (buffer-name))
1752                  (kill-buffer nil)                  (kill-buffer nil)
1753                (gdb-remove-breakpoint-icons (point-min) (point-max) t)                (gdb-remove-breakpoint-icons (point-min) (point-max) t)
# Line 1872  BUFFER nil or omitted means use the curr Line 1889  BUFFER nil or omitted means use the curr
1889    
1890  (def-gdb-auto-updated-buffer gdb-assembler-buffer  (def-gdb-auto-updated-buffer gdb-assembler-buffer
1891    gdb-invalidate-assembler    gdb-invalidate-assembler
1892    (concat "server disassemble " gdb-current-address "\n")    (concat gdb-server-prefix "disassemble " gdb-current-address "\n")
1893    gdb-assembler-handler    gdb-assembler-handler
1894    gdb-assembler-custom)    gdb-assembler-custom)
1895    
# Line 1956  BUFFER nil or omitted means use the curr Line 1973  BUFFER nil or omitted means use the curr
1973        (progn        (progn
1974          (unless (string-equal gdb-current-frame gdb-previous-frame)          (unless (string-equal gdb-current-frame gdb-previous-frame)
1975            (if (or (not (member 'gdb-invalidate-assembler            (if (or (not (member 'gdb-invalidate-assembler
1976                                 (gdb-get-pending-triggers)))                                 gdb-pending-triggers))
1977                    (not (string-equal gdb-current-address                    (not (string-equal gdb-current-address
1978                                       gdb-previous-address)))                                       gdb-previous-address)))
1979            (progn            (progn
1980              ;; take previous disassemble command off the queue              ;; take previous disassemble command off the queue
1981              (with-current-buffer gud-comint-buffer              (with-current-buffer gud-comint-buffer
1982                (let ((queue (gdb-get-input-queue)) (item))                (let ((queue gdb-input-queue) (item))
1983                  (dolist (item queue)                  (dolist (item queue)
1984                    (if (equal (cdr item) '(gdb-assembler-handler))                    (if (equal (cdr item) '(gdb-assembler-handler))
1985                        (gdb-set-input-queue                        (setq gdb-input-queue
1986                         (delete item (gdb-get-input-queue)))))))                              (delete item gdb-input-queue))))))
1987              (gdb-enqueue-input              (gdb-enqueue-input
1988               (list (concat "server disassemble " gdb-current-address "\n")               (list (concat gdb-server-prefix "disassemble " gdb-current-address "\n")
1989                     'gdb-assembler-handler))                     'gdb-assembler-handler))
1990              (gdb-set-pending-triggers              (push 'gdb-invalidate-assembler gdb-pending-triggers)
              (cons 'gdb-invalidate-assembler  
                    (gdb-get-pending-triggers)))  
1991              (setq gdb-previous-address gdb-current-address)              (setq gdb-previous-address gdb-current-address)
1992              (setq gdb-previous-frame gdb-current-frame)))))))              (setq gdb-previous-frame gdb-current-frame)))))))
1993    
1994  (defun gdb-get-current-frame ()  (defun gdb-get-current-frame ()
1995    (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))    (if (not (member 'gdb-get-current-frame gdb-pending-triggers))
1996        (progn        (progn
1997          (gdb-enqueue-input          (gdb-enqueue-input
1998           (list (concat "server info frame\n") 'gdb-frame-handler))           (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler))
1999          (gdb-set-pending-triggers          (push 'gdb-get-current-frame
2000           (cons 'gdb-get-current-frame                 gdb-pending-triggers))))
                (gdb-get-pending-triggers))))))  
2001    
2002  (defun gdb-frame-handler ()  (defun gdb-frame-handler ()
2003    (gdb-set-pending-triggers    (setq gdb-pending-triggers
2004     (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))     (delq 'gdb-get-current-frame gdb-pending-triggers))
2005    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
2006      (goto-char (point-min))      (goto-char (point-min))
2007      (forward-line)      (forward-line)
2008      (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ")      (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ")
2009          (progn          (progn
2010            (setq gdb-current-frame (match-string 2))            (setq gdb-current-frame (match-string 2))
2011              (if (gdb-get-buffer 'gdb-locals-buffer)
2012                  (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
2013                    (setq mode-name (concat "Locals:" gdb-current-frame))))
2014            (let ((address (match-string 1)))            (let ((address (match-string 1)))
2015              ;; remove leading 0s from output of info frame command.              ;; remove leading 0s from output of info frame command.
2016              (if (string-match "^0+\\(.*\\)" address)              (if (string-match "^0+\\(.*\\)" address)

Legend:
Removed from v.1.4.2.7  
changed lines
  Added in v.1.4.2.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26