From e91c181625c9e9c5a666347576c54a9cd3c447fe Mon Sep 17 00:00:00 2001 From: Thomas Lord Date: Wed, 15 Jun 1994 00:28:50 +0000 Subject: New features. Less bugs. --- gdb/gdba.el | 1121 +++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 856 insertions(+), 265 deletions(-) (limited to 'gdb/gdba.el') diff --git a/gdb/gdba.el b/gdb/gdba.el index 0f15c1ca99..9b1fa52aca 100644 --- a/gdb/gdba.el +++ b/gdb/gdba.el @@ -171,7 +171,7 @@ we're in the GUD buffer)." (defun gud-gdb-massage-args (file args) (cons "--annotate=2" (cons file args))) - + ;; ;; In this world, there are gdb instance objects (of unspecified ;; representation) and buffers associated with those objects. @@ -183,18 +183,33 @@ we're in the GUD buffer)." (defun make-gdb-instance (proc) "Create a gdb instance object from a gdb process." + (setq last-proc proc) (let ((instance (cons 'gdb-instance proc))) (save-excursion (set-buffer (process-buffer proc)) - (if (not (equal gdb-buffer-instance instance)) - (progn - (mapcar 'make-variable-buffer-local gdb-instance-variables) - (setq gdb-buffer-instance instance) ; These are both... - (setq gdb-buffer-type 'gud)))) ; ...instance variables + (setq gdb-buffer-instance instance) + (progn + (mapcar 'make-variable-buffer-local gdb-instance-variables) + (setq gdb-buffer-type 'gud) + ;; If we're taking over the buffer of another process, + ;; take over it's ancillery buffers as well. + ;; + (let ((dead (or old-gdb-buffer-instance))) + (mapcar + (function + (lambda (b) + (progn + (set-buffer b) + (if (eq dead gdb-buffer-instance) + (setq gdb-buffer-instance instance))))) + (buffer-list))))) instance)) (defun gdb-instance-process (inst) (cdr inst)) +;;; The list of instance variables is built up by the expansions of +;;; DEF-GDB-VARIABLE +;;; (defvar gdb-instance-variables '() "A list of variables that are local to the gud buffer associated with a gdb instance.") @@ -254,7 +269,22 @@ with a gdb instance.") "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.") + "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. + + 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 + gud mode sends to gdb on its own behalf. + post-emacs -- ignore input 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.") @@ -315,37 +345,112 @@ program." instance (function (lambda () gud-target-name)))) + + +;; +;; Instance Buffers. +;; + ;; More than one buffer can be associated with a gdb instance. ;; -;; Each buffer has a TYPE -- an atom that identifies the function +;; Each buffer has a TYPE -- a symbol that identifies the function ;; of that particular buffer. ;; ;; The usual gud interaction buffer is given the type `gud' and ;; is constructed specially. ;; ;; Others are constructed by gdb-get-create-instance-buffer and -;; named according to the rules set forth here: +;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc + +(defun gdb-get-instance-buffer (instance key) + "Return the instance buffer for `instance' tagged with type `key'. +The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." + (save-excursion + (gdb-look-for-tagged-buffer instance key (buffer-list)))) + +(defun gdb-get-create-instance-buffer (instance key) + "Create a new gdb instance buffer of the type specified by `key'. +The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." + (or (gdb-get-instance-buffer instance key) + (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) + (name (funcall (gdb-rules-name-maker rules) instance)) + (new (get-buffer-create name))) + (save-excursion + (set-buffer new) + (make-variable-buffer-local 'gdb-buffer-type) + (setq gdb-buffer-type key) + (make-variable-buffer-local 'gdb-buffer-instance) + (setq gdb-buffer-instance instance) + (if (cdr (cdr rules)) + (funcall (car (cdr (cdr rules))))) + new)))) + +(defun gdb-rules-name-maker (rules) (car (cdr rules))) + +(defun gdb-look-for-tagged-buffer (instance key bufs) + (let ((retval nil)) + (while (and (not retval) bufs) + (set-buffer (car bufs)) + (if (and (eq gdb-buffer-instance instance) + (eq gdb-buffer-type key)) + (setq retval (car bufs))) + (setq bufs (cdr bufs)) + ) + retval)) + +(defun gdb-instance-buffer-p (buf) + (save-excursion + (set-buffer buf) + (and gdb-buffer-type + (not (eq gdb-buffer-type 'gud))))) + +;; +;; This assoc maps buffer type symbols to rules. Each rule is a list of +;; at least one and possible more functions. The functions have these +;; roles in defining a buffer type: +;; +;; NAME - take an instance, return a name for this type buffer for that +;; instance. +;; The remaining function(s) are optional: +;; +;; MODE - called in new new buffer with no arguments, should establish +;; the proper mode for the buffer. +;; + +(defvar gdb-instance-buffer-rules-assoc '()) + +(defun gdb-set-instance-buffer-rules (buffer-type &rest rules) + (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc))) + (if binding + (setcdr binding rules) + (setq gdb-instance-buffer-rules-assoc + (cons (cons buffer-type rules) + gdb-instance-buffer-rules-assoc))))) + +(gdb-set-instance-buffer-rules 'gud 'error) ; gud buffers are an exception to the rules + +;; +;; partial-output buffers +;; +;; These accumulate output from a command executed on +;; behalf of emacs (rather than the user). ;; -(defvar gdb-instance-buffer-rules-assoc - '((gud error) ; gud buffers construct specially - (gdb-partial-output-buffer - gdb-partial-output-name - ) - (gdb-registers-buffer - gdb-registers-buffer-name) - (gdb-breakpoints-buffer - gdb-breakpoints-buffer-name - gud-breakpoints-mode) - (gdb-frames-buffer - gdb-frames-buffer-name))) +(gdb-set-instance-buffer-rules 'gdb-partial-output-buffer + 'gdb-partial-output-name) +(defun gdb-partial-output-name (instance) + (concat "*partial-output-" + (gdb-instance-target-string instance) + "*")) + + ;; ;; gdb communications ;; -;; input: things sent to gdb +;; INPUT: things sent to gdb ;; ;; Each instance has a high and low priority ;; input queue. Low priority input is sent only @@ -360,6 +465,8 @@ program." ;; ;; The handler function will be called from the ;; partial-output buffer when the command completes. +;; This is the way to write commands which +;; invoke gdb commands autonomously. ;; ;; These lists are consumed tail first. ;; @@ -373,8 +480,12 @@ This filter may simply queue output for a later time." ;; Note: Stuff enqueued here will be sent to the next prompt, even if it ;; is a query, or other non-top-level prompt. To guarantee stuff will get ;; sent to the top-level prompt, currently it must be put in the idle queue. +;; ^^^^^^^^^ +;; [This should encourage gud extentions that invoke gdb commands to let +;; the user go first; it is not a bug. -t] +;; + (defun gdb-instance-enqueue-input (instance item) - "Enqueue an input item (a string or a list) for a gdb instance." (if (gdb-instance-prompting instance) (progn (gdb-send-item instance item) @@ -393,8 +504,8 @@ This filter may simply queue output for a later time." (gdb-take-last-elt queue))))) (defun gdb-instance-enqueue-idle-input (instance item) - "Enqueue idle input (a string or a list) for a gdb instance." - (if (gdb-instance-prompting instance) + (if (and (gdb-instance-prompting instance) + (not (gdb-instance-input-queue instance))) (progn (gdb-send-item instance item) (set-gdb-instance-prompting instance nil)) @@ -411,15 +522,15 @@ This filter may simply queue output for a later time." answer) (gdb-take-last-elt queue))))) +; Don't use this in general. (defun gdb-take-last-elt (l) - "Don't use this in general." (if (cdr (cdr l)) (gdb-take-last-elt (cdr l)) (let ((answer (car (cdr l)))) (setcdr l '()) answer))) - + ;; ;; output -- things gdb prints to emacs ;; @@ -464,8 +575,8 @@ This filter may simply queue output for a later time." (defconst gdb-source-spec-regexp "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*") +;; Do not use this except as an annotation handler." (defun gdb-source (instance args) - "Do not use this except as an annotation handler." (string-match gdb-source-spec-regexp args) ;; Extract the frame position from the marker. (setq gud-last-frame @@ -475,9 +586,9 @@ This filter may simply queue output for a later time." (match-beginning 2) (match-end 2)))))) +;; An annotation handler for `prompt'. +;; This sends the next command (if any) to gdb. (defun gdb-prompt (instance ignored) - "An annotation handler for `prompt'. -This sends the next command (if any) to gdb." (let ((sink (gdb-instance-output-sink instance))) (cond ((eq sink 'user) t) @@ -494,10 +605,12 @@ This sends the next command (if any) to gdb." (let ((lowest (gdb-instance-dequeue-idle-input instance))) (if lowest (gdb-send-item instance lowest) - (set-gdb-instance-prompting instance t)))))) + (progn + (set-gdb-instance-prompting instance t) + (gud-display-frame))))))) +;; An annotation handler for non-top-level prompts. (defun gdb-subprompt (instance ignored) - "An annotation handler for non-top-level prompts." (let ((highest (gdb-instance-dequeue-input instance))) (if highest (gdb-send-item instance highest) @@ -516,10 +629,10 @@ This sends the next command (if any) to gdb." (process-send-string (gdb-instance-process instance) (car item))))) +;; An annotation handler for `pre-prompt'. +;; This terminates the collection of output from a previous +;; command if that happens to be in effect. (defun gdb-pre-prompt (instance 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-instance-output-sink instance))) (cond ((eq sink 'user) t) @@ -538,10 +651,10 @@ command if that happens to be in effect." (set-gdb-instance-output-sink instance 'user) (error "Output sink phase error 2."))))) +;; An annotation handler for `post-prompt'. +;; This begins the collection of output from the current +;; command if that happens to be appropriate." (defun gdb-post-prompt (instance ignored) - "An annotation handler for `post-prompt'. -This begins the collection of output from the current -command if that happens to be appropriate." (gdb-invalidate-registers instance ignored) (let ((sink (gdb-instance-output-sink instance))) (cond @@ -557,103 +670,21 @@ command if that happens to be appropriate." (set-gdb-instance-output-sink instance 'user) (error "Output sink phase error 3."))))) - -(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) - (` - (defun (, name) (instance ignored) - (if (and ((, demand-predicate) instance) - (not (member '(, name) - (gdb-instance-pending-triggers instance)))) - (progn - (gdb-instance-enqueue-idle-input - instance - (list (, gdb-command) '(, output-handler))) - (set-gdb-instance-pending-triggers - instance - (cons '(, name) - (gdb-instance-pending-triggers instance)))))))) - -(defmacro def-gdb-auto-update-handler (name trigger buf-key) - (` - (defun (, name) () - (set-gdb-instance-pending-triggers - instance - (delq '(, trigger) - (gdb-instance-pending-triggers instance))) - (let ((buf (gdb-get-instance-buffer instance - '(, buf-key)))) - (and buf - (save-excursion - (set-buffer buf) - (let ((p (point))) - (delete-region (point-min) (point-max)) - (insert-buffer (gdb-get-create-instance-buffer - instance - 'gdb-partial-output-buffer)) - (goto-char p)))))))) - -(defmacro def-gdb-auto-updated-buffer - (buffer-key trigger-name gdb-command output-handler-name) - (` - (progn - (def-gdb-auto-update-trigger (, trigger-name) - ;; The demand predicate: - (lambda (instance) - (gdb-get-instance-buffer instance '(, buffer-key))) - (, gdb-command) - (, output-handler-name)) - (def-gdb-auto-update-handler (, output-handler-name) - (, trigger-name) (, buffer-key))))) - - - -(def-gdb-auto-updated-buffer gdb-breakpoints-buffer - ;; This defines the auto update rule for buffers of type - ;; `gdb-breakpoints-buffer'. - ;; - ;; It defines a function to serve as the annotation handler that - ;; handles the `foo-invalidated' message. That function is called: - gdb-invalidate-breakpoints - - ;; To update the buffer, this command is sent to gdb. - "server info breakpoints\n" - - ;; This also defines a function to be the handler for the output - ;; from the command above. That function will copy the output into - ;; the appropriately typed buffer. That function will be called: - gdb-info-breakpoints-handler) - -(def-gdb-auto-updated-buffer gdb-frames-buffer - gdb-invalidate-frames - "server where\n" - gdb-info-frames-handler) - - -(def-gdb-auto-updated-buffer gdb-registers-buffer - gdb-invalidate-registers - "server info registers\n" - gdb-info-registers-handler) - +;; A buffer-local indication of how output from an inferior gdb +;; should be directed. Legit values are: ;; -;; At any given time, output from gdb is being directed -;; one of three places. By default, it goes into the gdb -;; interaction buffer. For commands executed on behalf -;; of emacs, it goes into a scratch buffer (not `the'). -;; Finally, some gdb output is simply thrown away; for example, -;; the prompt that follows output from a command executed -;; for emacs. +;; USER -- the output should be appended to the gud +;; buffer. +;; +;; PRE-EMACS -- throw away output preceding output for emacs. +;; EMACS -- redirect output to the partial-output buffer. +;; POST-EMACS -- throw away output following output for emacs." ;; -(defvar gdb-output-sink 'user - "An buffer-local indication of how output from an inferior gdb -should be directed. Legit values are: - - USER -- the output should be appended to the gud - buffer. - - PRE-EMACS -- throw away output preceding output for emacs. - EMACS -- redirect output to the partial-output buffer. - POST-EMACS -- throw away output following output for emacs.") +;; Handle a burst of output from a gdb instance. +;; This function is (indirectly) used as a gud-marker-filter. +;; It must return output (if any) to be insterted in the gud +;; buffer. (defun gdb-output-burst (instance string) "Handle a burst of output from a gdb instance. @@ -740,7 +771,7 @@ buffer." ((eq sink 'emacs) (gdb-append-to-partial-output instance new) so-far) - (t (error "Bogon output sink %d" sink))))) + (t (error "Bogon output sink %S" sink))))) (defun gdb-append-to-partial-output (instance string) (save-excursion @@ -756,101 +787,110 @@ buffer." (gdb-get-create-instance-buffer instance 'gdb-partial-output-buffer)) (delete-region (point-min) (point-max)))) + + +;; One trick is to have a command who's output is always available in +;; a buffer of it's own, and is always up to date. We build several +;; buffers of this type. ;; -;; Instance Buffers. -;; -;; These are buffers that display output from gdb (or other -;; information) that we want to filter out from the general gdb -;; interaction buffer. (e.g. the backtrace buffer). +;; There are two aspects to this: gdb has to tell us when the output +;; for that command might have changed, and we have to be able to run +;; the command behind the user's back. ;; -;; The general pattern is that each kind of buffer is associated -;; with a rule to refresh its contents. The rule includes one -;; function to call when it is noticed that the buffer is out of -;; date. Typically, that will queue up an idle command for gdb. +;; The idle input queue and the output phasing associated with +;; the instance variable `(gdb-instance-output-sink instance)' help +;; us to run commands behind the user's back. ;; -;; Every type of instance buffer is identified by some atom -;; such as gdb-frames-buffer. An instance and one of these -;; atoms uniquely identifies a particular instance buffer. +;; Below is the code for specificly managing buffers of output from one +;; command. ;; -(defun gdb-get-instance-buffer (instance key) - "Return the instance buffer for `instance' tagged with type `key'. -The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." - (save-excursion - (gdb-look-for-tagged-buffer instance key (buffer-list)))) - -(defun gdb-get-create-instance-buffer (instance key) - "Create a new gdb instance buffer of the type specified by `key'. -The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." - (or (gdb-get-instance-buffer instance key) - (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) - (name (funcall (gdb-rules-name-maker rules) instance)) - (new (get-buffer-create name))) - (save-excursion - (set-buffer new) - (make-variable-buffer-local 'gdb-buffer-type) - (setq gdb-buffer-type key) - (make-variable-buffer-local 'gdb-buffer-instance) - (setq gdb-buffer-instance instance) - (if (cdr (cdr rules)) - (funcall (car (cdr (cdr rules))))) - new)))) -(defun gdb-rules-name-maker (rules) (car (cdr rules))) +;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES +;; It adds an idle input for the command we are tracking. It should be the +;; annotation rule binding of whatever gdb sends to tell us this command +;; might have changed it's output. +;; +;; NAME is the fucntion name. DEMAND-PREDICATE tests if output is really needed. +;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the +;; input in the input queue (see comment about ``gdb communications'' above). +(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) + (` + (defun (, name) (instance &optional ignored) + (if (and ((, demand-predicate) instance) + (not (member '(, name) + (gdb-instance-pending-triggers instance)))) + (progn + (gdb-instance-enqueue-idle-input + instance + (list (, gdb-command) '(, output-handler))) + (set-gdb-instance-pending-triggers + instance + (cons '(, name) + (gdb-instance-pending-triggers instance)))))))) + +(defmacro def-gdb-auto-update-handler (name trigger buf-key) + (` + (defun (, name) () + (set-gdb-instance-pending-triggers + instance + (delq '(, trigger) + (gdb-instance-pending-triggers instance))) + (let ((buf (gdb-get-instance-buffer instance + '(, buf-key)))) + (and buf + (save-excursion + (set-buffer buf) + (let ((p (point)) + (buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer (gdb-get-create-instance-buffer + instance + 'gdb-partial-output-buffer)) + (goto-char p)))))))) -(defun gdb-look-for-tagged-buffer (instance key bufs) - (let ((retval nil)) - (while (and (not retval) bufs) - (set-buffer (car bufs)) - (if (and (eq gdb-buffer-instance instance) - (eq gdb-buffer-type key)) - (setq retval (car bufs))) - (setq bufs (cdr bufs)) - ) - retval)) +(defmacro def-gdb-auto-updated-buffer + (buffer-key trigger-name gdb-command output-handler-name) + (` + (progn + (def-gdb-auto-update-trigger (, trigger-name) + ;; The demand predicate: + (lambda (instance) + (gdb-get-instance-buffer instance '(, buffer-key))) + (, gdb-command) + (, output-handler-name)) + (def-gdb-auto-update-handler (, output-handler-name) + (, trigger-name) (, buffer-key))))) -(defun gdb-instance-buffer-p (buf) - (save-excursion - (set-buffer buf) - (and gdb-buffer-type - (not (eq gdb-buffer-type 'gud))))) + ;; -;; partial-output buffers -;; -;; These accumulate output from a command executed on -;; behalf of emacs (rather than the user). When the -;; output is complete, the hooks bound to `gdb-command-complete-hooks' -;; are called (and then cleared). Usually these hooks are not -;; set directly but rather implicitly according to the -;; instance-buffer rules. +;; Breakpoint buffers +;; +;; These display the output of `info breakpoints'. ;; -(defun gdb-partial-output-name (instance) - (concat "*partial-output-" - (gdb-instance-target-string instance) - "*")) - -;; -;; Backtrace buffers -;; + +(gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer + 'gdb-breakpoints-buffer-name + 'gud-breakpoints-mode) -(defun gdb-frames-buffer-name (instance) - (save-excursion - (set-buffer (process-buffer (gdb-instance-process instance))) - (concat "*stack frames of " - (gdb-instance-target-string instance) "*"))) +(def-gdb-auto-updated-buffer gdb-breakpoints-buffer + ;; This defines the auto update rule for buffers of type + ;; `gdb-breakpoints-buffer'. + ;; + ;; It defines a function to serve as the annotation handler that + ;; handles the `foo-invalidated' message. That function is called: + gdb-invalidate-breakpoints -(defun gud-display-frames-buffer (instance) - (interactive (list (gdb-needed-default-instance))) - (gud-display-buffer - (gdb-get-create-instance-buffer instance - 'gdb-frames-buffer))) + ;; To update the buffer, this command is sent to gdb. + "server info breakpoints\n" -;; -;; Breakpoint buffers -;; + ;; This also defines a function to be the handler for the output + ;; from the command above. That function will copy the output into + ;; the appropriately typed buffer. That function will be called: + gdb-info-breakpoints-handler) (defun gdb-breakpoints-buffer-name (instance) (save-excursion @@ -863,6 +903,27 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." (gdb-get-create-instance-buffer instance 'gdb-breakpoints-buffer))) +(defun gud-frame-breakpoints-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-frame-buffer + (gdb-get-create-instance-buffer instance + 'gdb-breakpoints-buffer))) + +(defvar gud-breakpoints-mode-map nil) +(setq gud-breakpoints-mode-map (make-keymap)) +(suppress-keymap gud-breakpoints-mode-map) +(define-key gud-breakpoints-mode-map " " 'gud-toggle-bp-this-line) +(define-key gud-breakpoints-mode-map "d" 'gud-delete-bp-this-line) + +(defun gud-breakpoints-mode () + "Major mode for gud breakpoints. + +\\{gud-breakpoints-mode-map}" + (setq major-mode 'gud-breakpoints-mode) + (setq mode-name "Breakpoints") + (use-local-map gud-breakpoints-mode-map) + (setq buffer-read-only t) + (gdb-invalidate-breakpoints gdb-buffer-instance)) (defun gud-toggle-bp-this-line () (interactive) @@ -900,26 +961,111 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." '(lambda () nil))) ))) -(defvar gud-breakpoints-mode-map nil) -(defun gud-breakpoints-mode () - "Major mode for gud breakpoints. -\\{gud-breakpoints-mode-map}" - (setq major-mode 'gud-breakpoints-mode) - (setq mode-name "Breakpoints") - (use-local-map gud-breakpoints-mode-map)) + +;; +;; Frames buffers. These display a perpetually correct bactracktrace +;; (from the command `where'). +;; +;; Alas, if your stack is deep, they are costly. +;; + +(gdb-set-instance-buffer-rules 'gdb-stack-buffer + 'gdb-stack-buffer-name + 'gud-frames-mode) + +(def-gdb-auto-updated-buffer gdb-stack-buffer + gdb-invalidate-frames + "server where\n" + gdb-info-frames-handler) + +(defun gdb-stack-buffer-name (instance) + (save-excursion + (set-buffer (process-buffer (gdb-instance-process instance))) + (concat "*stack frames of " + (gdb-instance-target-string instance) "*"))) -(if gud-breakpoints-mode-map - nil - (setq gud-breakpoints-mode-map (make-sparse-keymap)) - (define-key gud-breakpoints-mode-map " " 'gud-toggle-bp-this-line) - (define-key gud-breakpoints-mode-map "d" 'gud-delete-bp-this-line)) +(defun gud-display-stack-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-display-buffer + (gdb-get-create-instance-buffer instance + 'gdb-stack-buffer))) + +(defun gud-frame-stack-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-frame-buffer + (gdb-get-create-instance-buffer instance + 'gdb-stack-buffer))) + +(defvar gud-frames-mode-map nil) +(setq gud-frames-mode-map (make-keymap)) +(suppress-keymap gud-frames-mode-map) +(define-key gud-frames-mode-map [mouse-2] + 'gud-frames-select-by-mouse) + +(defun gud-frames-mode () + "Major mode for gud frames. + +\\{gud-frames-mode-map}" + (setq major-mode 'gud-frames-mode) + (setq mode-name "Frames") + (setq buffer-read-only t) + (use-local-map gud-frames-mode-map) + (gdb-invalidate-frames gdb-buffer-instance)) + +(defun gud-get-frame-number () + (save-excursion + (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t)) + (n (or (and pos + (string-to-int + (buffer-substring (match-beginning 1) + (match-end 1)))) + 0))) + n))) + +(defun gud-frames-select-by-mouse (e) + (interactive "e") + (let (selection) + (save-excursion + (set-buffer (window-buffer (posn-window (event-end e)))) + (save-excursion + (goto-char (posn-point (event-end e))) + (setq selection (gud-get-frame-number)))) + (select-window (posn-window (event-end e))) + (save-excursion + (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gud)) + (gud-call "fr %p" selection) + (gud-display-frame)))) + ;; ;; Registers buffers ;; +(def-gdb-auto-updated-buffer gdb-registers-buffer + gdb-invalidate-registers + "server info registers\n" + gdb-info-registers-handler) + +(gdb-set-instance-buffer-rules 'gdb-registers-buffer + 'gdb-registers-buffer-name + 'gud-registers-mode) + +(defvar gud-registers-mode-map nil) +(setq gud-registers-mode-map (make-keymap)) +(suppress-keymap gud-registers-mode-map) + +(defun gud-registers-mode () + "Major mode for gud registers. + +\\{gud-registers-mode-map}" + (setq major-mode 'gud-registers-mode) + (setq mode-name "Registers") + (setq buffer-read-only t) + (use-local-map gud-registers-mode-map) + (gdb-invalidate-registers gdb-buffer-instance)) + (defun gdb-registers-buffer-name (instance) (save-excursion (set-buffer (process-buffer (gdb-instance-process instance))) @@ -931,51 +1077,488 @@ The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." (gdb-get-create-instance-buffer instance 'gdb-registers-buffer))) +(defun gud-frame-registers-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-frame-buffer + (gdb-get-create-instance-buffer instance + 'gdb-registers-buffer))) + + + +;;;; Menu windows: + + +;; MENU-LIST is ((option option option...) (option option ...)...) +;; +(defun gud-display-menu (menu-list) + (setq fill-column (min 120 (- (window-width) + (min 8 (window-width))))) + (while menu-list + (mapcar (function (lambda (x) (insert (symbol-name x) " "))) (car menu-list)) + (fill-paragraph nil) + (insert "\n\n") + (setq menu-list (cdr menu-list))) + (goto-char (point-min)) + (while (re-search-forward "\\([^ \n]+\\)\\(\n\\| \\)" nil t) + (put-text-property (match-beginning 1) (match-end 1) + 'mouse-face 'highlight)) + (goto-char (point-min))) + +(defun gud-goto-menu (menu) + (setq gud-menu-position menu) + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (gud-display-menu menu))) + +(defun gud-menu-pick (event) + "Choose an item from a gdb command menu." + (interactive "e") + (let (choice) + (save-excursion + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (let (beg end) + (skip-chars-forward "^ \t\n") + (setq end (point)) + (skip-chars-backward "^ \t\n") + (setq beg (point)) + (setq choice (buffer-substring beg end)) + (message choice) + (gud-invoke-menu (intern choice)))))) + +(defun gud-invoke-menu (symbol) + (let ((meaning (assoc symbol gud-menu-rules))) + (cond + ((and (consp meaning) + (consp (car (cdr meaning)))) + (gud-goto-menu (car (cdr meaning)))) + (meaning (call-interactively (car (cdr meaning))))))) + + + +(gdb-set-instance-buffer-rules 'gdb-command-buffer + 'gdb-command-buffer-name + 'gud-command-mode) + +(defvar gud-command-mode-map nil) +(setq gud-command-mode-map (make-keymap)) +(suppress-keymap gud-command-mode-map) +(define-key gud-command-mode-map [mouse-2] 'gud-menu-pick) + +(defun gud-command-mode () + "Major mode for gud menu. + +\\{gud-command-mode-map}" (interactive) (setq major-mode 'gud-command-mode) + (setq mode-name "Menu") (setq buffer-read-only t) (use-local-map + gud-command-mode-map) (make-variable-buffer-local 'gud-menu-position) + (if (not gud-menu-position) (gud-goto-menu gud-running-menu))) + +(defun gdb-command-buffer-name (instance) + (save-excursion + (set-buffer (process-buffer (gdb-instance-process instance))) + (concat "*menu of " (gdb-instance-target-string instance) "*"))) + +(defun gud-display-command-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-display-buffer + (gdb-get-create-instance-buffer instance + 'gdb-command-buffer) + 6)) + +(defun gud-frame-command-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-frame-buffer + (gdb-get-create-instance-buffer instance + 'gdb-command-buffer))) + +(defvar gud-selected-menu-titles ()) +(setq gud-selected-menu-titles + '(RUNNING STACK DATA BREAKPOINTS FILES)) + +(setq gud-running-menu + (list + '(RUNNING stack breakpoints files) + '(target run next step continue finish stepi kill help-running))) + +(setq gud-stack-menu + (list + '(running STACK breakpoints files) + '(up down frame backtrace return help-stack))) + +(setq gud-data-menu + (list + '(running stack DATA breakpoints files) + '(whatis ptype print set display undisplay disassemble help-data))) + +(setq gud-breakpoints-menu + (list + '(running stack BREAKPOINTS files) + '(awatch rwatch watch break delete enable disable condition ignore help-breakpoints))) + +(setq gud-files-menu + (list + '(running stack breakpoints FILES) + '(file core-file help-files) + '(exec-file load symbol-file add-symbol-file sharedlibrary))) + +(setq gud-menu-rules + (list + (list 'running gud-running-menu) + (list 'RUNNING gud-running-menu) + (list 'stack gud-stack-menu) + (list 'STACK gud-stack-menu) + (list 'data gud-data-menu) + (list 'DATA gud-data-menu) + (list 'breakpoints gud-breakpoints-menu) + (list 'BREAKPOINTS gud-breakpoints-menu) + (list 'files gud-files-menu) + (list 'FILES gud-files-menu) + + (list 'target 'gud-target) + (list 'kill 'gud-kill) + (list 'stepi 'gud-stepi) + (list 'step 'gud-step) + (list 'next 'gud-next) + (list 'finish 'gud-finish) + (list 'continue 'gud-cont) + (list 'run 'gud-run) + + (list 'backtrace 'gud-backtrace) + (list 'frame 'gud-frame) + (list 'down 'gud-down) + (list 'up 'gud-up) + (list 'return 'gud-return) + + (list 'file 'gud-file) + (list 'core-file 'gud-core-file) + (list 'cd 'gud-cd) + + (list 'exec-file 'gud-exec-file) + (list 'load 'gud-load) + (list 'symbol-file 'gud-symbol-file) + (list 'add-symbol-file 'gud-add-symbol-file) + (list 'sharedlibrary 'gud-sharedlibrary) + )) + + + +(defun gdb-call-showing-gud (instance command) + (gud-display-gud-buffer instance) + (comint-input-sender (gdb-instance-process instance) command)) + +(defvar gud-target-history ()) + +(defun gud-temp-buffer-show (buf) + (let ((ow (selected-window))) + (unwind-protect + (progn + (pop-to-buffer buf) + + ;; This insertion works around a bug in emacs. + ;; The bug is that all the empty space after a + ;; highlighted word that terminates a buffer + ;; gets highlighted. That's really ugly, so + ;; make sure a highlighted word can't ever + ;; terminate the buffer. + (goto-char (point-max)) + (insert "\n") + (goto-char (point-min)) + + (if (< (window-height) 10) + (enlarge-window (- 10 (window-height))))) + (select-window ow)))) + +(defun gud-target (instance command) + (interactive + (let* ((instance (gdb-needed-default-instance)) + (temp-buffer-show-function (function gud-temp-buffer-show)) + (target-name (completing-read (format "Target type: ") + '(("remote") + ("core") + ("child") + ("exec")) + nil + t + nil + 'gud-target-history))) + (list instance + (cond + ((equal target-name "child") "run") + + ((equal target-name "core") + (concat "target core " + (read-file-name "core file: " + nil + "core" + t))) + + ((equal target-name "exec") + (concat "target exec " + (read-file-name "exec file: " + nil + "a.out" + t))) + + ((equal target-name "remote") + (concat "target remote " + (read-file-name "serial line for remote: " + "/dev/" + "ttya" + t))) + + (t "echo No such target command!"))))) + + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + +(defun gud-backtrace () + (interactive) + (let ((instance (gdb-needed-default-instance))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) + "backtrace")))) + +(defun gud-frame () + (interactive) + (let ((instance (gdb-needed-default-instance))) + (apply comint-input-sender + (list (gdb-instance-process instance) + "frame")))) + +(defun gud-return (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "return " (read-string "Expression to return: "))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + + +(defun gud-file (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "file " (read-file-name "Executable to debug: " + nil + "a.out" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + +(defun gud-core-file (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "core " (read-file-name "Core file to debug: " + nil + "core-file" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + +(defun gud-cd (dir) + (interactive "FChange GDB's default directory: ") + (let ((instance (gdb-needed-default-instance))) + (save-excursion + (set-buffer (gdb-get-instance-buffer instance 'gud)) + (cd dir)) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) + (concat "cd " dir))))) + + +(defun gud-exec-file (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "exec-file " (read-file-name "Init memory from executable: " + nil + "a.out" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + +(defun gud-load (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "load " (read-file-name "Dynamicly load from file: " + nil + "a.out" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + +(defun gud-symbol-file (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "symbol-file " (read-file-name "Read symbol table from file: " + nil + "a.out" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + + +(defun gud-add-symbol-file (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "add-symbol-file " + (read-file-name "Add symbols from file: " + nil + "a.out" + t))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + + +(defun gud-sharedlibrary (instance command) + (interactive + (let ((temp-buffer-show-function (function gud-temp-buffer-show))) + (list (gdb-needed-default-instance) + (concat "sharedlibrary " + (read-string "Load symbols for files matching regexp: "))))) + (gud-display-gud-buffer instance) + (apply comint-input-sender + (list (gdb-instance-process instance) command))) + + + + + +;;;; Window management + + ;;; FIXME: This should only return true for buffers in the current instance (defun gud-protected-buffer-p (buffer) "Is BUFFER a buffer which we want to leave displayed?" (save-excursion (set-buffer buffer) - (or (eq gdb-buffer-type 'gdb-registers-buffer) - (eq gdb-buffer-type 'gdb-breakpoints-buffer) - (eq gdb-buffer-type 'gdb-frames-buffer) - (eq gdb-buffer-type 'gud)))) -;;; + (or gdb-buffer-type + overlay-arrow-position))) + ;;; 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 gud-display-buffer (buf) - (let ((must-split nil)) +(defun gud-display-buffer (buf &optional size) + (let ((must-split nil) + (answer nil)) (unwind-protect (progn (walk-windows '(lambda (win) (if (gud-protected-buffer-p (window-buffer win)) - (set-window-dedicated-p win t) - ))) - ;; This is more or less just the same as display-buffer; the - ;; big difference is that we split the largest window rather - ;; than the lru window. Various settings and hair which - ;; display-buffer has are omitted, for simplicity. - (if (not (get-buffer-window buf nil)) - (let ((window (get-lru-window nil))) + (set-window-dedicated-p win t)))) + (setq answer (get-buffer-window buf)) + (if (not answer) + (let ((window (get-lru-window))) (if window - (set-window-buffer window buf) - (setq must-split t) - ))) - ) - (walk-windows - '(lambda (win) - (if (gud-protected-buffer-p (window-buffer win)) - (set-window-dedicated-p win nil) - ))) - ) + (progn + (set-window-buffer window buf) + (setq answer window)) + (setq must-split t))))) + (walk-windows + '(lambda (win) + (if (gud-protected-buffer-p (window-buffer win)) + (set-window-dedicated-p win nil))))) (if must-split - (set-window-buffer (split-window (get-largest-window)) buf)) - )) + (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 existing-source-window (buffer) + (catch 'found + (save-excursion + (walk-windows + (function + (lambda (win) + (if (and overlay-arrow-position + (eq (window-buffer win) + (marker-buffer overlay-arrow-position))) + (progn + (set-window-buffer win buffer) + (throw 'found win)))))) + nil))) + +(defun gud-display-source-buffer (buffer) + (or (existing-source-window buffer) + (gud-display-buffer buffer))) + +(defun gud-frame-buffer (buf) + (save-excursion + (set-buffer buf) + (make-frame))) + + + +;;; Shared keymap initialization: + +(defun make-windows-menu (map) + (define-key map [menu-bar displays] + (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows"))) + (define-key map [menu-bar displays gdb] + '("Gdb" . gud-display-gud-buffer)) + (define-key map [menu-bar displays registers] + '("Registers" . gud-display-registers-buffer)) + (define-key map [menu-bar displays frames] + '("Stack" . gud-display-stack-buffer)) + (define-key map [menu-bar displays breakpoints] + '("Breakpoints" . gud-display-breakpoints-buffer)) + (define-key map [menu-bar displays commands] + '("Commands" . gud-display-command-buffer))) + +(defun gud-display-gud-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-display-buffer + (gdb-get-create-instance-buffer instance 'gud))) + +(make-windows-menu gud-breakpoints-mode-map) +(make-windows-menu gud-frames-mode-map) +(make-windows-menu gud-registers-mode-map) + + + +(defun make-frames-menu (map) + (define-key map [menu-bar frames] + (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames"))) + (define-key map [menu-bar frames gdb] + '("Gdb" . gud-frame-gud-buffer)) + (define-key map [menu-bar frames registers] + '("Registers" . gud-frame-registers-buffer)) + (define-key map [menu-bar frames frames] + '("Stack" . gud-frame-stack-buffer)) + (define-key map [menu-bar frames breakpoints] + '("Breakpoints" . gud-frame-breakpoints-buffer)) + (define-key map [menu-bar displays commands] + '("Commands" . gud-display-command-buffer))) + +(defun gud-frame-gud-buffer (instance) + (interactive (list (gdb-needed-default-instance))) + (gud-frame-buffer + (gdb-get-create-instance-buffer instance 'gud))) + +(make-frames-menu gud-breakpoints-mode-map) +(make-frames-menu gud-frames-mode-map) +(make-frames-menu gud-registers-mode-map) + (defun gud-gdb-find-file (f) (find-file-noselect f)) @@ -1003,11 +1586,13 @@ and source-file directory for your debugger." (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") + (gud-def gud-kill "kill" nil "Kill the program.") + (gud-def gud-run "run" nil "Run the program.") (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") + (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "cont" "\C-r" "Continue with display.") (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-cont "cont" "\C-r" "Continue with display.") (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") @@ -1385,7 +1970,7 @@ and source-file directory for your debugger." ;;; and the new prompt take its place. ;;; ;;; Not echoing the command is easy enough; you send it directly using -;;; process-send-string, and it never enters the buffer. However, +;;; comint-input-sender, and it never enters the buffer. However, ;;; getting rid of the old prompt is trickier; you don't want to do it ;;; when you send the command, since that will result in an annoying ;;; flicker as the prompt is deleted, redisplay occurs while Emacs @@ -1409,9 +1994,12 @@ and source-file directory for your debugger." (defvar gdbish-comint-mode-map (copy-keymap comint-mode-map)) (define-key gdbish-comint-mode-map "\C-c\M-\C-r" 'gud-display-registers-buffer) -(define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-frames-buffer) +(define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-stack-buffer) (define-key gdbish-comint-mode-map "\C-c\M-\C-b" 'gud-display-breakpoints-buffer) +(make-windows-menu gdbish-comint-mode-map) +(make-frames-menu gdbish-comint-mode-map) + (defun gud-mode () "Major mode for interacting with an inferior debugger process. @@ -1471,7 +2059,6 @@ comint mode, which see." (setq mode-name "Debugger") (setq mode-line-process '(": %s")) (use-local-map (copy-keymap gdbish-comint-mode-map)) - (make-local-variable 'gud-last-frame) (setq gud-last-frame nil) (make-local-variable 'comint-prompt-regexp) (make-local-variable 'gud-delete-prompt-marker) @@ -1521,9 +2108,12 @@ program.") (setq default-directory (file-name-directory file)) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") - (apply 'make-comint (concat "gud-" filepart) program nil - (gud-massage-args file args)) - (gud-mode) + (let ((old-instance gdb-buffer-instance)) + (apply 'make-comint (concat "gud-" filepart) program nil + (gud-massage-args file args)) + (gud-mode) + (make-variable-buffer-local 'old-gdb-buffer-instance) + (setq old-gdb-buffer-instance old-instance)) (make-variable-buffer-local 'gud-target-name) (setq gud-target-name filepart)) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) @@ -1606,7 +2196,7 @@ Obeying it means displaying in another window the specified file and line." (interactive) (if gud-last-frame (progn - (gud-set-buffer) +; (gud-set-buffer) (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) (setq gud-last-last-frame gud-last-frame gud-last-frame nil)))) @@ -1620,8 +2210,10 @@ Obeying it means displaying in another window the specified file and line." (defun gud-display-line (true-file line) (let* ((buffer (gud-find-file true-file)) - (window (gud-display-buffer buffer)) + (window (gud-display-source-buffer buffer)) (pos)) + (if (not window) + (error "foo bar baz")) ;;; (if (equal buffer (current-buffer)) ;;; nil ;;; (setq buffer-read-only nil)) @@ -1720,8 +2312,7 @@ Obeying it means displaying in another window the specified file and line." "Invoke the debugger COMMAND displaying source in other window." (interactive) (gud-set-buffer) - (let ((command (concat command "\n")) - (proc (get-buffer-process gud-comint-buffer))) + (let ((proc (get-buffer-process gud-comint-buffer))) ;; Arrange for the current prompt to get deleted. (save-excursion @@ -1729,8 +2320,8 @@ Obeying it means displaying in another window the specified file and line." (goto-char (process-mark proc)) (beginning-of-line) (if (looking-at comint-prompt-regexp) - (set-marker gud-delete-prompt-marker (point)))) - (process-send-string proc command))) + (set-marker gud-delete-prompt-marker (point))) + (apply comint-input-sender (list proc command))))) (defun gud-refresh (&optional arg) "Fix up a possibly garbled display, and redraw the arrow." -- cgit v1.2.1