gdb-mi.el

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

    ;; Remove log stream containing debugging messages being produced by GDB's
    ;; internals.
    (while (string-match gdb-internals-regexp gud-marker-acc) 
       (setq 
	 gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
				(substring gud-marker-acc (match-end 0)))))

    (if (string-match gdb-stopped-regexp gud-marker-acc)
      (setq

       ;; Extract the frame position from the marker.
       gud-last-frame (cons (match-string 2 gud-marker-acc)
			    (string-to-int (match-string 3 gud-marker-acc)))

       ;; Append any text before the marker to the output we're going
       ;; to return - we don't include the marker in this text.
       output (gdbmi-concat-output output
		      (substring gud-marker-acc 0 (match-beginning 0)))

       ;; Set the accumulator to the remaining text.
       gud-marker-acc (substring gud-marker-acc (match-end 0))))
      
    (while (string-match gdb-gdb-regexp gud-marker-acc) 
      (setq

       ;; Append any text up to and including prompt less \n to the output.
       output (gdbmi-concat-output output
		      (substring gud-marker-acc 0 (- (match-end 0) 1)))

       ;; Set the accumulator to the remaining text.
       gud-marker-acc (substring gud-marker-acc (match-end 0)))
      (gdbmi-prompt))

    (setq output (gdbmi-concat-output output gud-marker-acc))
    (setq gud-marker-acc "")
    output))

(defun gdbmi-concat-output (so-far new)
  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'user) (concat so-far new))
     ((eq sink 'emacs)
      (gdb-append-to-partial-output new)
      so-far)
     ((eq sink 'inferior)
      (gdb-append-to-inferior-io new)
      so-far))))


;; Breakpoint buffer : This displays the output of `-break-list'.
;;
(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 that queues the command below.  That function is
  ;; called:
  gdbmi-invalidate-breakpoints
  ;;
  ;; To update the buffer, this command is sent to gdb.
  "-break-list\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-break-list-handler
  ;; buffer specific functions
  gdb-break-list-custom)

(defconst gdb-break-list-regexp
"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")

(defun gdb-break-list-handler ()
  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
				  gdb-pending-triggers))
  (let ((breakpoint nil)
	(breakpoints-list nil))
    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
      (goto-char (point-min))
      (while (re-search-forward gdb-break-list-regexp nil t)
	(let ((breakpoint (list (match-string 1)
				(match-string 2)
				(match-string 3)
				(match-string 4)
				(match-string 5)
				(match-string 6)
				(match-string 7)
				(match-string 8))))
	  (push breakpoint breakpoints-list))))
    (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
      (and buf (with-current-buffer buf
		 (let ((p (point))
		       (buffer-read-only nil))
		   (erase-buffer)
		   (insert "Num Type        Disp Enb Func\tFile:Line\tAddr\n")
		   (dolist (breakpoint breakpoints-list)
		     (insert (concat
			      (nth 0 breakpoint) "   "
			      (nth 1 breakpoint) "  "
			      (nth 2 breakpoint) "   "
			      (nth 3 breakpoint) " "
			      (nth 5 breakpoint) "\t"
			      (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" 
			      (nth 4 breakpoint) "\n")))
		   (goto-char p))))))
  (gdb-break-list-custom))

;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-break-list-custom ()
  (let ((flag)(address))
    ;;
    ;; remove all breakpoint-icons in source buffers but not assembler buffer
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(if (and (eq gud-minor-mode 'gdbmi)
		 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
	    (gdb-remove-breakpoint-icons (point-min) (point-max)))))
    (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
      (save-excursion
	(goto-char (point-min))
	(while (< (point) (- (point-max) 1))
	  (forward-line 1)
	  (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
	      (progn
		(setq flag (char-after (match-beginning 1)))
		(let ((line (match-string 3)) (buffer-read-only nil)
		      (file (match-string 2)))
		  (add-text-properties (point-at-bol) (point-at-eol)
				       '(mouse-face highlight
						    help-echo "mouse-2, RET: visit breakpoint"))
		  (with-current-buffer
		      (find-file-noselect
		       (if (file-exists-p file) file
			 (expand-file-name file gdb-cdir)))
		    (save-current-buffer
		      (set (make-local-variable 'gud-minor-mode) 'gdbmi)
		      (set (make-local-variable 'tool-bar-map)
			   gud-tool-bar-map))
		    ;; only want one breakpoint icon at each location
		    (save-excursion
		      (goto-line (string-to-number line))
		      (gdb-put-breakpoint-icon (eq flag ?y)))))))))
	  (end-of-line)))
  (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))

;; Frames buffer.  This displays a perpetually correct bactrack trace.
;;
(def-gdb-auto-updated-buffer gdb-stack-buffer
  gdbmi-invalidate-frames
  "-stack-list-frames\n"
  gdb-stack-list-frames-handler
  gdb-stack-list-frames-custom)

(defconst gdb-stack-list-frames-regexp
"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")

(defun gdb-stack-list-frames-handler ()
  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
				  gdb-pending-triggers))
  (let ((frame nil)
	(call-stack nil))
    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
      (goto-char (point-min))
      (while (re-search-forward gdb-stack-list-frames-regexp nil t)
	(let ((frame (list (match-string 1)
			   (match-string 2)
			   (match-string 3)
			   (match-string 4)
			   (match-string 5))))
	  (push frame call-stack))))
    (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
      (and buf (with-current-buffer buf
		 (let ((p (point))
		       (buffer-read-only nil))
		   (erase-buffer)
		   (insert "Level\tFunc\tFile:Line\tAddr\n")
		   (dolist (frame (nreverse call-stack))
		     (insert (concat
			      (nth 0 frame) "\t"
			      (nth 2 frame) "\t"
			      (nth 3 frame) ":" (nth 4 frame) "\t"
			      (nth 1 frame) "\n")))
		   (goto-char p))))))
  (gdb-stack-list-frames-custom))

(defun gdb-stack-list-frames-custom ()
  (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
    (save-excursion
      (let ((buffer-read-only nil))
	(goto-char (point-min))
	(forward-line 1)
	(while (< (point) (point-max))
	  (add-text-properties (point-at-bol) (point-at-eol)
			     '(mouse-face highlight
			       help-echo "mouse-2, RET: Select frame"))
	  (beginning-of-line)
	  (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
			 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
		     (equal (match-string 1) gdb-current-frame))
	    (put-text-property (point-at-bol) (point-at-eol)
			       'face '(:inverse-video t)))
	  (forward-line 1))))))

;; Locals buffer.
;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
(def-gdb-auto-updated-buffer gdb-locals-buffer
  gdbmi-invalidate-locals
  "-stack-list-locals 2\n"
  gdb-stack-list-locals-handler
  gdb-stack-list-locals-custom)

(defconst gdb-stack-list-locals-regexp
  (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))

;; Dont display values of arrays or structures.
;; These can be expanded using gud-watch.
(defun gdb-stack-list-locals-handler nil
  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals
				  gdb-pending-triggers))
  (let ((local nil)
	(locals-list nil))
    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
      (goto-char (point-min))
      (while (re-search-forward gdb-stack-list-locals-regexp nil t)
	(let ((local (list (match-string 1)
			   (match-string 2)
			   nil)))
	  (if (looking-at ",value=\"\\(.*?\\)\"")
	      (setcar (nthcdr 2 local) (match-string 1)))
	(push local locals-list))))
    (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
      (and buf (with-current-buffer buf
		 (let ((p (point))
		       (buffer-read-only nil))
		   (erase-buffer)
		   (dolist (local locals-list)
		     (insert 
		      (concat (car local) "\t" (nth 1 local) "\t"
			      (or (nth 2 local)
				  (if (string-match "struct" (nth 1 local))
				      "(structure)"
				    "(array)"))
			      "\n")))
		   (goto-char p)))))))

(defun gdb-stack-list-locals-custom ()
  nil)

(defun gdbmi-source-info ()
  "Find the source file where the program starts and displays it with related
buffers."
  (goto-char (point-min))
  (if (search-forward "source file is " nil t)
      (if (looking-at "\\S-*")
	  (setq gdb-main-file (match-string 0)))
    (setq gdb-view-source nil))
  (if (search-forward "directory is " nil t)
      (if (looking-at "\\S-*:\\(\\S-*\\)")
	  (setq gdb-cdir (match-string 1))
	(looking-at "\\S-*")
	(setq gdb-cdir (match-string 0))))

;temporary heuristic
  (if gdb-main-file
      (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))

  (if gdb-many-windows
      (gdb-setup-windows)
    (gdb-get-create-buffer 'gdb-breakpoints-buffer)
    (when gdb-show-main
      (switch-to-buffer gud-comint-buffer)
      (delete-other-windows)
      (split-window)
      (other-window 1)
      (switch-to-buffer
       (if gdb-view-source
	   (gud-find-file gdb-main-file)
	 (gdb-get-create-buffer 'gdb-assembler-buffer)))
      (other-window 1))))

(provide 'gdb-mi)
;;; gdbmi.el ends here