X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6858afd0c4acb9a214231f50aeab39cbcc5b3f17..b3be62d4c924fd8aa8b6fdfa96b03a015c586285:/lisp/progmodes/gdb-ui.el diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 5163471f47..f7ba72e172 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -1,6 +1,6 @@ ;;; gdb-ui.el --- User Interface for running GDB -;; Author: Nick Roberts +;; Author: Nick Roberts ;; Maintainer: FSF ;; Keywords: unix, tools @@ -25,23 +25,29 @@ ;;; Commentary: -;; This mode acts as a graphical user interface to GDB. You can interact with +;; This mode acts as a graphical user interface to GDB. You can interact with ;; GDB through the GUD buffer in the usual way, but there are also further ;; buffers which control the execution and describe the state of your program. ;; It separates the input/output of your program from that of GDB, if -;; required, and displays expressions and their current values in their own -;; buffers. It also uses features of Emacs 21 such as the display margin for -;; breakpoints, and the toolbar (see the GDB Graphical Interface section in -;; the Emacs info manual). +;; required, and watches expressions in the speedbar. It also uses features of +;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar +;; (see the GDB Graphical Interface section in the Emacs info manual). ;; Start the debugger with M-x gdba. ;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim -;; 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 ;; 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 '. +;; 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 '. 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,16 +59,55 @@ (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-frame nil) +(defvar gdb-current-stack-level 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.") -(defvar gdb-var-list nil "List of variables in watch window") +(defvar gdb-var-list nil "List of variables in watch window.") (defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") (defvar gdb-buffer-type nil) (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) +(defvar gdb-flush-pending-output nil) + +(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: + + `user' -- gdb output should be copied to the GUD buffer + for the user to see. + + `inferior' -- gdb output should be copied to the inferior-io buffer + + `pre-emacs' -- output should be ignored util the post-prompt + annotation is received. Then the output-sink + becomes:... + `emacs' -- output should be collected in the partial-output-buffer + for subsequent processing by a command. This is the + disposition of output generated by commands that + 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.") + +;; end of gdb variables ;;;###autoload (defun gdba (command-line) @@ -73,23 +118,34 @@ and source-file directory for your debugger. 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. +other with the source file with the main routine of the inferior. -If `gdb-many-windows' is t the layout below will appear -regardless of the value of `gdb-show-main' unless +If `gdb-many-windows' is t, regardless of the value of +`gdb-show-main', the layout below will appear unless `gdb-use-inferior-io-buffer' is nil when the source buffer -occupies the full width of the frame. Keybindings are given in +occupies the full width of the frame. Keybindings are given in relevant buffer. +Watch expressions appear in the speedbar/slowbar. + +The following commands help control operation : + +`gdb-many-windows' - Toggle the number of windows gdb uses. +`gdb-restore-windows' - To restore the window layout. + +See Info node `(emacs)GDB Graphical Interface' for a more +detailed description of this mode. + + --------------------------------------------------------------------- GDB Toolbar --------------------------------------------------------------------- -GUD buffer (I/O of GDB) | Locals buffer + GUD buffer (I/O of GDB) | Locals buffer | | | --------------------------------------------------------------------- -Source buffer | Input/Output (of debugee) buffer + Source buffer | Input/Output (of inferior) buffer | (comint-mode) | | @@ -98,28 +154,11 @@ Source buffer | Input/Output (of debugee) buffer | | --------------------------------------------------------------------- -Stack buffer | Breakpoints buffer + Stack buffer | Breakpoints buffer RET gdb-frames-select | SPC gdb-toggle-breakpoint | RET gdb-goto-breakpoint | d gdb-delete-breakpoint ---------------------------------------------------------------------- - -All the buffers share the toolbar and source should always display in the same -window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint -icons are displayed both by setting a break with gud-break and by typing break -in the GUD buffer. - -This works best (depending on the size of your monitor) using most of the -screen. - -Displayed expressions appear in separate frames. Arrays may be displayed -as slices and visualised using the graph program from plotutils if installed. -Pointers in structures may be followed in a tree-like fashion. - -The following interactive lisp functions help control operation : - -`gdb-many-windows' - Toggle the number of windows gdb uses. -`gdb-restore-windows' - To restore the window layout." +---------------------------------------------------------------------" ;; (interactive (list (gud-query-cmdline 'gdba))) ;; @@ -132,12 +171,14 @@ The following interactive lisp functions help control operation : (defcustom gdb-enable-debug-log nil "Non-nil means record the process input and output in `gdb-debug-log'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defcustom gdb-use-inferior-io-buffer nil "Non-nil means display output from the inferior in a separate buffer." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-ann3 () (setq gdb-debug-log nil) @@ -175,18 +216,23 @@ The following interactive lisp functions help control operation : (setq comint-input-sender 'gdb-send) ;; - ;; (re-)initialise + ;; (re-)initialize (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-current-frame nil) + (setq gdb-current-stack-level nil) (setq gdb-var-list nil) (setq gdb-var-changed nil) (setq gdb-first-prompt nil) + (setq gdb-prompting nil) + (setq gdb-input-queue nil) + (setq gdb-current-item nil) + (setq gdb-pending-triggers nil) + (setq gdb-output-sink 'user) + (setq gdb-server-prefix "server ") + (setq gdb-flush-pending-output nil) ;; - (mapc 'make-local-variable gdb-variables) (setq gdb-buffer-type 'gdba) ;; (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) @@ -202,10 +248,10 @@ The following interactive lisp functions help control operation : (run-hooks 'gdba-mode-hook)) (defcustom gdb-use-colon-colon-notation nil - "Non-nil means use FUNCTION::VARIABLE format to display variables in the -speedbar." + "If non-nil use FUN::VAR format to display variables in the speedbar." ; :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gud-watch () "Watch expression at point." @@ -213,16 +259,26 @@ speedbar." (require 'tooltip) (let ((expr (tooltip-identifier-from-point (point)))) (if (and (string-equal gdb-current-language "c") - gdb-use-colon-colon-notation) + 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 (concat "server interpreter mi \"-var-create - * " expr "\"\n") + (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))) + (select-window (get-buffer-window gud-comint-buffer 0))) + +(defun gdb-goto-info () + "Go to Emacs info node: GDB Graphical Interface." + (interactive) + (select-frame (make-frame)) + (require 'info) + (Info-goto-node "(emacs)GDB Graphical Interface")) (defconst gdb-var-create-regexp "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") @@ -255,7 +311,7 @@ speedbar." (goto-char (point-min)) (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) (catch 'var-found - (let ((var-list nil) (num 0)) + (let ((num 0)) (dolist (var gdb-var-list) (if (string-equal varnum (cadr var)) (progn @@ -306,12 +362,15 @@ speedbar." (setq gdb-var-list (nreverse var-list)))))) (defun gdb-var-update () - (if (not (member 'gdb-var-update (gdb-get-pending-triggers))) + (if (not (member 'gdb-var-update gdb-pending-triggers)) (progn - (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" + (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)) - (gdb-set-pending-triggers (cons 'gdb-var-update - (gdb-get-pending-triggers)))))) + (push 'gdb-var-update gdb-pending-triggers)))) (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"") @@ -321,12 +380,15 @@ speedbar." (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") + (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))))))) - (gdb-set-pending-triggers - (delq 'gdb-var-update (gdb-get-pending-triggers)))) + (setq gdb-pending-triggers + (delq 'gdb-var-update gdb-pending-triggers))) (defun gdb-var-delete () "Delete watched expression from the speedbar." @@ -339,8 +401,11 @@ speedbar." (varnum (cadr var))) (unless (string-match "\\." varnum) (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-delete " - varnum "\"\n") + (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) @@ -349,20 +414,24 @@ speedbar." (setq gdb-var-changed t)))))) (defun gdb-edit-value (text token indent) - "Assign a value to a variable displayed in the speedbar" + "Assign a value to a variable displayed in the speedbar." (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) (varnum (cadr var)) (value)) (setq value (read-string "New value: ")) (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-assign " - varnum " " value "\"\n") + (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 - "Non-nil means use font-lock-warning-face to display values that have -recently changed in the speedbar." + "If non-nil highlight values that have recently changed in the speedbar. +The highlighting is done with `font-lock-warning-face'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-speedbar-expand-node (text token indent) "Expand the node the user clicked on. @@ -370,77 +439,15 @@ TEXT is the text of the button we clicked on, a + or - item. 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)) + (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)))) - -;; ====================================================================== -;; -;; 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: - - user -- gdb output should be copied to the GUD buffer - for the user to see. - - inferior -- gdb output should be copied to the inferior-io buffer - - pre-emacs -- output should be ignored util the post-prompt - annotation is received. Then the output-sink - becomes:... - emacs -- output should be collected in the partial-output-buffer - for subsequent processing by a command. This is the - disposition of output generated by commands that - 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.") - -;; end of gdb variables - (defun gdb-get-target-string () (with-current-buffer gud-comint-buffer gud-target-name)) @@ -474,14 +481,14 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (name (funcall (gdb-rules-name-maker rules))) (new (get-buffer-create name))) (with-current-buffer new - ;; FIXME: This should be set after calling the function, since the - ;; function should run kill-all-local-variables. - (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) + (let ((trigger)) + (if (cdr (cdr rules)) + (setq trigger (funcall (car (cdr (cdr rules)))))) + (set (make-local-variable 'gdb-buffer-type) key) + (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) + (if trigger (funcall trigger))) new)))) (defun gdb-rules-name-maker (rules) (car (cdr rules))) @@ -548,7 +555,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (define-key map "\C-c\C-d" 'gdb-inferior-io-eof) map)) -(define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O" +(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 @@ -611,7 +618,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (defun gdb-send (proc string) "A comint send filter for gdb. -This filter may simply queue output for a later time." +This filter may simply queue input for a later time." (if gud-running (process-send-string proc (concat string "\n")) (gdb-enqueue-input (concat string "\n")))) @@ -620,20 +627,39 @@ This filter may simply queue output for a later time." ;; is a query, or other non-top-level prompt. (defun gdb-enqueue-input (item) - (if (gdb-get-prompting) + (if gdb-prompting (progn (gdb-send-item item) - (gdb-set-prompting nil)) - (gdb-set-input-queue - (cons item (gdb-get-input-queue))))) + (setq gdb-prompting nil)) + (push item gdb-input-queue))) (defun gdb-dequeue-input () - (let ((queue (gdb-get-input-queue))) + (let ((queue gdb-input-queue)) (and queue (let ((last (car (last queue)))) - (unless (nbutlast queue) (gdb-set-input-queue '())) + (unless (nbutlast queue) (setq gdb-input-queue '())) last)))) +(defun gdb-send-item (item) + (setq gdb-flush-pending-output nil) + (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) + (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))))) ;; ;; output -- things gdb prints to emacs @@ -654,7 +680,8 @@ This filter may simply queue output for a later time." (defcustom gud-gdba-command-name "gdb -annotate=3" "Default command to execute an executable under the GDB-UI debugger." :type 'string - :group 'gud) + :group 'gud + :version "21.4") (defvar gdb-annotation-rules '(("pre-prompt" gdb-pre-prompt) @@ -662,6 +689,8 @@ This filter may simply queue output for a later time." ("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) ("source" gdb-source) @@ -675,6 +704,14 @@ This filter may simply queue output for a later time." ("stopped" gdb-stopped) ) "An assoc mapping annotation tags to functions which process them.") +(defun gdb-resync() + (setq gdb-flush-pending-output t) + (setq gud-running nil) + (setq gdb-output-sink 'user) + (setq gdb-input-queue nil) + (setq gdb-pending-triggers nil) + (setq gdb-prompting t)) + (defconst gdb-source-spec-regexp "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") @@ -687,109 +724,108 @@ This filter may simply queue output for a later time." (match-string 1 args) (string-to-int (match-string 2 args)))) (setq gdb-current-address (match-string 3 args)) - (setq gdb-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))))) + ;; cover for auto-display output which comes *before* + ;; stopped annotation + (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) (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))) + "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) - (gdb-set-output-sink 'post-emacs)) + (setq gdb-output-sink 'post-emacs)) (t - (gdb-set-output-sink 'user) + (gdb-resync) (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))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) ((eq sink 'post-emacs) - (gdb-set-output-sink 'user) + (setq gdb-output-sink 'user) (let ((handler - (car (cdr (gdb-get-current-item))))) + (car (cdr gdb-current-item)))) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) (funcall handler)))) (t - (gdb-set-output-sink 'user) + (gdb-resync) (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) + (setq gdb-prompting t) (gud-display-frame))))) (defun gdb-subprompt (ignored) "An annotation handler for non-top-level prompts." - (gdb-set-prompting t)) + (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-get-output-sink))) + "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 - (gdb-set-output-sink 'inferior)))) - (t (error "Unexpected `starting' annotation"))))) + (setq gdb-output-sink 'inferior)))) + (t + (gdb-resync) + (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." + "An annotation handler for `exited' and other annotations. +They 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))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) - (gdb-set-output-sink 'user)) - (t (error "Unexpected stopping annotation")))))) + (setq gdb-output-sink 'user)) + (t + (gdb-resync) + (error "Unexpected stopping annotation")))))) (defun gdb-frame-begin (ignored) - (let ((sink (gdb-get-output-sink))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) - (gdb-set-output-sink 'user)) + (setq gdb-output-sink 'user)) ((eq sink 'user) t) ((eq sink 'emacs) t) - (t (error "Unexpected frame-begin annotation (%S)" sink))))) + (t + (gdb-resync) + (error "Unexpected frame-begin annotation (%S)" sink))))) (defun gdb-stopped (ignored) - "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." + "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))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) - (gdb-set-output-sink 'user)) + (setq gdb-output-sink 'user)) ((eq sink 'user) t) - (t (error "Unexpected stopped annotation"))))) + (t + (gdb-resync) + (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)) + "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) @@ -806,75 +842,77 @@ output from the current command if that happens to be appropriate." (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)))) (gdb-var-update)))) - (let ((sink (gdb-get-output-sink))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) ((eq sink 'pre-emacs) - (gdb-set-output-sink 'emacs)) + (setq gdb-output-sink 'emacs)) (t - (gdb-set-output-sink 'user) + (gdb-resync) (error "Phase error in gdb-post-prompt (got %s)" sink))))) (defun gud-gdba-marker-filter (string) - "A gud marker filter for gdb. Handle a burst of output from GDB." - (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) - ;; Recall the left over gud-marker-acc from last time - (setq gud-marker-acc (concat gud-marker-acc string)) - ;; Start accumulating output for the GUD buffer - (let ((output "")) - ;; - ;; Process all the complete markers in this chunk. - (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((annotation (match-string 1 gud-marker-acc))) - ;; - ;; Stuff prior to the match is just ordinary output. - ;; It is either concatenated to OUTPUT or directed - ;; elsewhere. - (setq output - (gdb-concat-output - output - (substring gud-marker-acc 0 (match-beginning 0)))) - ;; - ;; Take that stuff off the gud-marker-acc. - (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) - ;; - ;; Parse the tag from the annotation, and maybe its arguments. - (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) - (let* ((annotation-type (match-string 1 annotation)) - (annotation-arguments (match-string 2 annotation)) - (annotation-rule (assoc annotation-type - gdb-annotation-rules))) - ;; Call the handler for this annotation. - (if annotation-rule - (funcall (car (cdr annotation-rule)) - annotation-arguments) - ;; Else the annotation is not recognized. Ignore it silently, - ;; so that GDB can add new annotations without causing - ;; us to blow up. - )))) - ;; - ;; Does the remaining text end in a partial line? - ;; If it does, then keep part of the gud-marker-acc until we get more. - (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" - gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. + "A gud marker filter for gdb. Handle a burst of output from GDB." + (if gdb-flush-pending-output + nil + (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) + ;; Recall the left over gud-marker-acc from last time + (setq gud-marker-acc (concat gud-marker-acc string)) + ;; Start accumulating output for the GUD buffer + (let ((output "")) + ;; + ;; Process all the complete markers in this chunk. + (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) + (let ((annotation (match-string 1 gud-marker-acc))) + ;; + ;; Stuff prior to the match is just ordinary output. + ;; It is either concatenated to OUTPUT or directed + ;; elsewhere. (setq output - (gdb-concat-output output - (substring gud-marker-acc 0 - (match-beginning 0)))) + (gdb-concat-output + output + (substring gud-marker-acc 0 (match-beginning 0)))) ;; - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) + ;; Take that stuff off the gud-marker-acc. + (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) + ;; + ;; Parse the tag from the annotation, and maybe its arguments. + (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) + (let* ((annotation-type (match-string 1 annotation)) + (annotation-arguments (match-string 2 annotation)) + (annotation-rule (assoc annotation-type + gdb-annotation-rules))) + ;; Call the handler for this annotation. + (if annotation-rule + (funcall (car (cdr annotation-rule)) + annotation-arguments) + ;; Else the annotation is not recognized. Ignore it silently, + ;; so that GDB can add new annotations without causing + ;; us to blow up. + )))) ;; - ;; In case we know the gud-marker-acc contains no partial annotations: - (progn - (setq output (gdb-concat-output output gud-marker-acc)) - (setq gud-marker-acc ""))) - output)) + ;; Does the remaining text end in a partial line? + ;; If it does, then keep part of the gud-marker-acc until we get more. + (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" + gud-marker-acc) + (progn + ;; Everything before the potential marker start can be output. + (setq output + (gdb-concat-output output + (substring gud-marker-acc 0 + (match-beginning 0)))) + ;; + ;; Everything after, we save, to combine with later input. + (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) + ;; + ;; In case we know the gud-marker-acc contains no partial annotations: + (progn + (setq output (gdb-concat-output output gud-marker-acc)) + (setq gud-marker-acc ""))) + output))) (defun gdb-concat-output (so-far new) - (let ((sink (gdb-get-output-sink ))) + (let ((sink gdb-output-sink)) (cond ((eq sink 'user) (concat so-far new)) ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) @@ -884,7 +922,9 @@ output from the current command if that happens to be appropriate." ((eq sink 'inferior) (gdb-append-to-inferior-io new) so-far) - (t (error "Bogon output sink %S" sink))))) + (t + (gdb-resync) + (error "Bogon output sink %S" sink))))) (defun gdb-append-to-partial-output (string) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) @@ -936,19 +976,17 @@ output from the current command if that happens to be appropriate." `(defun ,name (&optional ignored) (if (and (,demand-predicate) (not (member ',name - (gdb-get-pending-triggers)))) + gdb-pending-triggers))) (progn (gdb-enqueue-input (list ,gdb-command ',output-handler)) - (gdb-set-pending-triggers - (cons ',name - (gdb-get-pending-triggers))))))) + (push ',name gdb-pending-triggers))))) (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) `(defun ,name () - (gdb-set-pending-triggers + (setq gdb-pending-triggers (delq ',trigger - (gdb-get-pending-triggers))) + gdb-pending-triggers)) (let ((buf (gdb-get-buffer ',buf-key))) (and buf (with-current-buffer buf @@ -1051,36 +1089,40 @@ static char *magick[] = { "PBM data used for disabled breakpoint icon.") (defvar breakpoint-enabled-icon nil - "Icon for enabled breakpoint in display margin") + "Icon for enabled breakpoint in display margin.") (defvar breakpoint-disabled-icon nil - "Icon for disabled breakpoint in display margin") + "Icon for disabled breakpoint in display margin.") -(defvar breakpoint-bitmap nil - "Bitmap for breakpoint in fringe") +;; Bitmap for breakpoint in fringe +(when (fboundp 'define-fringe-bitmap) + (define-fringe-bitmap 'breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")) (defface breakpoint-enabled-bitmap-face '((t :inherit fringe :foreground "red")) - "Face for enabled breakpoint icon in fringe.") + "Face for enabled breakpoint icon in fringe." + :group 'gud) (defface breakpoint-disabled-bitmap-face '((t :inherit fringe :foreground "grey60")) - "Face for disabled breakpoint icon in fringe.") + "Face for disabled breakpoint icon in fringe." + :group 'gud) ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) (defun gdb-info-breakpoints-custom () - (let ((flag)(address)) + (let ((flag)) ;; ;; remove all breakpoint-icons in source buffers but not assembler buffer (dolist (buffer (buffer-list)) (with-current-buffer buffer (if (and (eq gud-minor-mode 'gdba) - (not (string-match "^\*" (buffer-name)))) + (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) (gdb-remove-breakpoint-icons (point-min) (point-max))))) (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) (save-excursion @@ -1112,10 +1154,11 @@ static char *magick[] = { (save-excursion (goto-line (string-to-number line)) (gdb-put-breakpoint-icon (eq flag ?y))))))))) - (end-of-line)))))) + (end-of-line))))) + (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) (defun gdb-mouse-toggle-breakpoint (event) - "Toggle breakpoint with mouse click in left margin." + "Toggle breakpoint in left fringe/margin with mouse click." (interactive "e") (mouse-minibuffer-check event) (let ((posn (event-end event))) @@ -1124,9 +1167,8 @@ static char *magick[] = { (save-excursion (goto-char (posn-point posn)) (if (or (posn-object posn) - (and breakpoint-bitmap - (eq (car (fringe-bitmaps-at-pos (posn-point posn))) - breakpoint-bitmap))) + (eq (car (fringe-bitmaps-at-pos (posn-point posn))) + 'breakpoint)) (gud-remove nil) (gud-break nil))))))) @@ -1135,14 +1177,24 @@ static char *magick[] = { (concat "*breakpoints of " (gdb-get-target-string) "*"))) (defun gdb-display-breakpoints-buffer () + "Display status of user-settable breakpoints." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))) +(defconst gdb-frame-parameters + '((height . 14) (width . 80) + (unsplittable . t) + (tool-bar-lines . nil) + (menu-bar-lines . nil) + (minibuffer . nil))) + (defun gdb-frame-breakpoints-buffer () + "Display status of user-settable breakpoints in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-breakpoints-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer)))) (defvar gdb-breakpoints-mode-map (let ((map (make-sparse-keymap)) @@ -1155,6 +1207,7 @@ static char *magick[] = { (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) (define-key map " " 'gdb-toggle-breakpoint) (define-key map "d" 'gdb-delete-breakpoint) + (define-key map "q" 'kill-this-buffer) (define-key map "\r" 'gdb-goto-breakpoint) (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint) map)) @@ -1163,57 +1216,70 @@ static char *magick[] = { "Major mode for gdb breakpoints. \\{gdb-breakpoints-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-breakpoints-mode) (setq mode-name "Breakpoints") (use-local-map gdb-breakpoints-mode-map) (setq buffer-read-only t) - (gdb-invalidate-breakpoints)) + (run-mode-hooks 'gdb-breakpoints-mode-hook) + (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." (interactive) (save-excursion (beginning-of-line 1) - (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) - (error "Not recognized as break/watchpoint line") - (gdb-enqueue-input - (list - (concat - (if (eq ?y (char-after (match-beginning 2))) - "server disable " - "server enable ") - (match-string 1) "\n") - 'ignore))))) + (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)") + (looking-at + "\\([0-9]+\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\S-*:[0-9]+")) + (gdb-enqueue-input + (list + (concat gdb-server-prefix + (if (eq ?y (char-after (match-beginning 2))) + "disable " + "enable ") + (match-string 1) "\n") 'ignore)) + (error "Not recognized as break/watchpoint line")))) (defun gdb-delete-breakpoint () "Delete the breakpoint at current line." (interactive) (beginning-of-line 1) - (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)))) + (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)") + (looking-at + "\\([0-9]+\\)\\s-*\\S-*\\s-*\\S-*\\s-*.\\s-*\\S-*\\s-*\\S-*:[0-9]+")) + (gdb-enqueue-input + (list + (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore)) + (error "Not recognized as break/watchpoint line"))) (defun gdb-goto-breakpoint () - "Display the file in the source buffer at the breakpoint specified on the -current line." + "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))) - (save-selected-window - (gdb-display-buffer (find-file-noselect - (if (file-exists-p file) - file - (expand-file-name file gdb-cdir)))) - (goto-line (string-to-number line)))))) + (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + (looking-at ".*in\\s-+\\S-+\\s-+at\\s-+\\(\\S-*\\):\\([0-9]+\\)") + (looking-at + "[0-9]+\\s-*\\S-*\\s-*\\S-*\\s-*.\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")) + (let ((line (match-string 2)) + (file (match-string 1))) + (save-selected-window + (let* ((buf (find-file-noselect (if (file-exists-p file) + file + (expand-file-name file gdb-cdir)))) + (window (display-buffer buf))) + (with-current-buffer buf + (goto-line (string-to-number line)) + (set-window-point window (point)))))) + (error "Not recognized as break/watchpoint line")))) (defun gdb-mouse-goto-breakpoint (event) - "Display the file in the source buffer at the selected breakpoint." + "Display the breakpoint location that you click on." (interactive "e") (mouse-set-point event) (gdb-goto-breakpoint)) @@ -1244,9 +1310,8 @@ current line." '(mouse-face highlight help-echo "mouse-2, RET: Select frame")) (beginning-of-line) - (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") - (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) - (equal (match-string 1) gdb-current-frame)) + (when (and (looking-at "^#\\([0-9]+\\)") + (equal (match-string 1) gdb-current-stack-level)) (put-text-property (point-at-bol) (point-at-eol) 'face '(:inverse-video t))) (forward-line 1)))))) @@ -1256,18 +1321,22 @@ current line." (concat "*stack frames of " (gdb-get-target-string) "*"))) (defun gdb-display-stack-buffer () + "Display backtrace of current stack." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-stack-buffer))) (defun gdb-frame-stack-buffer () + "Display backtrace of current stack in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-stack-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-stack-buffer)))) (defvar gdb-frames-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) + (define-key map "q" 'kill-this-buffer) (define-key map "\r" 'gdb-frames-select) (define-key map [mouse-2] 'gdb-frames-mouse-select) map)) @@ -1276,30 +1345,32 @@ current line." "Major mode for gdb frames. \\{gdb-frames-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-frames-mode) (setq mode-name "Frames") (setq buffer-read-only t) (use-local-map gdb-frames-mode-map) (font-lock-mode -1) - (gdb-invalidate-frames)) + (run-mode-hooks 'gdb-frames-mode-hook) + (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)) + (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t)) (n (or (and pos (match-string-no-properties 1)) "0"))) n))) (defun gdb-frames-select () - "Make the frame on the current line become the current frame and display the -source in the source buffer." + "Select the frame and display the relevant source." (interactive) (gdb-enqueue-input - (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) + (list (concat gdb-server-prefix "frame " (gdb-get-frame-number) "\n") 'ignore)) (gud-display-frame)) (defun gdb-frames-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." + "Select the frame you click on and display the relevant source." (interactive "e") (mouse-set-point event) (gdb-frames-select)) @@ -1313,7 +1384,7 @@ the source buffer." (def-gdb-auto-updated-buffer gdb-threads-buffer gdb-invalidate-threads - "server info threads\n" + (concat gdb-server-prefix "info threads\n") gdb-info-threads-handler gdb-info-threads-custom) @@ -1332,18 +1403,22 @@ the source buffer." (concat "*threads of " (gdb-get-target-string) "*"))) (defun gdb-display-threads-buffer () + "Display IDs of currently known threads." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-threads-buffer))) (defun gdb-frame-threads-buffer () + "Display IDs of currently known threads in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-threads-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-threads-buffer)))) (defvar gdb-threads-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) + (define-key map "q" 'kill-this-buffer) (define-key map "\r" 'gdb-threads-select) (define-key map [mouse-2] 'gdb-threads-mouse-select) map)) @@ -1351,12 +1426,14 @@ the source buffer." (defun gdb-threads-mode () "Major mode for gdb frames. -\\{gdb-frames-mode-map}" +\\{gdb-threads-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-threads-mode) (setq mode-name "Threads") (setq buffer-read-only t) (use-local-map gdb-threads-mode-map) - (gdb-invalidate-threads)) + (run-mode-hooks 'gdb-threads-mode-hook) + 'gdb-invalidate-threads) (defun gdb-get-thread-number () (save-excursion @@ -1364,16 +1441,14 @@ the source buffer." (match-string-no-properties 1))) (defun gdb-threads-select () - "Make the thread on the current line become the current thread and display the -source in the source buffer." + "Select the thread and display the relevant source." (interactive) (gdb-enqueue-input (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) (gud-display-frame)) (defun gdb-threads-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." + "Select the thread you click on and display the relevant source." (interactive "e") (mouse-set-point event) (gdb-threads-select)) @@ -1387,7 +1462,7 @@ the source buffer." (def-gdb-auto-updated-buffer gdb-registers-buffer gdb-invalidate-registers - "server info registers\n" + (concat gdb-server-prefix "info registers\n") gdb-info-registers-handler gdb-info-registers-custom) @@ -1396,31 +1471,37 @@ the source buffer." (defvar gdb-registers-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - map)) + (define-key map "q" 'kill-this-buffer) + map)) (defun gdb-registers-mode () "Major mode for gdb registers. \\{gdb-registers-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-registers-mode) (setq mode-name "Registers") (setq buffer-read-only t) (use-local-map gdb-registers-mode-map) - (gdb-invalidate-registers)) + (run-mode-hooks 'gdb-registers-mode-hook) + 'gdb-invalidate-registers) (defun gdb-registers-buffer-name () (with-current-buffer gud-comint-buffer (concat "*registers of " (gdb-get-target-string) "*"))) (defun gdb-display-registers-buffer () + "Display integer register contents." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))) (defun gdb-frame-registers-buffer () + "Display integer register contents in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-registers-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer)))) ;; ;; Locals buffer. @@ -1438,8 +1519,8 @@ the source buffer." ;; 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))) + (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)) @@ -1467,76 +1548,63 @@ the source buffer." (defvar gdb-locals-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - map)) + (define-key map "q" 'kill-this-buffer) + map)) (defun gdb-locals-mode () "Major mode for gdb locals. \\{gdb-locals-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-locals-mode) - (setq mode-name "Locals") + (setq mode-name (concat "Locals:" gdb-current-frame)) (setq buffer-read-only t) (use-local-map gdb-locals-mode-map) - (gdb-invalidate-locals)) + (run-mode-hooks 'gdb-locals-mode-hook) + (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 (concat "*locals of " (gdb-get-target-string) "*"))) (defun gdb-display-locals-buffer () + "Display local variables of current stack and their values." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-locals-buffer))) (defun gdb-frame-locals-buffer () + "Display local variables of current stack and their values in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-locals-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-locals-buffer)))) ;;;; Window management - -;;; The way we abuse the dedicated-p flag is pretty gross, but seems -;;; to do the right thing. Seeing as there is no way for Lisp code to -;;; get at the use_time field of a window, I'm not sure there exists a -;;; more elegant solution without writing C code. - (defun gdb-display-buffer (buf &optional size) - (let ((must-split nil) - (answer nil)) - (unwind-protect - (progn - (walk-windows - #'(lambda (win) - (if (eq gud-comint-buffer (window-buffer win)) - (set-window-dedicated-p win t)))) - (setq answer (get-buffer-window buf)) - (if (not answer) - (let ((window (get-lru-window))) - (if window - (progn - (set-window-buffer window buf) - (setq answer window)) - (setq must-split t))))) - (walk-windows - #'(lambda (win) - (if (eq gud-comint-buffer (window-buffer win)) - (set-window-dedicated-p win nil))))) - (if must-split - (let* ((largest (get-largest-window)) - (cur-size (window-height largest)) - (new-size (and size (< size cur-size) (- cur-size size)))) - (setq answer (split-window largest new-size)) - (set-window-buffer answer buf))) - answer)) - -(defun gdb-display-source-buffer (buffer) - (if (eq gdb-selected-view 'source) - (progn - (gdb-display-buffer buffer) - (get-buffer-window buffer)) - (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer)) - nil)) + (let ((answer (get-buffer-window buf 0)) + (must-split nil)) + (if answer + (display-buffer buf) ;Raise the frame if necessary. + ;; The buffer is not yet displayed. + (pop-to-buffer gud-comint-buffer) ;Select the right frame. + (let ((window (get-lru-window))) + (if window + (progn + (set-window-buffer window buf) + (setq answer window)) + (setq must-split t))) + (if must-split + (let* ((largest (get-largest-window)) + (cur-size (window-height largest)) + (new-size (and size (< size cur-size) (- cur-size size)))) + (setq answer (split-window largest new-size)) + (set-window-buffer answer buf) + (set-window-dedicated-p answer t))) + answer))) ;;; Shared keymap initialization: @@ -1545,38 +1613,23 @@ the source buffer." (define-key gud-menu-map [frames] `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) - (define-key menu [locals] '("Locals" . gdb-frame-locals-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)) - (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) -; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-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 [locals] '("Locals" . gdb-display-locals-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)) - (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) -; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) -) - -(let ((menu (make-sparse-keymap "View"))) - (define-key gud-menu-map [view] - `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba))) -; (define-key menu [both] '(menu-item "Both" gdb-view-both -; :help "Display both source and assembler" -; :button (:radio . (eq gdb-selected-view 'both)))) - (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler - :help "Display assembler only" - :button (:radio . (eq gdb-selected-view 'assembler)))) - (define-key menu [source] '(menu-item "Source" gdb-view-source-function - :help "Display source only" - :button (:radio . (eq gdb-selected-view 'source))))) + (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))) (let ((menu (make-sparse-keymap "GDB-UI"))) (define-key gud-menu-map [ui] @@ -1589,39 +1642,29 @@ the source buffer." "Display locals, stack and breakpoint information"))) (defun gdb-frame-gdb-buffer () + "Display GUD buffer in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdba))) + (select-frame (make-frame gdb-frame-parameters)) + (switch-to-buffer (gdb-get-create-buffer 'gdba)) + (set-window-dedicated-p (selected-window) t)) (defun gdb-display-gdb-buffer () + "Display GUD buffer." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdba))) (defvar gdb-main-file nil "Source file from which program execution begins.") -(defun gdb-view-source-function () - (interactive) - (if gdb-view-source - (gdb-display-buffer - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file)))) - (setq gdb-selected-view 'source)) - -(defun gdb-view-assembler() - (interactive) - (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)) - (setq gdb-selected-view 'assembler)) - -;(defun gdb-view-both() -;(interactive) -;(setq gdb-selected-view 'both)) - (defcustom gdb-show-main nil "Nil means don't display source file containing the main routine." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") + +(defun gdb-set-window-buffer (name) + (set-window-buffer (selected-window) (get-buffer name)) + (set-window-dedicated-p (selected-window) t)) (defun gdb-setup-windows () "Layout the window pattern for gdb-many-windows." @@ -1630,39 +1673,38 @@ the source buffer." (delete-other-windows) (gdb-display-breakpoints-buffer) (delete-other-windows) - (switch-to-buffer gud-comint-buffer) + ; Don't dedicate. + (pop-to-buffer gud-comint-buffer) (split-window nil ( / ( * (window-height) 3) 4)) (split-window nil ( / (window-height) 3)) (split-window-horizontally) (other-window 1) - (switch-to-buffer (gdb-locals-buffer-name)) + (gdb-set-window-buffer (gdb-locals-buffer-name)) (other-window 1) (switch-to-buffer - (if (and gdb-view-source - (eq gdb-selected-view 'source)) (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file)) - (gdb-get-create-buffer 'gdb-assembler-buffer))) + (gud-find-file gdb-main-file))) (when gdb-use-inferior-io-buffer (split-window-horizontally) (other-window 1) - (switch-to-buffer (gdb-inferior-io-name))) + (gdb-set-window-buffer (gdb-inferior-io-name))) (other-window 1) - (switch-to-buffer (gdb-stack-buffer-name)) + (gdb-set-window-buffer (gdb-stack-buffer-name)) (split-window-horizontally) (other-window 1) - (switch-to-buffer (gdb-breakpoints-buffer-name)) + (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) (other-window 1)) (defcustom gdb-many-windows nil - "Nil (the default value) means 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. Non-nil means -display the layout shown for `gdba'." + "Nil 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) + :group 'gud + :version "21.4") (defun gdb-many-windows (arg) "Toggle the number of windows in the basic arrangement." @@ -1679,37 +1721,31 @@ display the layout shown for `gdba'." "Restore the basic arrangement of windows used by gdba. This arrangement depends on the value of `gdb-many-windows'." (interactive) - (if gdb-many-windows - (progn - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (gdb-setup-windows)) - (switch-to-buffer gud-comint-buffer) + (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. (delete-other-windows) + (if gdb-many-windows + (gdb-setup-windows) (split-window) (other-window 1) (switch-to-buffer - (if (and gdb-view-source - (eq gdb-selected-view 'source)) (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file)) - (gdb-get-create-buffer 'gdb-assembler-buffer))) + (gud-find-file gdb-main-file))) (other-window 1))) (defun gdb-reset () - "Exit a debugging session cleanly by killing the gdb buffers and resetting - the source buffers." + "Exit a debugging session cleanly. +Kills the gdb buffers and resets the source buffers." (dolist (buffer (buffer-list)) - (if (not (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) - (setq gud-minor-mode nil) - (kill-local-variable 'tool-bar-map) - (setq gud-running nil)))))) + (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) + (setq gud-minor-mode nil) + (kill-local-variable 'tool-bar-map) + (setq gud-running nil)))))) (when (markerp gdb-overlay-arrow-position) (move-marker gdb-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil)) @@ -1727,21 +1763,13 @@ buffers." (setq gdb-cdir (match-string 0)))) (if (search-forward "Located in " nil t) (if (looking-at "\\S-*") - (setq gdb-main-file (match-string 0))) - (setq gdb-view-source nil)) - (if gdb-many-windows + (setq gdb-main-file (match-string 0)))) + (if gdb-many-windows (gdb-setup-windows) (gdb-get-create-buffer 'gdb-breakpoints-buffer) - (when gdb-show-main - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (split-window) - (other-window 1) - (switch-to-buffer - (if gdb-view-source - (gud-find-file gdb-main-file) - (gdb-get-create-buffer 'gdb-assembler-buffer))) - (other-window 1)))) + (if gdb-show-main + (let ((pop-up-windows t)) + (display-buffer (gud-find-file gdb-main-file)))))) ;;from put-image (defun gdb-put-string (putstring pos &optional dprop) @@ -1780,22 +1808,17 @@ BUFFER nil or omitted means use the current buffer." (if (>= (car (window-fringes)) 8) (gdb-put-string nil (1+ start) - `(left-fringe - ,(or breakpoint-bitmap - (setq breakpoint-bitmap - (define-fringe-bitmap - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c"))) + `(left-fringe breakpoint ,(if enabled 'breakpoint-enabled-bitmap-face 'breakpoint-disabled-bitmap-face))) (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 0) + (set-window-margins + (get-buffer-window (current-buffer) 0) + left-margin-width right-margin-width)))) (put-image (if enabled (or breakpoint-enabled-icon @@ -1819,11 +1842,10 @@ BUFFER nil or omitted means use the current buffer." (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 0) + (set-window-margins + (get-buffer-window (current-buffer) 0) + left-margin-width right-margin-width)))) (gdb-put-string (if enabled "B" "b") (1+ start))))) (defun gdb-remove-breakpoint-icons (start end &optional remove-margin) @@ -1832,11 +1854,10 @@ BUFFER nil or omitted means use the current buffer." (remove-images start end)) (when remove-margin (setq left-margin-width 0) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 0) + (set-window-margins + (get-buffer-window (current-buffer) 0) + left-margin-width right-margin-width)))) ;; @@ -1848,7 +1869,7 @@ BUFFER nil or omitted means use the current buffer." (def-gdb-auto-updated-buffer gdb-assembler-buffer gdb-invalidate-assembler - (concat "server disassemble " gdb-current-address "\n") + (concat gdb-server-prefix "disassemble " gdb-current-address "\n") gdb-assembler-handler gdb-assembler-custom) @@ -1887,17 +1908,34 @@ BUFFER nil or omitted means use the current buffer." (if (re-search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y)))))))) (if (not (equal gdb-current-address "main")) - (set-window-point (get-buffer-window buffer) pos)))) + (set-window-point (get-buffer-window buffer 0) pos)))) (defvar gdb-assembler-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - map)) + (define-key map "q" 'kill-this-buffer) + map)) + +(defvar gdb-assembler-font-lock-keywords + '(;; <__function.name+n> + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + (1 font-lock-function-name-face)) + ;; 0xNNNNNNNN <__function.name+n>: opcode + ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)" + (4 font-lock-keyword-face)) + ;; %register(at least i386) + ("%\\sw+" . font-lock-variable-name-face) + ("^\\(Dump of assembler code for function\\) \\(.+\\):" + (1 font-lock-comment-face) + (2 font-lock-function-name-face)) + ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face)) + "Font lock keywords used in `gdb-assembler-mode'.") (defun gdb-assembler-mode () "Major mode for viewing code assembler. \\{gdb-assembler-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-assembler-mode) (setq mode-name "Machine") (setq gdb-overlay-arrow-position nil) @@ -1906,21 +1944,28 @@ BUFFER nil or omitted means use the current buffer." (setq fringes-outside-margins t) (setq buffer-read-only t) (use-local-map gdb-assembler-mode-map) - (gdb-invalidate-assembler)) + (gdb-invalidate-assembler) + (set (make-local-variable 'font-lock-defaults) + '(gdb-assembler-font-lock-keywords)) + (run-mode-hooks 'gdb-assembler-mode-hook) + 'gdb-invalidate-assembler) (defun gdb-assembler-buffer-name () (with-current-buffer gud-comint-buffer (concat "*Machine Code " (gdb-get-target-string) "*"))) (defun gdb-display-assembler-buffer () + "Display disassembly view." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))) (defun gdb-frame-assembler-buffer () + "Display disassembly view in a new frame." (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-assembler-buffer))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))) ;; modified because if gdb-current-address has changed value a new command ;; must be enqueued to update the buffer with the new output @@ -1929,62 +1974,59 @@ BUFFER nil or omitted means use the current buffer." (progn (unless (string-equal gdb-current-frame gdb-previous-frame) (if (or (not (member 'gdb-invalidate-assembler - (gdb-get-pending-triggers))) + 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-get-input-queue)) (item)) + (let ((queue gdb-input-queue)) (dolist (item queue) (if (equal (cdr item) '(gdb-assembler-handler)) - (gdb-set-input-queue - (delete item (gdb-get-input-queue))))))) + (setq gdb-input-queue + (delete item gdb-input-queue)))))) (gdb-enqueue-input - (list (concat "server disassemble " gdb-current-address "\n") + (list (concat gdb-server-prefix "disassemble " gdb-current-address "\n") 'gdb-assembler-handler)) - (gdb-set-pending-triggers - (cons 'gdb-invalidate-assembler - (gdb-get-pending-triggers))) + (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-get-pending-triggers))) + (if (not (member 'gdb-get-current-frame gdb-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)))))) + (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler)) + (push 'gdb-get-current-frame + gdb-pending-triggers)))) (defun gdb-frame-handler () - (gdb-set-pending-triggers - (delq 'gdb-get-current-frame (gdb-get-pending-triggers))) + (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)) + (if (looking-at "Stack level \\([0-9]+\\)") + (setq gdb-current-stack-level (match-string 1))) (forward-line) - (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*\\)") + (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) (setq gdb-current-address (concat "0x" (match-string 1 address))) (setq gdb-current-address (concat "0x" address)))) - (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t)) - (progn (setq gdb-view-source nil) t)) - (eq gdb-selected-view 'assembler)) - (progn - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-assembler-buffer)) + (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t)) ;;update with new frame for machine code if necessary - (gdb-invalidate-assembler)))))) + (gdb-invalidate-assembler))))) (if (re-search-forward " source language \\(\\S-*\\)\." nil t) (setq gdb-current-language (match-string 1)))) (provide 'gdb-ui) -;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 +;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 ;;; gdb-ui.el ends here