gdb/gdb-mi.el - binutils-gdb - Git at Google

 ;;; 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 <nickrob@gnu.org>
 ;; Maintainer: Nick Roberts <nickrob@gnu.org>
 ;; 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)))))

     ;; 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
	;;; 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 <nickrob@gnu.org>
	;; Maintainer: Nick Roberts <nickrob@gnu.org>
	;; 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)))))

	;; 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