;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; Commentary:
user -- gdb output should be copied to the gud buffer
for the user to see.
+ inferior -- gdb output should be copied to the inferior-io buffer
+
pre-emacs -- output should be ignored util the post-prompt
annotation is received. Then the output-sink
becomes:...
"*"))
\f
+(gdb-set-instance-buffer-rules 'gdb-inferior-io
+ 'gdb-inferior-io-name
+ 'gud-inferior-io-mode)
+
+(defun gdb-inferior-io-name (instance)
+ (concat "*input/output of "
+ (gdb-instance-target-string instance)
+ "*"))
+
+(defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
+(define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
+(define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)
+(define-key comint-mode-map "\C-c\C-\\" 'gdb-inferior-io-quit)
+(define-key comint-mode-map "\C-c\C-d" 'gdb-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 gdb-buffer-instance))
+ (set-buffer (gdb-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 gdb-inferior-io-interrupt (instance)
+ "Interrupt the program being debugged."
+ (interactive (list (gdb-needed-default-instance)))
+ (interrupt-process
+ (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
+
+(defun gdb-inferior-io-quit (instance)
+ "Send quit signal to the program being debugged."
+ (interactive (list (gdb-needed-default-instance)))
+ (quit-process
+ (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
+
+(defun gdb-inferior-io-stop (instance)
+ "Stop the program being debugged."
+ (interactive (list (gdb-needed-default-instance)))
+ (stop-process
+ (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
+
+(defun gdb-inferior-io-eof (instance)
+ "Send end-of-file to the program being debugged."
+ (interactive (list (gdb-needed-default-instance)))
+ (process-send-eof
+ (get-buffer-process (gdb-get-instance-buffer instance 'gud))))
+\f
;;
;; gdb communications
("prompt-for-continue" gdb-subprompt)
("post-prompt" gdb-post-prompt)
("source" gdb-source)
+ ("starting" gdb-starting)
+ ("exited" gdb-stopping)
+ ("signalled" gdb-stopping)
+ ("signal" gdb-stopping)
+ ("breakpoint" gdb-stopping)
+ ("watchpoint" gdb-stopping)
+ ("stopped" gdb-stopped)
)
"An assoc mapping annotation tags to functions which process them.")
((eq sink 'user) t)
((eq sink 'post-emacs)
(set-gdb-instance-output-sink instance 'user))
- ((or (eq sink 'emacs)
- (eq sink 'pre-emacs))
+ (t
(set-gdb-instance-output-sink instance 'user)
- (error "Phase error in gdb-prompt (got %s)" sink))
- (t (set-gdb-instance-output-sink instance 'user))))
+ (error "Phase error in gdb-prompt (got %s)" sink))))
(let ((highest (gdb-instance-dequeue-input instance)))
(if highest
(gdb-send-item instance highest)
(set-buffer (gdb-get-create-instance-buffer
instance 'gdb-partial-output-buffer))
(funcall handler))))
- ((eq sink 'pre-emacs)
+ (t
(set-gdb-instance-output-sink instance 'user)
- (error "Output sink phase error 1."))
- ((eq sink 'post-emacs)
+ (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 GDB.
+(defun gdb-starting (instance ignored)
+ (let ((sink (gdb-instance-output-sink instance)))
+ (cond
+ ((eq sink 'user)
+ (set-gdb-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 GDB, not the program being debugged.
+(defun gdb-stopping (instance ignored)
+ (let ((sink (gdb-instance-output-sink instance)))
+ (cond
+ ((eq sink 'inferior)
(set-gdb-instance-output-sink instance 'user)
- (error "Output sink phase error 2.")))))
+ )
+ (t (error "Unexpected stopping annotation")))))
+
+;; An annotation handler for `stopped'. It is just like gdb-stopping, except
+;; that if we already set the output sink to 'user in gdb-stopping, that is
+;; fine.
+(defun gdb-stopped (instance ignored)
+ (let ((sink (gdb-instance-output-sink instance)))
+ (cond
+ ((eq sink 'inferior)
+ (set-gdb-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
((eq sink 'pre-emacs)
(set-gdb-instance-output-sink instance 'emacs))
- ((eq sink 'emacs)
- (set-gdb-instance-output-sink instance 'user)
- (error "Output sink phase error 3."))
-
- ((eq sink 'post-emacs)
+ (t
(set-gdb-instance-output-sink instance 'user)
(error "Output sink phase error 3.")))))
-;; A 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
((eq sink 'emacs)
(gdb-append-to-partial-output instance new)
so-far)
+ ((eq sink 'inferior)
+ (gdb-append-to-inferior-io instance new)
+ so-far)
(t (error "Bogon output sink %S" sink)))))
(defun gdb-append-to-partial-output (instance string)
(gdb-get-create-instance-buffer
instance 'gdb-partial-output-buffer))
(delete-region (point-min) (point-max))))
+
+(defun gdb-append-to-inferior-io (instance string)
+ (save-excursion
+ (set-buffer
+ (gdb-get-create-instance-buffer
+ instance 'gdb-inferior-io))
+ (goto-char (point-max))
+ (insert-before-markers string))
+ (gud-display-buffer
+ (gdb-get-create-instance-buffer instance
+ 'gdb-inferior-io)))
+
+(defun gdb-clear-inferior-io (instance)
+ (save-excursion
+ (set-buffer
+ (gdb-get-create-instance-buffer
+ instance 'gdb-inferior-io))
+ (delete-region (point-min) (point-max))))
\f
(gud-find-file . gud-gdb-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 (expand-file-name file-word))
+ (filepart (file-name-nondirectory file))
+ (buffer-name (concat "*gud-" filepart "*")))
+ (setq gdb-first-time (not (get-buffer-process buffer-name))))
+
(gud-common-init command-line)
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq comint-input-sender 'gdb-send)
(run-hooks 'gdb-mode-hook)
- (make-gdb-instance (get-buffer-process (current-buffer)))
+ (let ((instance
+ (make-gdb-instance (get-buffer-process (current-buffer)))
+ ))
+ (if gdb-first-time (gdb-clear-inferior-io instance)))
)
\f
(gud-display-frame)))
(if moving (goto-char (process-mark proc)))))))
+(defun gud-proc-died (proc)
+ ;; Stop displaying an arrow in a source file.
+ (setq overlay-arrow-position nil)
+
+ ;; Kill the dummy process, so that C-x C-c won't worry about it.
+ (save-excursion
+ (set-buffer (process-buffer proc))
+ (kill-process
+ (get-buffer-process
+ (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io))))
+ )
+
(defun gud-sentinel (proc msg)
(cond ((null (buffer-name (process-buffer proc)))
;; buffer killed
- ;; Stop displaying an arrow in a source file.
- (setq overlay-arrow-position nil)
+ (gud-proc-died proc)
(set-process-buffer proc nil))
((memq (process-status proc) '(signal exit))
- ;; Stop displaying an arrow in a source file.
- (setq overlay-arrow-position nil)
+ (gud-proc-died proc)
+
;; Fix the mode line.
(setq mode-line-process
(concat ": "
projects / deliverable / binutils-gdb.git / blobdiff