;; ====================================================================== ;; edb functions ;;; History of argument lists passed to edb. (defvar gud-edb-history nil) (defun gud-edb-massage-args (file args) (cons "--annotate=2" (cons file args))) ;; ;; In this world, there are edb instance objects (of unspecified ;; representation) and buffers associated with those objects. ;; ;; ;; edb-instance objects ;; (defun make-edb-instance (proc) "Create a edb instance object from a edb process." (setq last-proc proc) (let ((instance (cons 'edb-instance proc))) (save-excursion (set-buffer (process-buffer proc)) (setq edb-buffer-instance instance) (progn (mapcar 'make-variable-buffer-local edb-instance-variables) (setq edb-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-edb-buffer-instance))) (mapcar (function (lambda (b) (progn (set-buffer b) (if (eq dead edb-buffer-instance) (setq edb-buffer-instance instance))))) (buffer-list))))) instance)) (defun edb-instance-process (inst) (cdr inst)) ;;; The list of instance variables is built up by the expansions of ;;; DEF-EDB-VARIABLE ;;; (defvar edb-instance-variables '() "A list of variables that are local to the gud buffer associated with a edb instance.") (defmacro def-edb-variable (name accessor setter &optional default doc) (` (progn (defvar (, name) (, default) (, (or doc "undocumented"))) (if (not (memq '(, name) edb-instance-variables)) (setq edb-instance-variables (cons '(, name) edb-instance-variables))) (, (and accessor (` (defun (, accessor) (instance) (let ((buffer (edb-get-instance-buffer instance 'gud))) (and buffer (save-excursion (set-buffer buffer) (, name)))))))) (, (and setter (` (defun (, setter) (instance val) (let ((buffer (edb-get-instance-buffer instance 'gud))) (and buffer (save-excursion (set-buffer buffer) (setq (, name) val))))))))))) (defmacro def-edb-var (root-symbol &optional default doc) (let* ((root (symbol-name root-symbol)) (accessor (intern (concat "edb-instance-" root))) (setter (intern (concat "set-edb-instance-" root))) (var-name (intern (concat "edb-" root)))) (` (def-edb-variable (, var-name) (, accessor) (, setter) (, default) (, doc))))) (def-edb-var buffer-instance nil "In an instance buffer, the buffer's instance.") (def-edb-var buffer-type nil "One of the symbols bound in edb-instance-buffer-rules") (def-edb-var burst "" "A string of characters from edb that have not yet been processed.") (def-edb-var input-queue () "A list of high priority edb command objects.") (def-edb-var idle-input-queue () "A list of low priority edb command objects.") (def-edb-var prompting nil "True when edb is idle with no pending input.") (def-edb-var output-sink 'user "The disposition of the output of the current edb command. Possible values are these symbols: user -- edb output should be copied to the gud buffer for the user to see. inferior -- edb 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 gud mode sends to edb on its own behalf. post-emacs -- ignore input until the prompt annotation is received, then go to USER disposition. ") (def-edb-var current-item nil "The most recent command item sent to edb.") (def-edb-var pending-triggers '() "A list of trigger functions that have run later than their output handlers.") (defun in-edb-instance-context (instance form) "Funcall `form' in the gud buffer of `instance'" (save-excursion (set-buffer (edb-get-instance-buffer instance 'gud)) (funcall form))) ;; end of instance vars ;; ;; finding instances ;; (defun edb-proc->instance (proc) (save-excursion (set-buffer (process-buffer proc)) edb-buffer-instance)) (defun edb-mru-instance-buffer () "Return the most recently used (non-auxiliary) edb gud buffer." (save-excursion (edb-goto-first-edb-instance (buffer-list)))) (defun edb-goto-first-edb-instance (blist) "Use edb-mru-instance-buffer -- not this." (and blist (progn (set-buffer (car blist)) (or (and edb-buffer-instance (eq edb-buffer-type 'gud) (car blist)) (edb-goto-first-edb-instance (cdr blist)))))) (defun buffer-edb-instance (buf) (save-excursion (set-buffer buf) edb-buffer-instance)) (defun edb-needed-default-instance () "Return the most recently used edb instance or signal an error." (let ((buffer (edb-mru-instance-buffer))) (or (and buffer (buffer-edb-instance buffer)) (error "No instance of edb found.")))) (defun edb-instance-target-string (instance) "The apparent name of the program being debugged by a edb instance. For sure this the root string used in smashing together the gud buffer's name, even if that doesn't happen to be the name of a program." (in-edb-instance-context instance (function (lambda () gud-target-name)))) ;; ;; Instance Buffers. ;; ;; More than one buffer can be associated with a edb instance. ;; ;; 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 edb-get-create-instance-buffer and ;; named according to the rules set forth in the edb-instance-buffer-rules-assoc (defun edb-get-instance-buffer (instance key) "Return the instance buffer for `instance' tagged with type `key'. The key should be one of the cars in `edb-instance-buffer-rules-assoc'." (save-excursion (edb-look-for-tagged-buffer instance key (buffer-list)))) (defun edb-get-create-instance-buffer (instance key) "Create a new edb instance buffer of the type specified by `key'. The key should be one of the cars in `edb-instance-buffer-rules-assoc'." (or (edb-get-instance-buffer instance key) (let* ((rules (assoc key edb-instance-buffer-rules-assoc)) (name (funcall (edb-rules-name-maker rules) instance)) (new (get-buffer-create name))) (save-excursion (set-buffer new) (make-variable-buffer-local 'edb-buffer-type) (setq edb-buffer-type key) (make-variable-buffer-local 'edb-buffer-instance) (setq edb-buffer-instance instance) (if (cdr (cdr rules)) (funcall (car (cdr (cdr rules))))) new)))) (defun edb-rules-name-maker (rules) (car (cdr rules))) (defun edb-look-for-tagged-buffer (instance key bufs) (let ((retval nil)) (while (and (not retval) bufs) (set-buffer (car bufs)) (if (and (eq edb-buffer-instance instance) (eq edb-buffer-type key)) (setq retval (car bufs))) (setq bufs (cdr bufs)) ) retval)) (defun edb-instance-buffer-p (buf) (save-excursion (set-buffer buf) (and edb-buffer-type (not (eq edb-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 the new buffer with no arguments, should establish ;; the proper mode for the buffer. ;; (defvar edb-instance-buffer-rules-assoc '()) (defun edb-set-instance-buffer-rules (buffer-type &rest rules) (let ((binding (assoc buffer-type edb-instance-buffer-rules-assoc))) (if binding (setcdr binding rules) (setq edb-instance-buffer-rules-assoc (cons (cons buffer-type rules) edb-instance-buffer-rules-assoc))))) (edb-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). ;; (edb-set-instance-buffer-rules 'edb-partial-output-buffer 'edb-partial-output-name) (defun edb-partial-output-name (instance) (concat "*partial-output-" (edb-instance-target-string instance) "*")) (edb-set-instance-buffer-rules 'edb-inferior-io 'edb-inferior-io-name 'gud-inferior-io-mode) (defun edb-inferior-io-name (instance) (concat "*input/output of " (edb-instance-target-string instance) "*")) (defvar edb-inferior-io-mode-map (copy-keymap comint-mode-map)) (define-key edb-inferior-io-mode-map "\C-c\C-c" 'edb-inferior-io-interrupt) (define-key edb-inferior-io-mode-map "\C-c\C-z" 'edb-inferior-io-stop) (define-key edb-inferior-io-mode-map "\C-c\C-\\" 'edb-inferior-io-quit) (define-key edb-inferior-io-mode-map "\C-c\C-d" 'edb-inferior-io-eof) (defun gud-inferior-io-mode () "Major mode for gud inferior-io. \\{comint-mode-map}" ;; We want to use comint because it has various nifty and familiar ;; features. We don't need a process, but comint wants one, so create ;; a dummy one. (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1)) "/bin/cat") (setq major-mode 'gud-inferior-io-mode) (setq mode-name "Debuggee I/O") (setq comint-input-sender 'gud-inferior-io-sender) ) (defun gud-inferior-io-sender (proc string) (save-excursion (set-buffer (process-buffer proc)) (let ((instance edb-buffer-instance)) (set-buffer (edb-get-instance-buffer instance 'gud)) (let ((gud-proc (get-buffer-process (current-buffer)))) (process-send-string gud-proc string) (process-send-string gud-proc "\n") )) )) (defun edb-inferior-io-interrupt (instance) "Interrupt the program being debugged." (interactive (list (edb-needed-default-instance))) (interrupt-process (get-buffer-process (edb-get-instance-buffer instance 'gud)) comint-ptyp)) (defun edb-inferior-io-quit (instance) "Send quit signal to the program being debugged." (interactive (list (edb-needed-default-instance))) (quit-process (get-buffer-process (edb-get-instance-buffer instance 'gud)) comint-ptyp)) (defun edb-inferior-io-stop (instance) "Stop the program being debugged." (interactive (list (edb-needed-default-instance))) (stop-process (get-buffer-process (edb-get-instance-buffer instance 'gud)) comint-ptyp)) (defun edb-inferior-io-eof (instance) "Send end-of-file to the program being debugged." (interactive (list (edb-needed-default-instance))) (process-send-eof (get-buffer-process (edb-get-instance-buffer instance 'gud)))) ;; ;; edb communications ;; ;; INPUT: things sent to edb ;; ;; Each instance has a high and low priority ;; input queue. Low priority input is sent only ;; when the high priority queue is idle. ;; ;; The queues are lists. Each element is either ;; a string (indicating user or user-like input) ;; or a list of the form: ;; ;; (INPUT-STRING HANDLER-FN) ;; ;; ;; The handler function will be called from the ;; partial-output buffer when the command completes. ;; This is the way to write commands which ;; invoke edb commands autonomously. ;; ;; These lists are consumed tail first. ;; (defun edb-send (proc string) "A comint send filter for edb. This filter may simply queue output for a later time." (let ((instance (edb-proc->instance proc))) (edb-instance-enqueue-input instance (concat string "\n")))) ;; 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 edb commands to let ;; the user go first; it is not a bug. -t] ;; (defun edb-instance-enqueue-input (instance item) (if (edb-instance-prompting instance) (progn (edb-send-item instance item) (set-edb-instance-prompting instance nil)) (set-edb-instance-input-queue instance (cons item (edb-instance-input-queue instance))))) (defun edb-instance-dequeue-input (instance) (let ((queue (edb-instance-input-queue instance))) (and queue (if (not (cdr queue)) (let ((answer (car queue))) (set-edb-instance-input-queue instance '()) answer) (edb-take-last-elt queue))))) (defun edb-instance-enqueue-idle-input (instance item) (if (and (edb-instance-prompting instance) (not (edb-instance-input-queue instance))) (progn (edb-send-item instance item) (set-edb-instance-prompting instance nil)) (set-edb-instance-idle-input-queue instance (cons item (edb-instance-idle-input-queue instance))))) (defun edb-instance-dequeue-idle-input (instance) (let ((queue (edb-instance-idle-input-queue instance))) (and queue (if (not (cdr queue)) (let ((answer (car queue))) (set-edb-instance-idle-input-queue instance '()) answer) (edb-take-last-elt queue))))) ; Don't use this in general. (defun edb-take-last-elt (l) (if (cdr (cdr l)) (edb-take-last-elt (cdr l)) (let ((answer (car (cdr l)))) (setcdr l '()) answer))) ;; ;; output -- things edb prints to emacs ;; ;; EDB output is a stream interrupted by annotations. ;; Annotations can be recognized by their beginning ;; with \C-j\C-z\C-z\C-j ;; ;; The tag is a string obeying symbol syntax. ;; ;; The optional part `' can be either the empty string ;; or a space followed by more data relating to the annotation. ;; For example, the SOURCE annotation is followed by a filename, ;; line number and various useless goo. This data must not include ;; any newlines. ;; (defun gud-edb-marker-filter (string) "A gud marker filter for edb." ;; Bogons don't tell us the process except through scoping crud. (let ((instance (edb-proc->instance proc))) (edb-output-burst instance string))) (defvar edb-annotation-rules '(("frames-invalid" edb-invalidate-frames) ("breakpoints-invalid" edb-invalidate-breakpoints) ("pre-prompt" edb-pre-prompt) ("prompt" edb-prompt) ("commands" edb-subprompt) ("overload-choice" edb-subprompt) ("query" edb-subprompt) ("prompt-for-continue" edb-subprompt) ("post-prompt" edb-post-prompt) ("source" edb-source) ("starting" edb-starting) ("exited" edb-stopping) ("signalled" edb-stopping) ("signal" edb-stopping) ("breakpoint" edb-stopping) ("watchpoint" edb-stopping) ("stopped" edb-stopped) ("display-begin" edb-display-begin) ("display-end" edb-display-end) ("error-begin" edb-error-begin) ) "An assoc mapping annotation tags to functions which process them.") (defun edb-ignore-annotation (instance args) nil) (defconst edb-source-spec-regexp "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*") ;; Do not use this except as an annotation handler." (defun edb-source (instance args) (string-match edb-source-spec-regexp args) ;; Extract the frame position from the marker. (setq gud-last-frame (cons (substring args (match-beginning 1) (match-end 1)) (string-to-int (substring args (match-beginning 2) (match-end 2)))))) ;; An annotation handler for `prompt'. ;; This sends the next command (if any) to edb. (defun edb-prompt (instance ignored) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'user) t) ((eq sink 'post-emacs) (set-edb-instance-output-sink instance 'user)) (t (set-edb-instance-output-sink instance 'user) (error "Phase error in edb-prompt (got %s)" sink)))) (let ((highest (edb-instance-dequeue-input instance))) (if highest (edb-send-item instance highest) (let ((lowest (edb-instance-dequeue-idle-input instance))) (if lowest (edb-send-item instance lowest) (progn (set-edb-instance-prompting instance t) (gud-display-frame))))))) ;; An annotation handler for non-top-level prompts. (defun edb-subprompt (instance ignored) (let ((highest (edb-instance-dequeue-input instance))) (if highest (edb-send-item instance highest) (set-edb-instance-prompting instance t)))) (defun edb-send-item (instance item) (set-edb-instance-current-item instance item) (if (stringp item) (progn (set-edb-instance-output-sink instance 'user) (process-send-string (edb-instance-process instance) item)) (progn (edb-clear-partial-output instance) (set-edb-instance-output-sink instance 'pre-emacs) (process-send-string (edb-instance-process instance) (car item))))) ;; This terminates the collection of output from a previous ;; command if that happens to be in effect. (defun edb-pre-prompt (instance ignored) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'user) t) ((eq sink 'emacs) (set-edb-instance-output-sink instance 'post-emacs) (let ((handler (car (cdr (edb-instance-current-item instance))))) (save-excursion (set-buffer (edb-get-create-instance-buffer instance 'edb-partial-output-buffer)) (funcall handler)))) (t (set-edb-instance-output-sink instance 'user) (error "Output sink phase error 1."))))) ;; An annotation handler for `starting'. This says that I/O for the subprocess ;; is now the program being debugged, not EDB. (defun edb-starting (instance ignored) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'user) (set-edb-instance-output-sink instance 'inferior) ;; FIXME: need to send queued input ) (t (error "Unexpected `starting' annotation"))))) ;; An annotation handler for `exited' and other annotations which say that ;; I/O for the subprocess is now EDB, not the program being debugged. (defun edb-stopping (instance ignored) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'inferior) (set-edb-instance-output-sink instance 'user) ) (t (error "Unexpected stopping annotation"))))) ;; An annotation handler for `stopped'. It is just like edb-stopping, except ;; that if we already set the output sink to 'user in edb-stopping, that is ;; fine. (defun edb-stopped (instance ignored) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'inferior) (set-edb-instance-output-sink instance 'user) ) ((eq sink 'user) t) (t (error "Unexpected stopping annotation"))))) ;; An annotation handler for `post-prompt'. ;; This begins the collection of output from the current ;; command if that happens to be appropriate." (defun edb-post-prompt (instance ignored) (if (not (edb-instance-pending-triggers instance)) (progn (edb-invalidate-registers instance ignored) (edb-invalidate-locals instance ignored) (edb-invalidate-display instance ignored))) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'user) t) ((eq sink 'pre-emacs) (set-edb-instance-output-sink instance 'emacs)) (t (set-edb-instance-output-sink instance 'user) (error "Output sink phase error 3."))))) ;; Handle a burst of output from a edb 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 edb-output-burst (instance string) "Handle a burst of output from a edb instance. This function is (indirectly) used as a gud-marker-filter. It must return output (if any) to be insterted in the gud buffer." (save-match-data (let ( ;; Recall the left over burst from last time (burst (concat (edb-instance-burst instance) string)) ;; Start accumulating output for the gud buffer (output "")) ;; Process all the complete markers in this chunk. (while (string-match "\n\032\032\\(.*\\)\n" burst) (let ((annotation (substring burst (match-beginning 1) (match-end 1)))) ;; Stuff prior to the match is just ordinary output. ;; It is either concatenated to OUTPUT or directed ;; elsewhere. (setq output (edb-concat-output instance output (substring burst 0 (match-beginning 0)))) ;; Take that stuff off the burst. (setq burst (substring burst (match-end 0))) ;; Parse the tag from the annotation, and maybe its arguments. (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) (let* ((annotation-type (substring annotation (match-beginning 1) (match-end 1))) (annotation-arguments (substring annotation (match-beginning 2) (match-end 2))) (annotation-rule (assoc annotation-type edb-annotation-rules))) ;; Call the handler for this annotation. (if annotation-rule (funcall (car (cdr annotation-rule)) instance annotation-arguments) ;; Else the annotation is not recognized. Ignore it silently, ;; so that EDB 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 burst until we get more. (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" burst) (progn ;; Everything before the potential marker start can be output. (setq output (edb-concat-output instance output (substring burst 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq burst (substring burst (match-beginning 0)))) ;; In case we know the burst contains no partial annotations: (progn (setq output (edb-concat-output instance output burst)) (setq burst ""))) ;; Save the remaining burst for the next call to this function. (set-edb-instance-burst instance burst) output))) (defun edb-concat-output (instance so-far new) (let ((sink (edb-instance-output-sink instance))) (cond ((eq sink 'user) (concat so-far new)) ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) ((eq sink 'emacs) (edb-append-to-partial-output instance new) so-far) ((eq sink 'inferior) (edb-append-to-inferior-io instance new) so-far) (t (error "Bogon output sink %S" sink))))) (defun edb-append-to-partial-output (instance string) (save-excursion (buffer-disable-undo ; Don't need undo in partial output buffer (set-buffer (edb-get-create-instance-buffer instance 'edb-partial-output-buffer))) (goto-char (point-max)) (insert string))) (defun edb-clear-partial-output (instance) (save-excursion (set-buffer (edb-get-create-instance-buffer instance 'edb-partial-output-buffer)) (delete-region (point-min) (point-max)))) (defun edb-append-to-inferior-io (instance string) (save-excursion (set-buffer (edb-get-create-instance-buffer instance 'edb-inferior-io)) (goto-char (point-max)) (insert-before-markers string)) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-inferior-io))) (defun edb-clear-inferior-io (instance) (save-excursion (set-buffer (edb-get-create-instance-buffer instance 'edb-inferior-io)) (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. ;; ;; There are two aspects to this: edb 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 idle input queue and the output phasing associated with ;; the instance variable `(edb-instance-output-sink instance)' help ;; us to run commands behind the user's back. ;; ;; Below is the code for specificly managing buffers of output from one ;; command. ;; ;; The trigger function is suitable for use in the assoc EDB-ANNOTATION-RULES ;; It adds an idle input for the command we are tracking. It should be the ;; annotation rule binding of whatever edb sends to tell us this command ;; might have changed it's output. ;; ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. ;; EDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the ;; input in the input queue (see comment about ``edb communications'' above). (defmacro def-edb-auto-update-trigger (name demand-predicate edb-command output-handler) (` (defun (, name) (instance &optional ignored) (if (and ((, demand-predicate) instance) (not (member '(, name) (edb-instance-pending-triggers instance)))) (progn (edb-instance-enqueue-idle-input instance (list (, edb-command) '(, output-handler))) (set-edb-instance-pending-triggers instance (cons '(, name) (edb-instance-pending-triggers instance)))) )))) (defmacro def-edb-auto-update-handler (name trigger buf-key) (` (defun (, name) () (set-edb-instance-pending-triggers instance (delq '(, trigger) (edb-instance-pending-triggers instance))) (let ((buf (edb-get-instance-buffer instance '(, buf-key)))) (and buf (save-excursion (set-buffer buf) (buffer-disable-undo buf) ; don't need undo (let ((p (point)) (buffer-read-only nil) (instance-buf (edb-get-create-instance-buffer instance 'edb-partial-output-buffer))) (if (gud-buffers-differ buf instance-buf) (progn (delete-region (point-min) (point-max)) (insert-buffer instance-buf) (if (buffer-dedicated-frame) (fit-frame-to-buffer (buffer-dedicated-frame) buf)) )) (goto-char p)))))))) (defmacro def-edb-auto-updated-buffer (buffer-key trigger-name edb-command output-handler-name) (` (progn (def-edb-auto-update-trigger (, trigger-name) ;; The demand predicate: (lambda (instance) (edb-get-instance-buffer instance '(, buffer-key))) (, edb-command) (, output-handler-name)) (def-edb-auto-update-handler (, output-handler-name) (, trigger-name) (, buffer-key))))) ;; ;; Breakpoint buffers ;; ;; These display the output of `info breakpoints'. ;; (edb-set-instance-buffer-rules 'edb-breakpoints-buffer 'edb-breakpoints-buffer-name 'gud-breakpoints-mode) (def-edb-auto-updated-buffer edb-breakpoints-buffer ;; This defines the auto update rule for buffers of type ;; `edb-breakpoints-buffer'. ;; ;; It defines a function to serve as the annotation handler that ;; handles the `foo-invalidated' message. That function is called: edb-invalidate-breakpoints ;; To update the buffer, this command is sent to edb. "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: edb-info-breakpoints-handler) (defun edb-breakpoints-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*breakpoints of " (edb-instance-target-string instance) "*"))) (defun gud-display-breakpoints-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-breakpoints-buffer))) (defun gud-frame-breakpoints-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'edb-breakpoints-buffer))) (defvar gud-breakpoints-mode-map nil) (defvar gud-breakpoints-mode-menu '("EDB Breakpoint Commands" "----" ["Toggle" gud-toggle-bp-this-line t] ["Delete" gud-delete-bp-this-line t] ["Condition" gud-bp-condition t] ["Ignore" gud-bp-ignore t]) "*menu for gud-breakpoints-mode") (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) (define-key gud-breakpoints-mode-map "c" 'gud-bp-condition) (define-key gud-breakpoints-mode-map "i" 'gud-bp-ignore) (define-key gud-breakpoints-mode-map 'button3 'gud-breakpoints-popup-menu) (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) (require 'mode-motion) (setq mode-motion-hook 'gud-breakpoints-mode-motion-hook) (edb-invalidate-breakpoints edb-buffer-instance)) (defun gud-toggle-bp-this-line () (interactive) (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-breakpoints-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")) (error "Not recognized as breakpoint line (demo foo).") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat (if (eq ?y (char-after (match-beginning 2))) "server disable " "server enable ") (buffer-substring (match-beginning 0) (match-end 1)) "\n") '(lambda () nil))) ))) (defun gud-delete-bp-this-line () (interactive) (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-breakpoints-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")) (error "Not recognized as breakpoint line (demo foo).") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat "server delete " (buffer-substring (match-beginning 0) (match-end 1)) "\n") '(lambda () nil))) ))) (defun gud-bp-condition (condition) (interactive "sCondition for breakpoint: ") (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-breakpoints-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")) (error "Not recognized as breakpoint line (demo foo).") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat "server condition " (buffer-substring (match-beginning 0) (match-end 1)) (if (> (length condition) 0) (concat " " condition) "") "\n") '(lambda () nil))) (edb-invalidate-breakpoints edb-buffer-instance) ))) (defun gud-bp-ignore (count) (interactive "nNumber of times to ignore breakpoint: ") (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-breakpoints-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")) (error "Not recognized as breakpoint line (demo foo).") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat "server ignore " (buffer-substring (match-beginning 0) (match-end 1)) " " (int-to-string count) "\n") '(lambda () nil))) (edb-invalidate-breakpoints edb-buffer-instance) ))) (defun gud-breakpoints-mode-motion-hook (event) (gud-breakpoints-mode-motion-internal event "^[0-9]+[ \t]")) (defun gud-breakpoints-mode-motion-internal (event regexp) ;; ;; This is mostly ripped off from mode-motion-highlight-internal but ;; we set the extent's face rather than setting it to highlight. That ;; way if we're somewhere in the breakpoint's list of commands or other ;; info we still highlight it. (if (event-buffer event) (let* ((buffer (event-buffer event)) point) (save-excursion (set-buffer buffer) (mouse-set-point event) (beginning-of-line) (if (not (looking-at regexp)) (re-search-backward regexp (point-min) 't)) (setq point (point)) (if (looking-at regexp) (end-of-line)) (if (and mode-motion-extent (extent-buffer mode-motion-extent)) (if (eq point (point)) (delete-extent mode-motion-extent) (set-extent-endpoints mode-motion-extent point (point))) (if (eq point (point)) nil (setq mode-motion-extent (make-extent point (point))) (set-extent-property mode-motion-extent 'face (get-face 'highlight))))) ))) (defun gud-breakpoints-popup-menu (event) (interactive "@e") (mouse-set-point event) (popup-menu gud-breakpoints-mode-menu)) ;; ;; Display expression buffers ;; ;; These show the current list of expressions which the debugger ;; prints when the inferior stops and their values. Note that there ;; isn't a "display-invalid" annotation so we have to a bit more ;; work than for the other auto-update buffers ;; (edb-set-instance-buffer-rules 'edb-display-buffer 'edb-display-buffer-name 'gud-display-mode) (def-edb-auto-updated-buffer edb-display-buffer ;; This defines the auto update rule for buffers of type ;; `edb-display-buffer'. ;; ;; It defines a function to serve as the annotation handler that ;; handles the `foo-invalidated' message. That function is called: edb-invalidate-display ;; To update the buffer, this command is sent to edb. "server info display\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: edb-info-display-handler) ;; Since the displayed expressions buffer is not simply a copy of what edb ;; prints for the "info display" command we need a slightly more complex ;; handler for it than the standard one which def-edb-auto-updated-buffer ;; defines. (defun edb-info-display-handler () (set-edb-instance-pending-triggers instance (delq 'edb-invalidate-display (edb-instance-pending-triggers instance))) (let ((buf (edb-get-instance-buffer instance 'edb-display-buffer))) (and buf (save-excursion (let ((instance-buf (edb-get-create-instance-buffer instance 'edb-partial-output-buffer)) expr-alist point expr highlight-expr) (set-buffer instance-buf) (goto-char (point-min)) (while (re-search-forward "^\\([0-9]+\\): \\([ny] .*$\\)" (point-max) t) (setq expr-alist (cons (cons (buffer-substring (match-beginning 1) (match-end 1)) (buffer-substring (match-beginning 2) (match-end 2))) expr-alist))) (set-buffer buf) (setq buffer-read-only nil) (if (and mode-motion-extent (extent-buffer mode-motion-extent) (extent-start-position mode-motion-extent)) (progn (goto-char (extent-start-position mode-motion-extent)) (if (looking-at "^[0-9]+:") (setq highlight-expr (buffer-substring (match-beginning 0) (match-end 0)))))) (goto-char (point-min)) (delete-region (point-min) (if (not (re-search-forward "^\\([0-9]+\\): " (point-max) t)) (point-max) (beginning-of-line) (point))) (if (not expr-alist) (progn (insert "There are no auto-display expressions now.\n") (delete-region (point) (point-max))) (insert "Auto-display expressions now in effect: Num Enb Expression = value\n") (while (re-search-forward "^\\([0-9]+\\): \\([ny]\\)" (point-max) t) (if (setq expr (assoc (buffer-substring (match-beginning 1) (match-end 1)) expr-alist)) (progn (if (string-equal (substring (cdr expr) 0 1) "y") (replace-match "\\1: y") (replace-match (format "\\1: %s" (cdr expr))) (setq point (point)) (if (re-search-forward "^[0-9]+: " (point-max) 'move) (beginning-of-line)) (delete-region point (if (eobp) (point) (1- (point))))) (setq expr-alist (delq expr expr-alist))) (beginning-of-line) (setq point (point)) (if (re-search-forward "^[0-9]+: " (point-max) 'move 2) (beginning-of-line)) (delete-region point (point)))) (goto-char (point-max)) (while expr-alist (insert (concat (car (car expr-alist)) ": " (cdr (car expr-alist)) "\n" )) (setq expr-alist (cdr expr-alist))) ) (goto-char (point-min)) (if (and mode-motion-extent (extent-buffer mode-motion-extent) highlight-expr (re-search-forward (concat "^" highlight-expr ".*$") (point-max) t)) (set-extent-endpoints mode-motion-extent (match-beginning 0) (match-end 0))) (setq buffer-read-only t) (if (buffer-dedicated-frame) (fit-frame-to-buffer (buffer-dedicated-frame) buf)) ))))) (defvar gud-display-mode-map nil) (setq gud-display-mode-map (make-keymap)) (suppress-keymap gud-display-mode-map) (defvar gud-display-mode-menu '("EDB Display Commands" "----" ["Toggle enable" gud-toggle-disp-this-line t] ["Delete" gud-delete-disp-this-line t]) "*menu for gud-display-mode") (define-key gud-display-mode-map " " 'gud-toggle-disp-this-line) (define-key gud-display-mode-map "d" 'gud-delete-disp-this-line) (define-key gud-display-mode-map 'button3 'gud-display-popup-menu) (defun gud-display-mode () "Major mode for gud display. \\{gud-display-mode-map}" (setq major-mode 'gud-display-mode) (setq mode-name "Display") (setq buffer-read-only t) (use-local-map gud-display-mode-map) (require 'mode-motion) (setq mode-motion-hook 'gud-display-mode-motion-hook) (edb-invalidate-display edb-buffer-instance) ) (defun edb-display-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*Displayed expressions of " (edb-instance-target-string instance) "*"))) (defun gud-display-display-buffer (instance) (interactive (list (edb-needed-default-instance))) (let ((buf (edb-get-create-instance-buffer instance 'edb-display-buffer))) (edb-invalidate-display instance) (gud-display-buffer buf))) (defun gud-frame-display-buffer (instance) (interactive (list (edb-needed-default-instance))) (let ((buf (edb-get-create-instance-buffer instance 'edb-display-buffer))) (edb-invalidate-display instance) (gud-display-buffer-new-frame buf))) (defun gud-toggle-disp-this-line () (interactive) (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-display-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) (error "No expression on this line.") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat (if (eq ?y (char-after (match-beginning 2))) "server disable display " "server enable display ") (buffer-substring (match-beginning 0) (match-end 1)) "\n") '(lambda () nil))) ))) (defun gud-delete-disp-this-line () (interactive) (save-excursion (set-buffer (edb-get-instance-buffer edb-buffer-instance 'edb-display-buffer)) (if (key-press-event-p last-input-event) (beginning-of-line 1) (and mode-motion-extent (extent-buffer mode-motion-extent) (goto-char (extent-start-position mode-motion-extent)))) (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) (error "No expression on this line.") (edb-instance-enqueue-idle-input edb-buffer-instance (list (concat "server delete display " (buffer-substring (match-beginning 0) (match-end 1)) "\n") '(lambda () nil))) ))) (defun gud-display-mode-motion-hook (event) (gud-breakpoints-mode-motion-internal event "^[0-9]+: ")) (defun gud-display-popup-menu (event) (interactive "@e") (mouse-set-point event) (popup-menu gud-display-mode-menu)) ;; If we get an error whilst evaluating one of the expressions ;; we won't get the display-end annotation. Set the sink back to ;; user to make sure that the error message is seen (defun edb-error-begin (instance ignored) (set-edb-instance-output-sink instance 'user)) (defun edb-display-begin (instance ignored) (if (edb-get-instance-buffer instance 'edb-display-buffer) (progn (set-edb-instance-output-sink instance 'emacs) (edb-clear-partial-output instance)) (set-edb-instance-output-sink instance 'user)) ) (defun edb-display-end (instance ignored) (save-excursion (let ((display-output (edb-get-instance-buffer instance 'edb-display-buffer)) display-index display-value highlight-expr) (if display-output (progn (set-buffer (edb-get-instance-buffer instance 'edb-partial-output-buffer)) (goto-char (point-min)) (looking-at "\\([0-9]+\\): ") (setq display-index (buffer-substring (match-beginning 1) (match-end 1))) (setq display-value (+ 2 (match-end 1))) (set-buffer display-output) (if (and mode-motion-extent (extent-buffer mode-motion-extent) (extent-start-position mode-motion-extent)) (progn (goto-char (extent-start-position mode-motion-extent)) (if (looking-at "^[0-9]+:") (setq highlight-expr (buffer-substring (match-beginning 0) (match-end 0)))))) (setq buffer-read-only nil) (goto-char (point-min)) (if (not (re-search-forward (concat "^" display-index ": [ny] ") (point-max) 'move)) (insert (format "%s: y " display-index)) (goto-char (match-end 0)) (if (save-match-data (re-search-forward "^[0-9]+: " (point-max) 'move)) (beginning-of-line)) (delete-region (match-end 0) (point))) (insert-buffer-substring (edb-get-instance-buffer instance 'edb-partial-output-buffer) display-value) (goto-char (point-min)) (if (and mode-motion-extent (extent-buffer mode-motion-extent) highlight-expr (re-search-forward (concat "^" highlight-expr ".*$") (point-max) t)) (set-extent-endpoints mode-motion-extent (match-beginning 0) (match-end 0))) (setq buffer-read-only t) ))) (edb-clear-partial-output instance) (set-edb-instance-output-sink instance 'user) )) ;; ;; Frames buffers. These display a perpetually correct bactracktrace ;; (from the command `where'). ;; ;; Alas, if your stack is deep, they are costly. ;; (edb-set-instance-buffer-rules 'edb-stack-buffer 'edb-stack-buffer-name 'gud-frames-mode) (def-edb-auto-updated-buffer edb-stack-buffer edb-invalidate-frames "server where\n" edb-info-frames-handler) (defun edb-stack-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*stack frames of " (edb-instance-target-string instance) "*"))) (defun gud-display-stack-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-stack-buffer))) (defun gud-frame-stack-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'edb-stack-buffer))) (defvar gud-frames-mode-map nil) (setq gud-frames-mode-map (make-keymap)) (suppress-keymap gud-frames-mode-map) ;;; XEmacs change ;(define-key gud-frames-mode-map [mouse-2] ; 'gud-frames-select-by-mouse) (define-key gud-frames-mode-map [button2] '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) (edb-invalidate-frames edb-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 (edb-get-instance-buffer (edb-needed-default-instance) 'gud)) (gud-call "fr %p" selection) (gud-display-frame)))) ;; ;; Registers buffers ;; (def-edb-auto-updated-buffer edb-registers-buffer edb-invalidate-registers "server info registers\n" edb-info-registers-handler) (edb-set-instance-buffer-rules 'edb-registers-buffer 'edb-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) (edb-invalidate-registers edb-buffer-instance)) (defun edb-registers-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*registers of " (edb-instance-target-string instance) "*"))) (defun gud-display-registers-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-registers-buffer))) (defun gud-frame-registers-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'edb-registers-buffer))) ;; ;; Locals buffers ;; (def-edb-auto-updated-buffer edb-locals-buffer edb-invalidate-locals "server info locals\n" edb-info-locals-handler) (edb-set-instance-buffer-rules 'edb-locals-buffer 'edb-locals-buffer-name 'gud-locals-mode) (defvar gud-locals-mode-map nil) (setq gud-locals-mode-map (make-keymap)) (suppress-keymap gud-locals-mode-map) (defun gud-locals-mode () "Major mode for gud locals. \\{gud-locals-mode-map}" (setq major-mode 'gud-locals-mode) (setq mode-name "Locals") (setq buffer-read-only t) (use-local-map gud-locals-mode-map) (edb-invalidate-locals edb-buffer-instance)) (defun edb-locals-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*locals of " (edb-instance-target-string instance) "*"))) (defun gud-display-locals-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-locals-buffer))) (defun gud-frame-locals-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'edb-locals-buffer))) ;;;; ;;;; Put a friendly face on the EDB on-line help. ;;;; ;; Keymap for extents in the help buffer (setq edb-help-extent-map (make-keymap)) (suppress-keymap edb-help-extent-map) (define-key edb-help-extent-map 'button2 'edb-help-xref) (define-key edb-help-extent-map 'button3 'edb-help-popup-menu) ;; Keymap for elsewhere in the help buffer (setq edb-help-map (make-keymap)) (define-key edb-help-map 'button3 'edb-help-popup-menu) (defvar gud-help-menu '("EDB Help Topics" "----" ("Classes of EDB Commands" "----" ["running" (edb-help "running") t] ["stack" (edb-help "stack") t] ["data" (edb-help "data") t] ["breakpoints" (edb-help "breakpoints") t] ["files" (edb-help "files") t] ["status" (edb-help "status") t] ["support" (edb-help "support") t] ["user-defined" (edb-help "user-defined") t] ["aliases" (edb-help "aliases") t] ["obscure" (edb-help "obscure") t] ["internals" (edb-help "internals") t]) "----" ("Prefix Commands" "----" ["info" (edb-help "info") t] ["delete" (edb-help "delete") t] ["disable" (edb-help "disable") t] ["enable" (edb-help "enable") t] ["maintenance" (edb-help "maintenance") t] ["maintenance info" (edb-help "maintenance info") t] ["maintenance print" (edb-help "maintenance print") t] ["show" (edb-help "show") t] ["show check" (edb-help "show check") t] ["show history" (edb-help "show history") t] ["show print" (edb-help "show print") t] ["set" (edb-help "set") t] ["set check" (edb-help "set check") t] ["set history" (edb-help "set history") t] ["set print" (edb-help "set print") t] ["thread" (edb-help "thread") t] ["thread apply" (edb-help "thread apply") t] ["unset" (edb-help "unset") t]) ; Only if you build this into edb ; ("Duel" ; ["summary" (edb-help "duel help") t] ; ["ops" (edb-help "duel ops") t] ; ["examples" (edb-help "duel examples") t]) ) "*menu for edb-help") (defun edb-help-popup-menu (event) (interactive "@e") (mouse-set-point event) (popup-menu gud-help-menu)) (defun edb-help-xref (event) (interactive "e") (save-excursion (set-buffer (get-buffer (gettext "*Debugger Help*"))) (let ((extent (extent-at (event-point event)))) (edb-help (or (extent-property extent 'back-to) (buffer-substring (extent-start-position extent) (extent-end-position extent))) edb-help-topic) ))) (defun edb-help-info () (interactive) (require 'info) (Info-goto-node "(edb)Top")) ;; Format the help page. We lightly edit the EDB output to add instructions ;; on getting help on listed commands using the mouse rather than typing ;; "help" at edb. ;; ;; We're not trying to re-produce Info's or w3's navigational and cross ;; referencing here but just to put a simple mouse-driven front end over ;; EDB's help. ;; ;; The help buffer *ought* to be in edb-help-mode but we only ever create ;; one buffer so just setting a buffer local keymap should be good enough ;; for now. (defun edb-format-help-page nil (save-excursion (display-buffer (set-buffer (get-buffer-create (gettext "*Debugger Help*")))) (erase-buffer) (map-extents '(lambda (extent) (delete-extent extent) nil)) (use-local-map edb-help-map) (insert-buffer (edb-get-instance-buffer instance 'edb-partial-output-buffer)) (goto-char (point-min)) (forward-line 1) (while (re-search-forward "\\(^.*\\) -- .*$" (point-max) t) (let ((extent (make-extent (match-beginning 1) (match-end 1)))) (set-extent-property extent 'face (find-face 'bold)) (set-extent-property extent 'highlight t) (set-extent-property extent 'keymap edb-help-extent-map) )) ;; We use the message at the end of the help to distinguish between ;; help on a class of commands, help on a prefix command and help ;; on a command. (goto-char (point-min)) (cond ((looking-at "List of classes of commands:") ;; It's the list of classes (end-of-line) (insert " Click on a highlighted class to see the list of commands in that class.") ) ((and (not (looking-at "List of classes of commands:")) (re-search-forward "^Type \"help\" followed by command name" (point-max) t)) ;; It's help on a specific class (goto-char (point-min)) (insert "Help on ") (downcase-word 1) (end-of-line) (insert " Click on a highlighted command to see the help for that command or click ") (setq point (point)) (insert "here") (setq extent (make-extent point (point))) (set-extent-property extent 'back-to "") (insert " to see the list of classes of commands.\n") ) ((re-search-forward "^Type \"help.*subcommand" (point-max) t) ;; It's a prefix command (goto-char (point-min)) (insert (concat "Help on \"" edb-help-topic "\" - ")) (downcase-word 1) (end-of-line) (insert " Click on a highlighted topic to see the help for that topic or click ") (setq point (point)) (insert "here") (setq extent (make-extent point (point))) (string-match " ?[^ \t]*$" edb-help-topic) (if (equal "" (set-extent-property extent 'back-to (substring edb-help-topic 0 (match-beginning 0)))) (insert " to see the list of classes of commands.\n") (insert (concat " to see the help on " (extent-property extent 'back-to )))) ) (t ;; Must be an ordinary command (goto-char (point-min)) (insert (concat "Help on \"" edb-help-topic "\" - ")) (insert " Click ") (setq point (point)) (insert "here") (setq extent (make-extent point (point))) (if (equal "" (set-extent-property extent 'back-to edb-previous-help-topic)) (insert " to see the list of classes of commands.\n") (insert (concat " to see the help on " (extent-property extent 'back-to )))) ) ) (and extent (set-extent-property extent 'face (find-face 'bold)) (set-extent-property extent 'highlight t) (set-extent-property extent 'keymap edb-help-extent-map)) (setq fill-column 78) (fill-region (point-min) (point)) (insert "\n") )) (defun edb-help (topic &optional previous-topic) (interactive "sEdb Help Topic: ") (let ((instance (edb-needed-default-instance)) ) (save-excursion (set-buffer (get-buffer-create (gettext "*Debugger Help*"))) (make-variable-buffer-local 'edb-help-topic) (make-variable-buffer-local 'edb-previous-help-topic) (setq edb-help-topic topic) (setq edb-previous-help-topic (or previous-topic ""))) (edb-clear-partial-output instance) (edb-instance-enqueue-idle-input instance (list (concat "server " (if (string-match "^duel" topic) "" "help ") topic "\n") 'edb-format-help-page)))) ;;;; Menus and stuff (defun edb-install-menubar () "Installs the Edb menu at the menubar." ;; We can't define the menu at load-time because many of the functions ;; that we will call won't be bound then. (defvar edb-menu '("EDB Commands" "----" ("Help" ["info" edb-help-info t] "----" ["running -- Running the program" (edb-help "running") t] ["stack -- Examining the stack" (edb-help "stack") t] ["data -- Examining data" (edb-help "data") t] ["breakpoints -- Making program stop at certain points" (edb-help "breakpoints") t] ["files -- Specifying and examining files" (edb-help "files") t] ["status -- Status inquiries" (edb-help "status") t] ["support -- Support facilities" (edb-help "support") t] ["user-defined -- User-defined commands" (edb-help "user-defined") t] ["aliases -- Aliases of other commands" (edb-help "aliases") t] ["obscure -- Obscure features" (edb-help "obscure") t] ["internals -- Maintenance commands" (edb-help "internals") t] "---" ; Only if you build this into edb ; ["Duel summary" (edb-help "duel help") t] ; ["Duel ops" (edb-help "duel ops") t] ; ["Duel examples" (edb-help "duel examples") t] ) "---" ("New window showing" ["Local variables" gud-display-locals-buffer t] ["Displayed expressions" gud-display-display-buffer t] ["Breakpoints" gud-display-breakpoints-buffer t] ["Stack trace" gud-display-stack-buffer t] ["Machine registers" gud-display-registers-buffer t] ) ("New frame showing" ["Local variables" gud-frame-locals-buffer t] ["Displayed expressions" gud-frame-display-buffer t] ["Breakpoints" gud-frame-breakpoints-buffer t] ["Stack trace" gud-frame-stack-buffer t] ["Machine registers" gud-frame-registers-buffer t] ) "----" ["step" gud-step t] ["next" gud-next t] ["finish" gud-finish t] ["continue" gud-cont t] ["run" gud-run t] ) "*The menu for EDB mode.") (if (and (featurep 'menubar) current-menubar (not (assoc "Edb" current-menubar))) (progn (set-buffer-menubar (copy-sequence current-menubar)) (add-menu nil "Edb" (cdr edb-menu)))) ) (add-hook 'edb-mode-hook 'edb-install-menubar) (edb-set-instance-buffer-rules 'edb-command-buffer 'edb-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) ;;; XEmacs change ;(define-key gud-command-mode-map [mouse-2] 'gud-menu-pick) (define-key gud-command-mode-map [button2] '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 edb-command-buffer-name (instance) (save-excursion (set-buffer (process-buffer (edb-instance-process instance))) (concat "*menu of " (edb-instance-target-string instance) "*"))) (defun gud-display-command-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'edb-command-buffer) 6)) (defun gud-frame-command-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'edb-command-buffer))) (defun edb-call-showing-gud (instance command) (gud-display-gud-buffer instance) (comint-input-sender (edb-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 (edb-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 (edb-instance-process instance) command))) (defun gud-backtrace () (interactive) (let ((instance (edb-needed-default-instance))) (gud-display-gud-buffer instance) (apply comint-input-sender (list (edb-instance-process instance) "backtrace")))) (defun gud-frame () (interactive) (let ((instance (edb-needed-default-instance))) (apply comint-input-sender (list (edb-instance-process instance) "frame")))) (defun gud-return (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-needed-default-instance) (concat "return " (read-string "Expression to return: "))))) (gud-display-gud-buffer instance) (apply comint-input-sender (list (edb-instance-process instance) command))) (defun gud-file (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-core-file (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-cd (dir) (interactive "FChange EDB's default directory: ") (let ((instance (edb-needed-default-instance))) (save-excursion (set-buffer (edb-get-instance-buffer instance 'gud)) (cd dir)) (gud-display-gud-buffer instance) (apply comint-input-sender (list (edb-instance-process instance) (concat "cd " dir))))) (defun gud-exec-file (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-load (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-symbol-file (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-add-symbol-file (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-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 (edb-instance-process instance) command))) (defun gud-sharedlibrary (instance command) (interactive (let ((temp-buffer-show-function (function gud-temp-buffer-show))) (list (edb-needed-default-instance) (concat "sharedlibrary " (read-string "Load symbols for files matching regexp: "))))) (gud-display-gud-buffer instance) (apply comint-input-sender (list (edb-instance-process instance) command))) ;;;; Help ;;;; 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 edb-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 &optional size) (let ((must-split nil) (answer nil)) (save-excursion (unwind-protect (progn (walk-windows '(lambda (win) (if (gud-protected-buffer-p (window-buffer win)) (set-window-buffer-dedicated win (window-buffer win))))) (setq answer (get-buffer-window buf)) (if (not answer) (let ((window (get-lru-window))) (if (not (window-dedicated-p window)) (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-buffer-dedicated 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 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-display-buffer-new-frame (buf) (save-excursion (set-buffer buf) (let* ((buf-height (+ 4 (count-lines (point-min) (point-max)))) (frame-params (list (cons 'height buf-height))) ) ;; This is a hack so that we can re-size this window to occupy just as ;; much space is needed. (setq truncate-lines t) (set-buffer-dedicated-frame buf (make-frame frame-params))))) ;;; Shared keymap initialization: (defun gud-display-gud-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer (edb-get-create-instance-buffer instance 'gud))) (defun gud-frame-gud-buffer (instance) (interactive (list (edb-needed-default-instance))) (gud-display-buffer-new-frame (edb-get-create-instance-buffer instance 'gud))) (defun gud-edb-find-file (f) (find-file-noselect f)) ;;; XEmacs: don't autoload this yet since it's still buggy - use the ;;; one in edb.el instead (defun edb (command-line) "Run edb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive (list (read-shell-command "Run edb (like this): " (if (consp gud-edb-history) (car gud-edb-history) "edb ") '(gud-edb-history . 1)))) (gud-overload-functions '((gud-massage-args . gud-edb-massage-args) (gud-marker-filter . gud-edb-marker-filter) (gud-find-file . gud-edb-find-file) )) (let* ((words (gud-chop-words command-line)) (program (car words)) (file-word (let ((w (cdr words))) (while (and w (= ?- (aref (car w) 0))) (setq w (cdr w))) (car w))) (args (delq file-word (cdr words))) (file (and file-word (expand-file-name file-word))) (filepart (if file (file-name-nondirectory file) "")) (buffer-name (concat "*" "edb" (and (string< "" filepart) (concat "-" filepart)) "*"))) (setq edb-first-time (not (get-buffer-process buffer-name)))) (gud-common-init command-line "edb") (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-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-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.") (setq comint-prompt-regexp "^(.*edb[+]?) *") (setq comint-input-sender 'edb-send) (run-hooks 'edb-mode-hook) (let ((instance (make-edb-instance (get-buffer-process (current-buffer))) )) (if edb-first-time (edb-clear-inferior-io instance))) ) ;;;; ;;;; extracted `gdb functions' part from gud.el and changed all gdb to edb. ;;;; (provide 'gud-edb)