gdb-mi.el

这个是LINUX下的GDB调度工具的源码

;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)

;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
;; (could use "-interpreter-exec console cli-command")

;; Author: Nick Roberts <[e-mail]>
;; Maintainer: Nick Roberts <[e-mail]>
;; Keywords: unix, tools

;; Copyright (C) 2004  Free Software Foundation, Inc.

;; This file is part of GNU GDB.

;; GNU GDB is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;;; Commentary:

;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
;; onwards. You can interact with GDB through the GUD buffer in the usual way,
;; but there are also buffers which control the execution and describe the
;; state of your program. It separates the input/output of your program from
;; that of GDB and displays expressions and their current values in their own
;; buffers. It also uses features of Emacs 21 such as the fringe/display
;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
;; section in the Emacs info manual).

;; Start the debugger with M-x gdbmi.

;; This file uses GDB/MI as the primary interface to GDB. It is still under
;; development and is part of a process to migrate Emacs from annotations
;; (as used in gdb-ui.el) to GDB/MI.

;; Known Bugs:
;;

;;; Code:

(require 'gud)
(require 'gdb-ui)


;;;###autoload
(defun gdbmi (command-line)
  "Run gdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

If `gdb-many-windows' is nil (the default value) then gdb just
pops up the GUD buffer unless `gdb-show-main' is t. In this case
it starts with two windows: one displaying the GUD buffer and the
other with the source file with the main routine of the inferior.

If `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear. Keybindings are
given in relevant buffer.

Watch expressions appear in the speedbar/slowbar.

The following interactive lisp functions help control operation :

`gdb-many-windows'    - Toggle the number of windows gdb uses.
`gdb-restore-windows' - To restore the window layout.

See Info node `(emacs)GDB Graphical Interface' for a more
detailed description of this mode.


---------------------------------------------------------------------
                               GDB Toolbar
---------------------------------------------------------------------
GUD buffer (I/O of GDB)           | Locals buffer
                                  |
                                  |
                                  |
---------------------------------------------------------------------
 Source buffer                    | Input/Output (of inferior) buffer
                                  | (comint-mode)
                                  |
                                  |
                                  |
                                  |
                                  |
                                  |
---------------------------------------------------------------------
 Stack buffer                     | Breakpoints buffer
 RET      gdb-frames-select       | SPC    gdb-toggle-breakpoint
                                  | RET    gdb-goto-breakpoint
                                  |   d    gdb-delete-breakpoint
---------------------------------------------------------------------
"
  ;;
  (interactive (list (gud-query-cmdline 'gdbmi)))
  ;;
  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
  (gdb command-line)
  ;;
  (setq gdb-debug-log nil)
  (set (make-local-variable 'gud-minor-mode) 'gdbmi)
  (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
  ;;
  (gud-def gud-break (if (not (string-equal mode-name "Machine"))
			 (gud-call "-break-insert %f:%l" arg)
		       (save-excursion
			 (beginning-of-line)
			 (forward-char 2)
			 (gud-call "-break-insert *%a" arg)))
	   "\C-b" "Set breakpoint at current line or address.")
  ;;
  (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
			  (gud-call "clear %f:%l" arg)
			(save-excursion
			  (beginning-of-line)
			  (forward-char 2)
			  (gud-call "clear *%a" arg)))
	   "\C-d" "Remove breakpoint at current line or address.")
  ;;
  (gud-def gud-until  (if (not (string-equal mode-name "Machine"))
			  (gud-call "until %f:%l" arg)
			(save-excursion
			  (beginning-of-line)
			  (forward-char 2)
			  (gud-call "until *%a" arg)))
	   "\C-u" "Continue to current line or address.")

  (define-key gud-minor-mode-map [left-margin mouse-1]
    'gdb-mouse-toggle-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-1]
    'gdb-mouse-toggle-breakpoint)

  (setq comint-input-sender 'gdbmi-send)
  ;;
  ;; (re-)initialise
  (setq gdb-main-file nil)
  (setq gdb-current-address "main")
  (setq gdb-previous-address nil)
  (setq gdb-previous-frame nil)
  (setq gdb-current-frame "main")
  (setq gdb-view-source t)
  (setq gdb-selected-view 'source)
  (setq gdb-var-list nil)
  (setq gdb-var-changed nil)
  (setq gdb-prompting nil)
  (setq gdb-current-item nil)
  (setq gdb-pending-triggers nil)
  (setq gdb-output-sink 'user)
  (setq gdb-server-prefix nil)
  ;;
  (setq gdb-buffer-type 'gdbmi)
  ;;
  ;; FIXME: use tty command to separate io.
  ;;(gdb-clear-inferior-io)
  ;;
  (if (eq window-system 'w32)
      (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
  ;; find source file and compilation directory here
  (gdb-enqueue-input (list "list main\n"   'ignore))   ; C program
  (gdb-enqueue-input (list "list MAIN__\n" 'ignore))   ; Fortran program
  (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
  ;;
  (run-hooks 'gdbmi-mode-hook))

; Force nil till fixed.
(defconst gdbmi-use-inferior-io-buffer nil)

; uses --all-values Needs GDB 6.1 onwards.
(defun gdbmi-var-list-children (varnum)
  (gdb-enqueue-input
   (list (concat "-var-update " varnum "\n") 'ignore))
  (gdb-enqueue-input
   (list (concat "-var-list-children --all-values "  
		 varnum "\n")
	     `(lambda () (gdbmi-var-list-children-handler ,varnum)))))

(defconst gdbmi-var-list-children-regexp
"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
)

(defun gdbmi-var-list-children-handler (varnum)
  (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (let ((var-list nil))
     (catch 'child-already-watched
       (dolist (var gdb-var-list)
	 (if (string-equal varnum (cadr var))
	     (progn
	       (push var var-list)
	       (while (re-search-forward gdbmi-var-list-children-regexp nil t)
		 (let ((varchild (list (match-string 2)
				       (match-string 1)
				       (match-string 3)
				       nil
				       (match-string 4)
				       nil)))
		   (if (looking-at ",type=\"\\(.*?\\)\"")
		       (setcar (nthcdr 3 varchild) (match-string 1)))
		   (dolist (var1 gdb-var-list)
		     (if (string-equal (cadr var1) (cadr varchild))
			 (throw 'child-already-watched nil)))
		   (push varchild var-list))))
	   (push var var-list)))
       (setq gdb-var-changed t)
       (setq gdb-var-list (nreverse var-list))))))

;(defun gdbmi-send (proc string)
;  "A comint send filter for gdb."
;  (setq gdb-output-sink 'user)
;  (setq gdb-prompting nil)
;  (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))

(defun gdbmi-send (proc string)
  "A comint send filter for gdb."
  (setq gdb-output-sink 'user)
  (setq gdb-prompting nil)
  (process-send-string proc (concat string "\n")))

(defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
  "Default command to execute an executable under the GDB-UI debugger."
  :type 'string
  :group 'gud)

(defconst gdb-stopped-regexp 
  "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")

(defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")

(defconst gdb-internals-regexp "&\".*\\n\"\n")

(defconst gdb-gdb-regexp "(gdb) \n")

(defconst gdb-running-regexp "^\\^running")

(defun gdbmi-prompt ()
  "This handler terminates the any collection of output. It also
  sends the next command (if any) to gdb."
  (unless gdb-pending-triggers
	(gdb-get-current-frame)
	(gdbmi-invalidate-frames)
	(gdbmi-invalidate-breakpoints)
	(gdbmi-invalidate-locals)
	(dolist (frame (frame-list))
	  (when (string-equal (frame-parameter frame 'name) "Speedbar")
	    (setq gdb-var-changed t)    ; force update
	    (dolist (var gdb-var-list)
	      (setcar (nthcdr 5 var) nil))))
	(gdb-var-update))
  (let ((sink gdb-output-sink))
    (when (eq sink 'emacs)
      (let ((handler
	     (car (cdr gdb-current-item))))
	(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
	  (funcall handler)))))
  (let ((input (gdb-dequeue-input)))
    (if input
	(gdb-send-item input)
      (progn
	(setq gud-running nil)
	(setq gdb-prompting t)
	(gud-display-frame)))))

(defun gud-gdbmi-marker-filter (string)
  "Filter GDB/MI output."
  (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
  ;; Recall the left over gud-marker-acc from last time
  (setq gud-marker-acc (concat gud-marker-acc string))
  ;; Start accumulating output for the GUD buffer
  (let ((output ""))

    (if (string-match gdb-running-regexp gud-marker-acc) 
       (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
	     gud-running t))

    ;; Remove the trimmings from the console stream.
    (while (string-match gdb-console-regexp gud-marker-acc) 
       (setq 
	gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
			       (match-string 1 gud-marker-acc)
			       (substring gud-marker-acc (match-end 0)))))