diff options
author | Nick Roberts <nickrob@snap.net.nz> | 2009-09-25 01:53:34 +0000 |
---|---|---|
committer | Nick Roberts <nickrob@snap.net.nz> | 2009-09-25 01:53:34 +0000 |
commit | 98517b456379663c4b74632c05b2f64f86575d7d (patch) | |
tree | 9d01c95939b8cc84820ac4fe23b2de66d6be8703 | |
parent | 00ac1fbefeba6de3e0538ae8e7149ad48ed1ce8c (diff) | |
download | gdb-98517b456379663c4b74632c05b2f64f86575d7d.zip gdb-98517b456379663c4b74632c05b2f64f86575d7d.tar.gz gdb-98517b456379663c4b74632c05b2f64f86575d7d.tar.bz2 |
Remove file.
-rw-r--r-- | gdb/mi/gdb-mi.el | 609 |
1 files changed, 0 insertions, 609 deletions
diff --git a/gdb/mi/gdb-mi.el b/gdb/mi/gdb-mi.el deleted file mode 100644 index 031de00..0000000 --- a/gdb/mi/gdb-mi.el +++ /dev/null @@ -1,609 +0,0 @@ -;;; gdb-mi.el - -;; Author: Nick Roberts <nickrob@gnu.org> -;; Maintainer: Nick Roberts <nickrob@gnu.org> -;; Keywords: unix, tools - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 -;; 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 works with Emacs -;; 22.x and the version of GDB with which it is distributed. 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. It runs gdb with GDB/MI (-interp=mi) and -;; access CLI using "-interpreter-exec console cli-command". - -;; This mode acts on top of gdb-ui.el. After the release of 22.1, -;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el -;; which will *replace* gdb-ui.el. If you are interested in developing -;; this mode you should get this version. -;; -;; Known Bugs: -;; -;; 1) To handle program input, if required, and to avoid extra output in the -;; GUD buffer you must not use run, step, next or continue etc but their MI -;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate -;; icon in the toolbar. -;; 2) Some commands send extra prompts to the GUD buffer. -;; 3) Doesn't list catchpoints in breakpoints buffer. -;; -;; TODO: -;; 1) Prefix MI commands with a token instead of queueing commands. -;; 2) Use MI command -data-read-memory for memory window. -;; 3) Use MI command -data-disassemble for disassembly window. -;; 4) Allow separate buffers for Inferior IO and GDB IO. -;; 5) Watch windows to work with threads. -;; -;;; Code: - -(require 'gud) -(require 'gdb-ui) - -(defvar gdb-last-command nil) -(defvar gdb-prompt-name nil) - -;;;###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 commands 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 | -| | -| | -| | -| | -| | -| | -| | -+-------------------------------+------------------------------+ -| 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-ring nil) - (set (make-local-variable 'gud-minor-mode) 'gdbmi) - (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter) - ;; - (gud-def gud-step "-exec-step %p" "\C-s" - "Step one source line with display.") - (gud-def gud-stepi "-exec-step-instruction %p" "\C-i" - "Step one instruction with display.") - (gud-def gud-next "-exec-next %p" "\C-n" - "Step one line (skip functions).") - (gud-def gud-cont "-exec-continue" "\C-r" - "Continue with display.") - (gud-def gud-finish "-exec-finish" "\C-f" - "Finish executing current function.") - (gud-def gud-run "-exec-run" nil "Run the program.") - (gud-def gud-break (if (not (string-equal mode-name "Machine")) - (gud-call "break %f:%l" arg) - (save-excursion - (beginning-of-line) - (forward-char 2) - (gud-call "break *%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 "-exec-until %f:%l" arg) - (save-excursion - (beginning-of-line) - (forward-char 2) - (gud-call "-exec-until *%a" arg))) - "\C-u" "Continue to current line or address.") - - (define-key gud-minor-mode-map [left-margin mouse-1] - 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-1] - 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-2] - 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-fringe drag-mouse-1] - 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-margin mouse-3] - 'gdb-mouse-toggle-breakpoint-margin) - (define-key gud-minor-mode-map [left-fringe mouse-3] - 'gdb-mouse-toggle-breakpoint-fringe) - - (setq comint-input-sender 'gdbmi-send) - ;; - ;; (re-)initialise - (setq gdb-pc-address (if gdb-show-main "main" nil) - gdb-previous-frame-address nil - gdb-memory-address "main" - gdb-previous-frame nil - gdb-selected-frame nil - gdb-frame-number nil - gdb-var-list nil - gdb-prompting nil - gdb-input-queue nil - gdb-current-item nil - gdb-pending-triggers nil - gdb-output-sink 'user - gdb-server-prefix nil - gdb-flush-pending-output nil - gdb-location-alist nil - gdb-source-file-list nil - gdb-last-command nil - gdb-prompt-name nil - gdb-buffer-fringe-width (car (window-fringes))) - gdb-debug-ring nil - gdb-source-window nil - gdb-inferior-status nil - gdb-continuation 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))) - (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore)) - ;; find source file and compilation directory here - (gdb-enqueue-input - ; Needs GDB 6.2 onwards. - (list "-file-list-exec-source-files\n" - 'gdb-set-gud-minor-mode-existing-buffers-1)) - (gdb-enqueue-input - ; Needs GDB 6.0 onwards. - (list "-file-list-exec-source-file\n" 'gdb-get-source-file)) - (gdb-enqueue-input - (list "-data-list-register-names\n" 'gdb-get-register-names)) - (gdb-enqueue-input - (list "-gdb-show prompt\n" 'gdb-get-prompt)) - ;; - (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2) - (run-hooks 'gdbmi-mode-hook)) - - -(defun gdbmi-send (proc string) - "A comint send filter for gdb." - (if gud-running - (process-send-string proc (concat string "\n")) - (with-current-buffer gud-comint-buffer - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(face)))) - (setq gdb-output-sink 'user) - (setq gdb-prompting nil) - ;; mimic <RET> key to repeat previous command in GDB - (if (not (string-match "^\\s+$" string)) - (setq gdb-last-command string) - (if gdb-last-command (setq string gdb-last-command))) - (if gdb-enable-debug - (push (cons 'mi-send (concat string "\n")) gdb-debug-ring)) - (if (string-match "^-" string) - ;; MI command - (process-send-string proc (concat string "\n")) - ;; CLI command - (if (string-match "\\\\$" string) - (setq gdb-continuation (concat gdb-continuation string "\n")) - (process-send-string proc - (concat "-interpreter-exec console \"" - gdb-continuation string "\"\n")) - (setq gdb-continuation nil))))) - -(defcustom gud-gdbmi-command-name "gdb -interp=mi" - "Default command to execute an executable under the GDB-UI debugger." - :type 'string - :group 'gud) - -(defconst gdb-gdb-regexp "(gdb) \n") - -(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp)) - -;; fullname added GDB 6.4+. -;; Probably not needed. -stack-info-frame computes filename and line. -(defconst gdb-stopped-regexp - "\\*stopped,reason=.*?,file=\".*?\"\ -,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n") - -(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n") - -(defconst gdb-done-regexp "\\^done,*\n*") - -(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n") - -(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n") - -(defun gdbmi-prompt1 () - "Queue any GDB commands that the user interface needs." - (unless gdb-pending-triggers - (gdbmi-get-selected-frame) - (gdbmi-invalidate-frames) - (gdbmi-invalidate-breakpoints) - (gdb-get-changed-registers) - (gdb-invalidate-registers-1) - (gdb-invalidate-locals-1) - (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (gdb-var-update-1)))) - -(defun gdbmi-prompt2 () - "Handle any output and send next GDB command." - (let ((sink gdb-output-sink)) - (when (eq sink 'emacs) - (let ((handler - (car (cdr gdb-current-item)))) - (with-current-buffer (gdb-get-buffer-create '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-flush-pending-output - nil - (if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink)) - gdb-debug-ring)) - ;; 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 "") running) - - (if (string-match gdb-running-regexp gud-marker-acc) - (setq - gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - (substring gud-marker-acc (match-end 0))) - running t)) - - (if (string-match gdb-stopped-regexp gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame (cons (match-string 1 gud-marker-acc) - (string-to-number - (match-string 2 gud-marker-acc))) - - gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - (substring gud-marker-acc (match-end 0))))) - - ;; Filter error messages going to GUD buffer and - ;; display in minibuffer. - (when (eq gdb-output-sink 'user) - (while (string-match gdb-error-regexp gud-marker-acc) - (message (read (match-string 1 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-done-regexp gud-marker-acc) - (setq - gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - (substring gud-marker-acc (match-end 0)))))) - - (when (string-match gdb-gdb-regexp gud-marker-acc) - (setq - gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - (substring gud-marker-acc (match-end 0)))) - - ;; 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)) - (read (match-string 1 gud-marker-acc)) - (substring gud-marker-acc (match-end 0))))) - - ;; Remove the trimmings from log stream containing debugging messages - ;; being produced by GDB's internals and use warning face. - (while (string-match gdb-internals-regexp gud-marker-acc) - (setq - gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - (let ((error-message - (read (match-string 1 gud-marker-acc)))) - (put-text-property - 0 (length error-message) - 'face font-lock-warning-face - error-message) - error-message) - (substring gud-marker-acc (match-end 0))))) - - (setq output (gdbmi-concat-output output gud-marker-acc)) - (setq gud-marker-acc "") - (gdbmi-prompt1) - (unless gdb-input-queue - (setq output (concat output gdb-prompt-name))) - (gdbmi-prompt2) - (setq gud-running running)) - - (when gud-running - (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-update-trigger gdbmi-invalidate-breakpoints - (gdb-get-buffer 'gdb-breakpoints-buffer) - "-break-list\n" - gdb-break-list-handler) - -(defconst gdb-break-list-regexp -"bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\ -enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\ -file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\ -\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}") - -(defun gdb-break-list-handler () - (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints - gdb-pending-triggers)) - (let ((breakpoint) (breakpoints-list)) - (with-current-buffer (gdb-get-buffer-create '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) - (match-string 9) - (match-string 10)))) - (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 Hits Addr What\n") - (dolist (breakpoint breakpoints-list) - (insert - (concat - (nth 0 breakpoint) " " - (nth 1 breakpoint) " " - (nth 2 breakpoint) " " - (nth 3 breakpoint) " " - (nth 9 breakpoint) " " - (nth 4 breakpoint) " " - (if (nth 5 breakpoint) - (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n") - (concat (nth 8 breakpoint) "\n"))))) - (goto-char p)))))) - (gdb-info-breakpoints-custom)) - -(defun gdbmi-get-location (bptno line flag) - "Find the directory containing the relevant source file. -Put in buffer and place breakpoint icon." - (goto-char (point-min)) - (catch 'file-not-found - (if (re-search-forward gdb-source-file-regexp-1 nil t) - (delete (cons bptno "File not found") gdb-location-alist) - (push (cons bptno (match-string 1)) gdb-location-alist) - (gdb-resync) - (unless (assoc bptno gdb-location-alist) - (push (cons bptno "File not found") gdb-location-alist) - (message-box "Cannot find source file for breakpoint location. -Add directory to search path for source files using the GDB command, dir.")) - (throw 'file-not-found nil)) - (with-current-buffer - (find-file-noselect (match-string 1)) - (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) bptno))))) - -;; Frames buffer. This displays a perpetually correct bactrack trace. -;; -(def-gdb-auto-update-trigger gdbmi-invalidate-frames - (gdb-get-buffer 'gdb-stack-buffer) - "-stack-list-frames\n" - gdb-stack-list-frames-handler) - -(defconst gdb-stack-list-frames-regexp -"{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\ -\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\ -from=\"\\(.*?\\)\"\\)") - -(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-buffer-create '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) - (match-string 6)))) - (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\tAddr\tFunc\tFile:Line\n") - (dolist (frame (nreverse call-stack)) - (insert - (concat - (nth 0 frame) "\t" - (nth 1 frame) "\t" - (propertize (nth 2 frame) - 'face font-lock-function-name-face) "\t" - (if (nth 3 frame) - (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n") - (concat "from " (nth 5 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 (looking-at "^[0-9]+\\s-+\\(\\S-+\\)") - (equal (match-string 1) gdb-selected-frame)) - (put-text-property (point-at-bol) (point-at-eol) - 'face '(:inverse-video t))) - (forward-line 1)))))) - - -;; gdb-ui.el uses "info source" to find out if macro information is present. -(defun gdb-get-source-file () - "Find the source file where the program starts and display it with related -buffers, if required." - (goto-char (point-min)) - (if (re-search-forward gdb-source-file-regexp-1 nil t) - (setq gdb-main-file (match-string 1))) - (if gdb-many-windows - (gdb-setup-windows) - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (if gdb-show-main - (let ((pop-up-windows t)) - (display-buffer (gud-find-file gdb-main-file)))))) - -(defun gdbmi-get-selected-frame () - (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers)) - (progn - (gdb-enqueue-input - (list "-stack-info-frame\n" 'gdbmi-frame-handler)) - (push 'gdbmi-get-selected-frame - gdb-pending-triggers)))) - -(defun gdbmi-frame-handler () - (setq gdb-pending-triggers - (delq 'gdbmi-get-selected-frame gdb-pending-triggers)) - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (goto-char (point-min)) - (when (re-search-forward gdb-stack-list-frames-regexp nil t) - (setq gdb-frame-number (match-string 1)) - (setq gdb-pc-address (match-string 2)) - (setq gdb-selected-frame (match-string 3)) - (when (match-string 4) - (setq gud-last-frame - (cons (match-string 4) (string-to-number (match-string 5)))) - (gud-display-frame) - (if gud-overlay-arrow-position - (let ((buffer (marker-buffer gud-overlay-arrow-position)) - (position (marker-position gud-overlay-arrow-position))) - (when buffer - (with-current-buffer buffer - (setq fringe-indicator-alist - (if (string-equal gdb-frame-number "0") - nil - '((overlay-arrow . hollow-right-triangle)))) - (setq gud-overlay-arrow-position (make-marker)) - (set-marker gud-overlay-arrow-position position)))))) - (if (gdb-get-buffer 'gdb-locals-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) - (setq mode-name (concat "Locals:" gdb-selected-frame)))) - (if (gdb-get-buffer 'gdb-assembler-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) - (setq mode-name (concat "Machine:" gdb-selected-frame))))))) - -(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") - -(defun gdb-get-prompt () - "Find prompt for GDB session." - (goto-char (point-min)) - (setq gdb-prompt-name nil) - (re-search-forward gdb-prompt-name-regexp nil t) - (setq gdb-prompt-name (match-string 1))) - -(provide 'gdb-mi) -;;; gdbmi.el ends here |