Mercurial > emacs
changeset 51493:b78f64d427c5
Moved to progmodes/.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Thu, 05 Jun 2003 19:53:31 +0000 |
parents | 168bf1dc1b53 |
children | ba857b9204ca |
files | lisp/gud.el |
diffstat | 1 files changed, 0 insertions(+), 2970 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gud.el Thu Jun 05 19:47:26 2003 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2970 +0,0 @@ -;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers - -;; Author: Eric S. Raymond <esr@snark.thyrsus.com> -;; Maintainer: FSF -;; Keywords: unix, tools - -;; Copyright (C) 1992,93,94,95,96,1998,2000,02,2003 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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. - -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu> -;; It was later rewritten by rms. Some ideas were due to Masanobu. -;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com> -;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, -;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com> -;; added support for xdb (HPUX debugger). Rick Sladkey <jrs@world.std.com> -;; wrote the GDB command completion code. Dave Love <d.love@dl.ac.uk> -;; added the IRIX kluge, re-implemented the Mips-ish variant and added -;; a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX kluge with -;; the gud-xdb-directories hack producing gud-dbx-directories. Derek L. Davies -;; <ddavies@world.std.com> added support for jdb (Java debugger.) - -;;; Code: - -(require 'comint) -(require 'etags) - -;; ====================================================================== -;; GUD commands must be visible in C buffers visited by GUD - -(defgroup gud nil - "Grand Unified Debugger mode for gdb and other debuggers under Emacs. -Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and bash." - :group 'unix - :group 'tools) - - -(defcustom gud-key-prefix "\C-x\C-a" - "Prefix of all GUD commands valid in C buffers." - :type 'string - :group 'gud) - -(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh) -(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack - -(defvar gud-marker-filter nil) -(put 'gud-marker-filter 'permanent-local t) -(defvar gud-find-file nil) -(put 'gud-find-file 'permanent-local t) - -(defun gud-marker-filter (&rest args) - (apply gud-marker-filter args)) - -(defvar gud-minor-mode nil) -(put 'gud-minor-mode 'permanent-local t) - -(defvar gud-keep-buffer nil) - -(defun gud-symbol (sym &optional soft minor-mode) - "Return the symbol used for SYM in MINOR-MODE. -MINOR-MODE defaults to `gud-minor-mode. -The symbol returned is `gud-<MINOR-MODE>-<SYM>'. -If SOFT is non-nil, returns nil if the symbol doesn't already exist." - (unless (or minor-mode gud-minor-mode) (error "Gud internal error")) - (funcall (if soft 'intern-soft 'intern) - (format "gud-%s-%s" (or minor-mode gud-minor-mode) sym))) - -(defun gud-val (sym &optional minor-mode) - "Return the value of `gud-symbol' SYM. Default to nil." - (let ((sym (gud-symbol sym t minor-mode))) - (if (boundp sym) (symbol-value sym)))) - -(defvar gud-running nil - "Non-nil if debuggee is running. -Used to grey out relevant toolbar icons.") - -(easy-mmode-defmap gud-menu-map - '(([refresh] "Refresh" . gud-refresh) - ([run] menu-item "Run" gud-run - :enable (and (not gud-running) - (memq gud-minor-mode '(gdba gdb jdb)))) - ([goto] menu-item "Continue to selection" gud-until - :enable (and (not gud-running) - (memq gud-minor-mode '(gdba gdb)))) - ([remove] menu-item "Remove Breakpoint" gud-remove - :enable (not gud-running)) - ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak - :enable (memq gud-minor-mode '(gdba gdb sdb xdb bashdb))) - ([break] menu-item "Set Breakpoint" gud-break - :enable (not gud-running)) - ([up] menu-item "Up Stack" gud-up - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdba gdb dbx xdb jdb pdb bashdb)))) - ([down] menu-item "Down Stack" gud-down - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdba gdb dbx xdb jdb pdb bashdb)))) - ([print] menu-item "Print Expression" gud-print - :enable (not gud-running)) - ([display] menu-item "Display Expression" gud-display - :enable (and (not gud-running) - (eq gud-minor-mode 'gdba))) - ([finish] menu-item "Finish Function" gud-finish - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdba gdb xdb jdb pdb bashdb)))) - ([stepi] menu-item "Step Instruction" gud-stepi - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdba gdb dbx)))) - ([nexti] menu-item "Next Instruction" gud-nexti - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdba gdb)))) - ([step] menu-item "Step Line" gud-step - :enable (not gud-running)) - ([next] menu-item "Next Line" gud-next - :enable (not gud-running)) - ([cont] menu-item "Continue" gud-cont - :enable (not gud-running))) - "Menu for `gud-mode'." - :name "Gud") - -(easy-mmode-defmap gud-minor-mode-map - `(([menu-bar debug] . ("Gud" . ,gud-menu-map))) - "Map used in visited files.") - -(let ((m (assq 'gud-minor-mode minor-mode-map-alist))) - (if m (setcdr m gud-minor-mode-map) - (push (cons 'gud-minor-mode gud-minor-mode-map) minor-mode-map-alist))) - -(defvar gud-mode-map - ;; Will inherit from comint-mode via define-derived-mode. - (make-sparse-keymap) - "`gud-mode' keymap.") - -(defvar gud-tool-bar-map - (if (display-graphic-p) - (let ((map (make-sparse-keymap))) - (dolist (x '((gud-break . "gud-break") - (gud-remove . "gud-remove") - (gud-print . "gud-print") - (gud-display . "gud-display") - (gud-run . "gud-run") - (gud-until . "gud-until") - (gud-cont . "gud-cont") - (gud-step . "gud-step") - (gud-next . "gud-next") - (gud-finish . "gud-finish") - (gud-stepi . "gud-stepi") - (gud-nexti . "gud-nexti") - (gud-up . "gud-up") - (gud-down . "gud-down")) - map) - (tool-bar-local-item-from-menu - (car x) (cdr x) map gud-minor-mode-map))))) - -(defun gud-file-name (f) - "Transform a relative file name to an absolute file name. -Uses `gud-<MINOR-MODE>-directories' to find the source files." - (if (file-exists-p f) (expand-file-name f) - (let ((directories (gud-val 'directories)) - (result nil)) - (while directories - (let ((path (expand-file-name f (car directories)))) - (if (file-exists-p path) - (setq result path - directories nil))) - (setq directories (cdr directories))) - result))) - -(defun gud-find-file (file) - ;; Don't get confused by double slashes in the name that comes from GDB. - (while (string-match "//+" file) - (setq file (replace-match "/" t t file))) - (let ((minor-mode gud-minor-mode) - (buf (funcall (or gud-find-file 'gud-file-name) file))) - (when (stringp buf) - (setq buf (and (file-readable-p buf) (find-file-noselect buf 'nowarn)))) - (when buf - ;; Copy `gud-minor-mode' to the found buffer to turn on the menu. - (with-current-buffer buf - (set (make-local-variable 'gud-minor-mode) minor-mode) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) - (make-local-variable 'gud-keep-buffer)) - buf))) - -;; ====================================================================== -;; command definition - -;; This macro is used below to define some basic debugger interface commands. -;; Of course you may use `gud-def' with any other debugger command, including -;; user defined ones. - -;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form -;; which defines FUNC to send the command NAME to the debugger, gives -;; it the docstring DOC, and binds that function to KEY in the GUD -;; major mode. The function is also bound in the global keymap with the -;; GUD prefix. - -(defmacro gud-def (func cmd key &optional doc) - "Define FUNC to be a command sending STR and bound to KEY, with -optional doc string DOC. Certain %-escapes in the string arguments -are interpreted specially if present. These are: - - %f name (without directory) of current source file. - %F name (without directory or extension) of current source file. - %d directory of current source file. - %l number of current source line - %e text of the C lvalue or function-call expression surrounding point. - %a text of the hexadecimal address surrounding point - %p prefix argument to the command (if any) as a number - - The `current' source file is the file of the current buffer (if -we're in a C file) or the source file current at the last break or -step (if we're in the GUD buffer). - The `current' line is that of the current buffer (if we're in a -source file) or the source line number at the last break or step (if -we're in the GUD buffer)." - `(progn - (defun ,func (arg) - ,@(if doc (list doc)) - (interactive "p") - ,(if (stringp cmd) - `(gud-call ,cmd arg) - cmd)) - ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) - ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) - -;; Where gud-display-frame should put the debugging arrow; a cons of -;; (filename . line-number). This is set by the marker-filter, which scans -;; the debugger's output for indications of the current program counter. -(defvar gud-last-frame nil) - -;; Used by gud-refresh, which should cause gud-display-frame to redisplay -;; the last frame, even if it's been called before and gud-last-frame has -;; been set to nil. -(defvar gud-last-last-frame nil) - -;; All debugger-specific information is collected here. -;; Here's how it works, in case you ever need to add a debugger to the mode. -;; -;; Each entry must define the following at startup: -;; -;;<name> -;; comint-prompt-regexp -;; gud-<name>-massage-args -;; gud-<name>-marker-filter -;; gud-<name>-find-file -;; -;; The job of the massage-args method is to modify the given list of -;; debugger arguments before running the debugger. -;; -;; The job of the marker-filter method is to detect file/line markers in -;; strings and set the global gud-last-frame to indicate what display -;; action (if any) should be triggered by the marker. Note that only -;; whatever the method *returns* is displayed in the buffer; thus, you -;; can filter the debugger's output, interpreting some and passing on -;; the rest. -;; -;; The job of the find-file method is to visit and return the buffer indicated -;; by the car of gud-tag-frame. This may be a file name, a tag name, or -;; something else. - -;; ====================================================================== -;; speedbar support functions and variables. -(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer. - -(defvar gud-last-speedbar-buffer nil - "The last GUD buffer used.") - -(defvar gud-last-speedbar-stackframe nil - "Description of the currently displayed GUD stack. -t means that there is no stack, and we are in display-file mode.") - -(defvar gud-speedbar-key-map nil - "Keymap used when in the buffers display mode.") - -(defun gud-install-speedbar-variables () - "Install those variables used by speedbar to enhance gud/gdb." - (if gud-speedbar-key-map - nil - (setq gud-speedbar-key-map (speedbar-make-specialized-keymap)) - - (define-key gud-speedbar-key-map "j" 'speedbar-edit-line) - (define-key gud-speedbar-key-map "e" 'speedbar-edit-line) - (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line))) - -(defvar gud-speedbar-menu-items - ;; Note to self. Add expand, and turn off items when not available. - '(["Jump to stack frame" speedbar-edit-line t]) - "Additional menu items to add to the speedbar frame.") - -;; Make sure our special speedbar mode is loaded -(if (featurep 'speedbar) - (gud-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) - -(defun gud-speedbar-buttons (buffer) - "Create a speedbar display based on the current state of GUD. -If the GUD BUFFER is not running a supported debugger, then turn -off the specialized speedbar mode." - (if (and (save-excursion (goto-char (point-min)) - (looking-at "Current Stack")) - (equal gud-last-last-frame gud-last-speedbar-stackframe)) - nil - (setq gud-last-speedbar-buffer buffer) - (let* ((minor-mode (with-current-buffer buffer gud-minor-mode)) - (frames - (cond ((memq minor-mode '(gdba gdb)) - (gud-gdb-get-stackframe buffer)) - ;; Add more debuggers here! - (t - (speedbar-remove-localized-speedbar-support buffer) - nil)))) - (erase-buffer) - (if (not frames) - (insert "No Stack frames\n") - (insert "Current Stack:\n")) - (while frames - (insert (nth 1 (car frames)) ":\n") - (if (= (length (car frames)) 2) - (progn -; (speedbar-insert-button "[?]" -; 'speedbar-button-face -; nil nil nil t) - (speedbar-insert-button (car (car frames)) - 'speedbar-directory-face - nil nil nil t)) -; (speedbar-insert-button "[+]" -; 'speedbar-button-face -; 'speedbar-highlight-face -; 'gud-gdb-get-scope-data -; (car frames) t) - (speedbar-insert-button (car (car frames)) - 'speedbar-file-face - 'speedbar-highlight-face - (cond ((memq minor-mode '(gdba gdb)) - 'gud-gdb-goto-stackframe) - (t (error "Should never be here"))) - (car frames) t)) - (setq frames (cdr frames))) -; (let ((selected-frame -; (cond ((eq ff 'gud-gdb-find-file) -; (gud-gdb-selected-frame-info buffer)) -; (t (error "Should never be here")))))) - ) - (setq gud-last-speedbar-stackframe gud-last-last-frame))) - - -;; ====================================================================== -;; gdb functions - -;; History of argument lists passed to gdb. -(defvar gud-gdb-history nil) - -(defcustom gud-gdb-command-name "gdb --fullname" - "Default command to execute an executable under the GDB debugger." - :type 'string - :group 'gud) - -(defvar gud-gdb-marker-regexp - ;; This used to use path-separator instead of ":"; - ;; however, we found that on both Windows 32 and MSDOS - ;; a colon is correct here. - (concat "\032\032\\(.:?[^" ":" "\n]*\\)" ":" - "\\([0-9]*\\)" ":" ".*\n")) - -;; There's no guarantee that Emacs will hand the filter the entire -;; marker at once; it could be broken up across several strings. We -;; might even receive a big chunk with several markers in it. If we -;; receive a chunk of text which looks like it might contain the -;; beginning of a marker, we save it here between calls to the -;; filter. -(defvar gud-marker-acc "") -(make-variable-buffer-local 'gud-marker-acc) - -(defun gud-gdb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - (while (string-match gud-gdb-marker-regexp gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame (cons (match-string 1 gud-marker-acc) - (string-to-int (match-string 2 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 (concat 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)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -(easy-mmode-defmap gud-minibuffer-local-map - '(("\C-i" . comint-dynamic-complete-filename)) - "Keymap for minibuffer prompting of gud startup command." - :inherit minibuffer-local-map) - -(defun gud-query-cmdline (minor-mode &optional init) - (let* ((hist-sym (gud-symbol 'history nil minor-mode)) - (cmd-name (gud-val 'command-name minor-mode))) - (unless (boundp hist-sym) (set hist-sym nil)) - (read-from-minibuffer - (format "Run %s (like this): " minor-mode) - (or (car-safe (symbol-value hist-sym)) - (concat (or cmd-name (symbol-name minor-mode)) - " " - (or init - (let ((file nil)) - (dolist (f (directory-files default-directory) file) - (if (and (file-executable-p f) - (not (file-directory-p f)) - (or (not file) - (file-newer-than-file-p f file))) - (setq file f))))))) - gud-minibuffer-local-map nil - hist-sym))) - -;;;###autoload -(defun gdb (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." - (interactive (list (gud-query-cmdline 'gdb))) - - (gud-common-init command-line nil 'gud-gdb-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'gdb) - - (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.") - (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") - (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") - (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") - (gud-def gud-cont "cont" "\C-r" "Continue with display.") - (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") - (gud-def gud-jump "tbreak %f:%l\njump %f:%l" "\C-j" "Relocate execution address to line at point in source buffer.") - - (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") - (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") - (gud-def gud-until "until %l" "\C-u" "Continue to current line.") - (gud-def gud-run "run" nil "Run the program.") - - (local-set-key "\C-i" 'gud-gdb-complete-command) - (setq comint-prompt-regexp "^(.*gdb[+]?) *") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'gdb-mode-hook) - ) - -;; One of the nice features of GDB is its impressive support for -;; context-sensitive command completion. We preserve that feature -;; in the GUD buffer by using a GDB command designed just for Emacs. - -;; The completion process filter indicates when it is finished. -(defvar gud-gdb-fetch-lines-in-progress) - -;; Since output may arrive in fragments we accumulate partials strings here. -(defvar gud-gdb-fetch-lines-string) - -;; We need to know how much of the completion to chop off. -(defvar gud-gdb-fetch-lines-break) - -;; The completion list is constructed by the process filter. -(defvar gud-gdb-fetched-lines) - -(defvar gud-comint-buffer nil) - -(defun gud-gdb-complete-command () - "Perform completion on the GDB command preceding point. -This is implemented using the GDB `complete' command which isn't -available with older versions of GDB." - (interactive) - (let* ((end (point)) - (command (buffer-substring (comint-line-beginning-position) end)) - (command-word - ;; Find the word break. This match will always succeed. - (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) - (substring command (match-beginning 2)))) - (complete-list - (gud-gdb-run-command-fetch-lines (concat "complete " command) - (current-buffer) - ;; From string-match above. - (match-beginning 2)))) - ;; Protect against old versions of GDB. - (and complete-list - (string-match "^Undefined command: \"complete\"" (car complete-list)) - (error "This version of GDB doesn't support the `complete' command")) - ;; Sort the list like readline. - (setq complete-list (sort complete-list (function string-lessp))) - ;; Remove duplicates. - (let ((first complete-list) - (second (cdr complete-list))) - (while second - (if (string-equal (car first) (car second)) - (setcdr first (setq second (cdr second))) - (setq first second - second (cdr second))))) - ;; Add a trailing single quote if there is a unique completion - ;; and it contains an odd number of unquoted single quotes. - (and (= (length complete-list) 1) - (let ((str (car complete-list)) - (pos 0) - (count 0)) - (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) - (setq count (1+ count) - pos (match-end 0))) - (and (= (mod count 2) 1) - (setq complete-list (list (concat str "'")))))) - ;; Let comint handle the rest. - (comint-dynamic-simple-complete command-word complete-list))) - -;; The completion process filter is installed temporarily to slurp the -;; output of GDB up to the next prompt and build the completion list. -(defun gud-gdb-fetch-lines-filter (string filter) - "Filter used to read the list of lines output by a command. -STRING is the output to filter. -It is passed through FILTER before we look at it." - (setq string (funcall filter string)) - (setq string (concat gud-gdb-fetch-lines-string string)) - (while (string-match "\n" string) - (push (substring string gud-gdb-fetch-lines-break (match-beginning 0)) - gud-gdb-fetched-lines) - (setq string (substring string (match-end 0)))) - (if (string-match comint-prompt-regexp string) - (progn - (setq gud-gdb-fetch-lines-in-progress nil) - string) - (progn - (setq gud-gdb-fetch-lines-string string) - ""))) - -;; gdb speedbar functions - -(defun gud-gdb-goto-stackframe (text token indent) - "Goto the stackframe described by TEXT, TOKEN, and INDENT." - (speedbar-with-attached-buffer - (gud-basic-call (concat "server frame " (nth 1 token))) - (sit-for 1))) - -(defvar gud-gdb-fetched-stack-frame nil - "Stack frames we are fetching from GDB.") - -;(defun gud-gdb-get-scope-data (text token indent) -; ;; checkdoc-params: (indent) -; "Fetch data associated with a stack frame, and expand/contract it. -;Data to do this is retrieved from TEXT and TOKEN." -; (let ((args nil) (scope nil)) -; (gud-gdb-run-command-fetch-lines "info args") -; -; (gud-gdb-run-command-fetch-lines "info local") -; -; )) - -(defun gud-gdb-get-stackframe (buffer) - "Extract the current stack frame out of the GUD GDB BUFFER." - (let ((newlst nil) - (fetched-stack-frame-list - (gud-gdb-run-command-fetch-lines "server backtrace" buffer))) - (if (and (car fetched-stack-frame-list) - (string-match "No stack" (car fetched-stack-frame-list))) - ;; Go into some other mode??? - nil - (dolist (e fetched-stack-frame-list) - (let ((name nil) (num nil)) - (if (not (or - (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e) - (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e))) - (if (not (string-match - "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e)) - nil - (setcar newlst - (list (nth 0 (car newlst)) - (nth 1 (car newlst)) - (match-string 1 e) - (match-string 2 e)))) - (setq num (match-string 1 e) - name (match-string 2 e)) - (setq newlst - (cons - (if (string-match - "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e) - (list name num (match-string 1 e) - (match-string 2 e)) - (list name num)) - newlst))))) - (nreverse newlst)))) - -;(defun gud-gdb-selected-frame-info (buffer) -; "Learn GDB information for the currently selected stack frame in BUFFER." -; ) - -(defun gud-gdb-run-command-fetch-lines (command buffer &optional skip) - "Run COMMAND, and return the list of lines it outputs. -BUFFER is the GUD buffer in which to run the command. -SKIP is the number of chars to skip on each lines, it defaults to 0." - (with-current-buffer buffer - (if (save-excursion - (goto-char (point-max)) - (forward-line 0) - (not (looking-at comint-prompt-regexp))) - nil - ;; Much of this copied from GDB complete, but I'm grabbing the stack - ;; frame instead. - (let ((gud-gdb-fetch-lines-in-progress t) - (gud-gdb-fetched-lines nil) - (gud-gdb-fetch-lines-string nil) - (gud-gdb-fetch-lines-break (or skip 0)) - (gud-marker-filter - `(lambda (string) (gud-gdb-fetch-lines-filter string ',gud-marker-filter)))) - ;; Issue the command to GDB. - (gud-basic-call command) - ;; Slurp the output. - (while gud-gdb-fetch-lines-in-progress - (accept-process-output (get-buffer-process buffer))) - (nreverse gud-gdb-fetched-lines))))) - - -;; ====================================================================== -;; sdb functions - -;; History of argument lists passed to sdb. -(defvar gud-sdb-history nil) - -(defvar gud-sdb-needs-tags (not (file-exists-p "/var")) - "If nil, we're on a System V Release 4 and don't need the tags hack.") - -(defvar gud-sdb-lastfile nil) - -(defun gud-sdb-marker-filter (string) - (setq gud-marker-acc - (if gud-marker-acc (concat gud-marker-acc string) string)) - (let (start) - ;; Process all complete markers in this chunk - (while - (cond - ;; System V Release 3.2 uses this format - ((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc start) - (setq gud-last-frame - (cons (match-string 3 gud-marker-acc) - (string-to-int (match-string 4 gud-marker-acc))))) - ;; System V Release 4.0 quite often clumps two lines together - ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" - gud-marker-acc start) - (setq gud-sdb-lastfile (match-string 2 gud-marker-acc)) - (setq gud-last-frame - (cons gud-sdb-lastfile - (string-to-int (match-string 3 gud-marker-acc))))) - ;; System V Release 4.0 - ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" - gud-marker-acc start) - (setq gud-sdb-lastfile (match-string 2 gud-marker-acc))) - ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" - gud-marker-acc start)) - (setq gud-last-frame - (cons gud-sdb-lastfile - (string-to-int (match-string 1 gud-marker-acc))))) - (t - (setq gud-sdb-lastfile nil))) - (setq start (match-end 0))) - - ;; Search for the last incomplete line in this chunk - (while (string-match "\n" gud-marker-acc start) - (setq start (match-end 0))) - - ;; If we have an incomplete line, store it in gud-marker-acc. - (setq gud-marker-acc (substring gud-marker-acc (or start 0)))) - string) - -(defun gud-sdb-find-file (f) - (if gud-sdb-needs-tags (find-tag-noselect f) (find-file-noselect f))) - -;;;###autoload -(defun sdb (command-line) - "Run sdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive (list (gud-query-cmdline 'sdb))) - - (if (and gud-sdb-needs-tags - (not (and (boundp 'tags-file-name) - (stringp tags-file-name) - (file-exists-p tags-file-name)))) - (error "The sdb support requires a valid tags table to work")) - - (gud-common-init command-line nil 'gud-sdb-marker-filter 'gud-sdb-find-file) - (set (make-local-variable 'gud-minor-mode) 'sdb) - - (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") - (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "s %p" "\C-s" "Step one source line with display.") - (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.") - (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "c" "\C-r" "Continue with display.") - (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.") - - (setq comint-prompt-regexp "\\(^\\|\n\\)\\*") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'sdb-mode-hook) - ) - -;; ====================================================================== -;; dbx functions - -;; History of argument lists passed to dbx. -(defvar gud-dbx-history nil) - -(defcustom gud-dbx-directories nil - "*A list of directories that dbx should search for source code. -If nil, only source files in the program directory -will be known to dbx. - -The file names should be absolute, or relative to the directory -containing the executable being debugged." - :type '(choice (const :tag "Current Directory" nil) - (repeat :value ("") - directory)) - :group 'gud) - -(defun gud-dbx-massage-args (file args) - (nconc (let ((directories gud-dbx-directories) - (result nil)) - (while directories - (setq result (cons (car directories) (cons "-I" result))) - (setq directories (cdr directories))) - (nreverse result)) - args)) - -(defun gud-dbx-marker-filter (string) - (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) - - (let (start) - ;; Process all complete markers in this chunk. - (while (or (string-match - "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" - gud-marker-acc start) - (string-match - "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" - gud-marker-acc start)) - (setq gud-last-frame - (cons (match-string 2 gud-marker-acc) - (string-to-int (match-string 1 gud-marker-acc))) - start (match-end 0))) - - ;; Search for the last incomplete line in this chunk - (while (string-match "\n" gud-marker-acc start) - (setq start (match-end 0))) - - ;; If the incomplete line APPEARS to begin with another marker, keep it - ;; in the accumulator. Otherwise, clear the accumulator to avoid an - ;; unnecessary concat during the next call. - (setq gud-marker-acc - (if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start) - (substring gud-marker-acc (match-beginning 0)) - nil))) - string) - -;; Functions for Mips-style dbx. Given the option `-emacs', documented in -;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's. -(defvar gud-mips-p - (or (string-match "^mips-[^-]*-ultrix" system-configuration) - ;; We haven't tested gud on this system: - (string-match "^mips-[^-]*-riscos" system-configuration) - ;; It's documented on OSF/1.3 - (string-match "^mips-[^-]*-osf1" system-configuration) - (string-match "^alpha[^-]*-[^-]*-osf" system-configuration)) - "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") - -(defvar gud-dbx-command-name - (concat "dbx" (if gud-mips-p " -emacs"))) - -;; This is just like the gdb one except for the regexps since we need to cope -;; with an optional breakpoint number in [] before the ^Z^Z -(defun gud-mipsdbx-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - (while (string-match - ;; This is like th gdb marker but with an optional - ;; leading break point number like `[1] ' - "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame - (cons (match-string 1 gud-marker-acc) - (string-to-int (match-string 2 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 (concat 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)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -;; The dbx in IRIX is a pain. It doesn't print the file name when -;; stopping at a breakpoint (but you do get it from the `up' and -;; `down' commands...). The only way to extract the information seems -;; to be with a `file' command, although the current line number is -;; available in $curline. Thus we have to look for output which -;; appears to indicate a breakpoint. Then we prod the dbx sub-process -;; to output the information we want with a combination of the -;; `printf' and `file' commands as a pseudo marker which we can -;; recognise next time through the marker-filter. This would be like -;; the gdb marker but you can't get the file name without a newline... -;; Note that gud-remove won't work since Irix dbx expects a breakpoint -;; number rather than a line number etc. Maybe this could be made to -;; work by listing all the breakpoints and picking the one(s) with the -;; correct line number, but life's too short. -;; d.love@dl.ac.uk (Dave Love) can be blamed for this - -(defvar gud-irix-p - (and (string-match "^mips-[^-]*-irix" system-configuration) - (not (string-match "irix[6-9]\\.[1-9]" system-configuration))) - "Non-nil to assume the interface appropriate for IRIX dbx. -This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides -a better solution in 6.1 upwards.") -(defvar gud-dbx-use-stopformat-p - (string-match "irix[6-9]\\.[1-9]" system-configuration) - "Non-nil to use the dbx feature present at least from Irix 6.1 - whereby $stopformat=1 produces an output format compatiable with - `gud-dbx-marker-filter'.") -;; [Irix dbx seems to be a moving target. The dbx output changed -;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, -;; the output from `up' is no longer spotted by gud (and it's probably -;; not distinctive enough to try to match it -- use C-<, C-> -;; exclusively) . For 5.3 and 6.0, the $curline variable changed to -;; `long long'(why?!), so the printf stuff needed changing. The line -;; number was cast to `long' as a compromise between the new `long -;; long' and the original `int'. This is reported not to work in 6.2, -;; so it's changed back to int -- don't make your sources too long. -;; From Irix6.1 (but not 6.0?) dbx supports an undocumented feature -;; whereby `set $stopformat=1' reportedly produces output compatible -;; with `gud-dbx-marker-filter', which we prefer. - -;; The process filter is also somewhat -;; unreliable, sometimes not spotting the markers; I don't know -;; whether there's anything that can be done about that. It would be -;; much better if SGI could be persuaded to (re?)instate the MIPS -;; -emacs flag for gdb-like output (which ought to be possible as most -;; of the communication I've had over it has been from sgi.com).] - -;; this filter is influenced by the xdb one rather than the gdb one -(defun gud-irixdbx-marker-filter (string) - (let (result (case-fold-search nil)) - (if (or (string-match comint-prompt-regexp string) - (string-match ".*\012" string)) - (setq result (concat gud-marker-acc string) - gud-marker-acc "") - (setq gud-marker-acc (concat gud-marker-acc string))) - (if result - (cond - ;; look for breakpoint or signal indication e.g.: - ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0] - ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8] - ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188] - ((string-match - "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" - result) - ;; prod dbx into printing out the line number and file - ;; name in a form we can grok as below - (process-send-string (get-buffer-process gud-comint-buffer) - "printf \"\032\032%1d:\",(int)$curline;file\n")) - ;; look for result of, say, "up" e.g.: - ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] - ;; (this will also catch one of the lines printed by "where") - ((string-match - "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" - result) - (let ((file (match-string 1 result))) - (if (file-exists-p file) - (setq gud-last-frame - (cons (match-string 1 result) - (string-to-int (match-string 2 result)))))) - result) - ((string-match ; kluged-up marker as above - "\032\032\\([0-9]*\\):\\(.*\\)\n" result) - (let ((file (gud-file-name (match-string 2 result)))) - (if (and file (file-exists-p file)) - (setq gud-last-frame - (cons file - (string-to-int (match-string 1 result)))))) - (setq result (substring result 0 (match-beginning 0)))))) - (or result ""))) - -(defvar gud-dgux-p (string-match "-dgux" system-configuration) - "Non-nil means to assume the interface approriate for DG/UX dbx. -This was tested using R4.11.") - -;; There are a couple of differences between DG's dbx output and normal -;; dbx output which make it nontrivial to integrate this into the -;; standard dbx-marker-filter (mainly, there are a different number of -;; backreferences). The markers look like: -;; -;; (0) Stopped at line 10, routine main(argc=1, argv=0xeffff0e0), file t.c -;; -;; from breakpoints (the `(0)' there isn't constant, it's the breakpoint -;; number), and -;; -;; Stopped at line 13, routine main(argc=1, argv=0xeffff0e0), file t.c -;; -;; from signals and -;; -;; Frame 21, line 974, routine command_loop(), file keyboard.c -;; -;; from up/down/where. - -(defun gud-dguxdbx-marker-filter (string) - (setq gud-marker-acc (if gud-marker-acc - (concat gud-marker-acc string) - string)) - (let ((re (concat "^\\(\\(([0-9]+) \\)?Stopped at\\|Frame [0-9]+,\\)" - " line \\([0-9]+\\), routine .*, file \\([^ \t\n]+\\)")) - start) - ;; Process all complete markers in this chunk. - (while (string-match re gud-marker-acc start) - (setq gud-last-frame - (cons (match-string 4 gud-marker-acc) - (string-to-int (match-string 3 gud-marker-acc))) - start (match-end 0))) - - ;; Search for the last incomplete line in this chunk - (while (string-match "\n" gud-marker-acc start) - (setq start (match-end 0))) - - ;; If the incomplete line APPEARS to begin with another marker, keep it - ;; in the accumulator. Otherwise, clear the accumulator to avoid an - ;; unnecessary concat during the next call. - (setq gud-marker-acc - (if (string-match "Stopped\\|Frame" gud-marker-acc start) - (substring gud-marker-acc (match-beginning 0)) - nil))) - string) - -;;;###autoload -(defun dbx (command-line) - "Run dbx on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive (list (gud-query-cmdline 'dbx))) - - (cond - (gud-mips-p - (gud-common-init command-line nil 'gud-mipsdbx-marker-filter)) - (gud-irix-p - (gud-common-init command-line 'gud-dbx-massage-args - 'gud-irixdbx-marker-filter)) - (gud-dgux-p - (gud-common-init command-line 'gud-dbx-massage-args - 'gud-dguxdbx-marker-filter)) - (t - (gud-common-init command-line 'gud-dbx-massage-args - 'gud-dbx-marker-filter))) - - (set (make-local-variable 'gud-minor-mode) 'dbx) - - (cond - (gud-mips-p - (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") - (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") - (gud-def gud-break "stop at \"%f\":%l" - "\C-b" "Set breakpoint at current line.") - (gud-def gud-finish "return" "\C-f" "Finish executing current function.")) - (gud-irix-p - (gud-def gud-break "stop at \"%d%f\":%l" - "\C-b" "Set breakpoint at current line.") - (gud-def gud-finish "return" "\C-f" "Finish executing current function.") - (gud-def gud-up "up %p; printf \"\032\032%1d:\",(int)$curline;file\n" - "<" "Up (numeric arg) stack frames.") - (gud-def gud-down "down %p; printf \"\032\032%1d:\",(int)$curline;file\n" - ">" "Down (numeric arg) stack frames.") - ;; Make dbx give out the source location info that we need. - (process-send-string (get-buffer-process gud-comint-buffer) - "printf \"\032\032%1d:\",(int)$curline;file\n")) - (t - (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") - (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") - (gud-def gud-break "file \"%d%f\"\nstop at %l" - "\C-b" "Set breakpoint at current line.") - (if gud-dbx-use-stopformat-p - (process-send-string (get-buffer-process gud-comint-buffer) - "set $stopformat=1\n")))) - - (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step %p" "\C-s" "Step one line with display.") - (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") - (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "cont" "\C-r" "Continue with display.") - (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") - - (setq comint-prompt-regexp "^[^)\n]*dbx) *") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'dbx-mode-hook) - ) - -;; ====================================================================== -;; xdb (HP PARISC debugger) functions - -;; History of argument lists passed to xdb. -(defvar gud-xdb-history nil) - -(defcustom gud-xdb-directories nil - "*A list of directories that xdb should search for source code. -If nil, only source files in the program directory -will be known to xdb. - -The file names should be absolute, or relative to the directory -containing the executable being debugged." - :type '(choice (const :tag "Current Directory" nil) - (repeat :value ("") - directory)) - :group 'gud) - -(defun gud-xdb-massage-args (file args) - (nconc (let ((directories gud-xdb-directories) - (result nil)) - (while directories - (setq result (cons (car directories) (cons "-d" result))) - (setq directories (cdr directories))) - (nreverse result)) - args)) - -;; xdb does not print the lines all at once, so we have to accumulate them -(defun gud-xdb-marker-filter (string) - (let (result) - (if (or (string-match comint-prompt-regexp string) - (string-match ".*\012" string)) - (setq result (concat gud-marker-acc string) - gud-marker-acc "") - (setq gud-marker-acc (concat gud-marker-acc string))) - (if result - (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]" - result) - (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" - result)) - (let ((line (string-to-int (match-string 2 result))) - (file (gud-file-name (match-string 1 result)))) - (if file - (setq gud-last-frame (cons file line)))))) - (or result ""))) - -;;;###autoload -(defun xdb (command-line) - "Run xdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger. - -You can set the variable 'gud-xdb-directories' to a list of program source -directories if your program contains sources from more than one directory." - (interactive (list (gud-query-cmdline 'xdb))) - - (gud-common-init command-line 'gud-xdb-massage-args - 'gud-xdb-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'xdb) - - (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "b %f:%l\\t" "\C-t" - "Set temporary breakpoint at current line.") - (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "s %p" "\C-s" "Step one line with display.") - (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "c" "\C-r" "Continue with display.") - (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") - (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") - (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.") - (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.") - - (setq comint-prompt-regexp "^>") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'xdb-mode-hook)) - -;; ====================================================================== -;; perldb functions - -;; History of argument lists passed to perldb. -(defvar gud-perldb-history nil) - -(defun gud-perldb-massage-args (file args) - "Convert a command line as would be typed normally to run perldb -into one that invokes an Emacs-enabled debugging session. -\"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." - ;; FIXME: what if the command is `make perldb' and doesn't accept those extra - ;; arguments ? - (let* ((new-args nil) - (seen-e nil) - (shift (lambda () (push (pop args) new-args)))) - - ;; Pass all switches and -e scripts through. - (while (and args - (string-match "^-" (car args)) - (not (equal "-" (car args))) - (not (equal "--" (car args)))) - (when (equal "-e" (car args)) - ;; -e goes with the next arg, so shift one extra. - (or (funcall shift) - ;; -e as the last arg is an error in Perl. - (error "No code specified for -e")) - (setq seen-e t)) - (funcall shift)) - - (unless seen-e - (if (or (not args) - (string-match "^-" (car args))) - (error "Can't use stdin as the script to debug")) - ;; This is the program name. - (funcall shift)) - - ;; If -e specified, make sure there is a -- so -emacs is not taken - ;; as -e macs. - (if (and args (equal "--" (car args))) - (funcall shift) - (and seen-e (push "--" new-args))) - - (push "-emacs" new-args) - (while args - (funcall shift)) - - (nreverse new-args))) - -;; There's no guarantee that Emacs will hand the filter the entire -;; marker at once; it could be broken up across several strings. We -;; might even receive a big chunk with several markers in it. If we -;; receive a chunk of text which looks like it might contain the -;; beginning of a marker, we save it here between calls to the -;; filter. -(defun gud-perldb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame - (cons (match-string 1 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 (concat 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)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -(defcustom gud-perldb-command-name "perl -d" - "Default command to execute a Perl script under debugger." - :type 'string - :group 'gud) - -;;;###autoload -(defun perldb (command-line) - "Run perldb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive - (list (gud-query-cmdline 'perldb - (concat (or (buffer-file-name) "-e 0") " ")))) - - (gud-common-init command-line 'gud-perldb-massage-args - 'gud-perldb-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'perldb) - - (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "s" "\C-s" "Step one source line with display.") - (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "c" "\C-r" "Continue with display.") -; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") -; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") -; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") - - (setq comint-prompt-regexp "^ DB<+[0-9]+>+ ") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'perldb-mode-hook)) - -;; ====================================================================== -;; pdb (Python debugger) functions - -;; History of argument lists passed to pdb. -(defvar gud-pdb-history nil) - -;; Last group is for return value, e.g. "> test.py(2)foo()->None" -;; Either file or function name may be omitted: "> <string>(0)?()" -(defvar gud-pdb-marker-regexp - "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\)()\\(->[^\n]*\\)?\n") -(defvar gud-pdb-marker-regexp-file-group 1) -(defvar gud-pdb-marker-regexp-line-group 2) -(defvar gud-pdb-marker-regexp-fnname-group 3) - -(defvar gud-pdb-marker-regexp-start "^> ") - -;; There's no guarantee that Emacs will hand the filter the entire -;; marker at once; it could be broken up across several strings. We -;; might even receive a big chunk with several markers in it. If we -;; receive a chunk of text which looks like it might contain the -;; beginning of a marker, we save it here between calls to the -;; filter. -(defun gud-pdb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - (while (string-match gud-pdb-marker-regexp gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame - (let ((file (match-string gud-pdb-marker-regexp-file-group - gud-marker-acc)) - (line (string-to-int - (match-string gud-pdb-marker-regexp-line-group - gud-marker-acc)))) - (if (string-equal file "<string>") - gud-last-frame - (cons file line))) - - ;; Output everything instead of the below - output (concat output (substring gud-marker-acc 0 (match-end 0))) -;; ;; Append any text before the marker to the output we're going -;; ;; to return - we don't include the marker in this text. -;; output (concat 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)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match gud-pdb-marker-regexp-start gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -(defcustom gud-pdb-command-name "pdb" - "File name for executing the Python debugger. -This should be an executable on your path, or an absolute file name." - :type 'string - :group 'gud) - -;;;###autoload -(defun pdb (command-line) - "Run pdb on program FILE in buffer `*gud-FILE*'. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive - (list (gud-query-cmdline 'pdb))) - - (gud-common-init command-line nil 'gud-pdb-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'pdb) - - (gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step" "\C-s" "Step one source line with display.") - (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "continue" "\C-r" "Continue with display.") - (gud-def gud-finish "return" "\C-f" "Finish executing current function.") - (gud-def gud-up "up" "<" "Up one stack frame.") - (gud-def gud-down "down" ">" "Down one stack frame.") - (gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at point.") - ;; Is this right? - (gud-def gud-statement "! %e" "\C-e" "Execute Python statement at point.") - - ;; (setq comint-prompt-regexp "^(.*pdb[+]?) *") - (setq comint-prompt-regexp "^(Pdb) *") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'pdb-mode-hook)) - -;; ====================================================================== -;; -;; JDB support. -;; -;; AUTHOR: Derek Davies <ddavies@world.std.com> -;; Zoltan Kemenczy <zoltan@ieee.org;zkemenczy@rim.net> -;; -;; CREATED: Sun Feb 22 10:46:38 1998 Derek Davies. -;; UPDATED: Nov 11, 2001 Zoltan Kemenczy -;; Dec 10, 2002 Zoltan Kemenczy - added nested class support -;; -;; INVOCATION NOTES: -;; -;; You invoke jdb-mode with: -;; -;; M-x jdb <enter> -;; -;; It responds with: -;; -;; Run jdb (like this): jdb -;; -;; type any jdb switches followed by the name of the class you'd like to debug. -;; Supply a fully qualfied classname (these do not have the ".class" extension) -;; for the name of the class to debug (e.g. "COM.the-kind.ddavies.CoolClass"). -;; See the known problems section below for restrictions when specifying jdb -;; command line switches (search forward for '-classpath'). -;; -;; You should see something like the following: -;; -;; Current directory is ~/src/java/hello/ -;; Initializing jdb... -;; 0xed2f6628:class(hello) -;; > -;; -;; To set an initial breakpoint try: -;; -;; > stop in hello.main -;; Breakpoint set in hello.main -;; > -;; -;; To execute the program type: -;; -;; > run -;; run hello -;; -;; Breakpoint hit: running ... -;; hello.main (hello:12) -;; -;; Type M-n to step over the current line and M-s to step into it. That, -;; along with the JDB 'help' command should get you started. The 'quit' -;; JDB command will get out out of the debugger. There is some truly -;; pathetic JDB documentation available at: -;; -;; http://java.sun.com/products/jdk/1.1/debugging/ -;; -;; KNOWN PROBLEMS AND FIXME's: -;; -;; Not sure what happens with inner classes ... haven't tried them. -;; -;; Does not grok UNICODE id's. Only ASCII id's are supported. -;; -;; You must not put whitespace between "-classpath" and the path to -;; search for java classes even though it is required when invoking jdb -;; from the command line. See gud-jdb-massage-args for details. -;; The same applies for "-sourcepath". -;; -;; Note: The following applies only if `gud-jdb-use-classpath' is nil; -;; refer to the documentation of `gud-jdb-use-classpath' and -;; `gud-jdb-classpath',`gud-jdb-sourcepath' variables for information -;; on using the classpath for locating java source files. -;; -;; If any of the source files in the directories listed in -;; gud-jdb-directories won't parse you'll have problems. Make sure -;; every file ending in ".java" in these directories parses without error. -;; -;; All the .java files in the directories in gud-jdb-directories are -;; syntactically analyzed each time gud jdb is invoked. It would be -;; nice to keep as much information as possible between runs. It would -;; be really nice to analyze the files only as neccessary (when the -;; source needs to be displayed.) I'm not sure to what extent the former -;; can be accomplished and I'm not sure the latter can be done at all -;; since I don't know of any general way to tell which .class files are -;; defined by which .java file without analyzing all the .java files. -;; If anyone knows why JavaSoft didn't put the source file names in -;; debuggable .class files please clue me in so I find something else -;; to be spiteful and bitter about. -;; -;; ====================================================================== -;; gud jdb variables and functions - -(defcustom gud-jdb-command-name "jdb" - "Command that executes the Java debugger." - :type 'string - :group 'gud) - -(defcustom gud-jdb-use-classpath t - "If non-nil, search for Java source files in classpath directories. -The list of directories to search is the value of `gud-jdb-classpath'. -The file pathname is obtained by converting the fully qualified -class information output by jdb to a relative pathname and appending -it to `gud-jdb-classpath' element by element until a match is found. - -This method has a significant jdb startup time reduction advantage -since it does not require the scanning of all `gud-jdb-directories' -and parsing all Java files for class information. - -Set to nil to use `gud-jdb-directories' to scan java sources for -class information on jdb startup (original method)." - :type 'boolean - :group 'gud) - -(defvar gud-jdb-classpath nil - "Java/jdb classpath directories list. -If `gud-jdb-use-classpath' is non-nil, gud-jdb derives the `gud-jdb-classpath' -list automatically using the following methods in sequence -\(with subsequent successful steps overriding the results of previous -steps): - -1) Read the CLASSPATH environment variable, -2) Read any \"-classpath\" argument used to run jdb, - or detected in jdb output (e.g. if jdb is run by a script - that echoes the actual jdb command before starting jdb) -3) Send a \"classpath\" command to jdb and scan jdb output for - classpath information if jdb is invoked with an \"-attach\" (to - an already running VM) argument (This case typically does not - have a \"-classpath\" command line argument - that is provided - to the VM when it is started). - -Note that method 3 cannot be used with oldjdb (or Java 1 jdb) since -those debuggers do not support the classpath command. Use 1) or 2).") - -(defvar gud-jdb-sourcepath nil - "Directory list provided by an (optional) \"-sourcepath\" option to jdb. -This list is prepended to `gud-jdb-classpath' to form the complete -list of directories searched for source files.") - -(defvar gud-marker-acc-max-length 4000 - "Maximum number of debugger output characters to keep. -This variable limits the size of `gud-marker-acc' which holds -the most recent debugger output history while searching for -source file information.") - -(defvar gud-jdb-history nil -"History of argument lists passed to jdb.") - - -;; List of Java source file directories. -(defvar gud-jdb-directories (list ".") - "*A list of directories that gud jdb should search for source code. -The file names should be absolute, or relative to the current -directory. - -The set of .java files residing in the directories listed are -syntactically analyzed to determine the classes they define and the -packages in which these classes belong. In this way gud jdb maps the -package-qualified class names output by the jdb debugger to the source -file from which the class originated. This allows gud mode to keep -the source code display in sync with the debugging session.") - -(defvar gud-jdb-source-files nil -"List of the java source files for this debugging session.") - -;; Association list of fully qualified class names (package + class name) -;; and their source files. -(defvar gud-jdb-class-source-alist nil -"Association list of fully qualified class names and source files.") - -;; This is used to hold a source file during analysis. -(defvar gud-jdb-analysis-buffer nil) - -(defvar gud-jdb-classpath-string nil -"Holds temporary classpath values.") - -(defun gud-jdb-build-source-files-list (path extn) -"Return a list of java source files (absolute paths). -PATH gives the directories in which to search for files with -extension EXTN. Normally EXTN is given as the regular expression - \"\\.java$\" ." - (apply 'nconc (mapcar (lambda (d) - (when (file-directory-p d) - (directory-files d t extn nil))) - path))) - -;; Move point past whitespace. -(defun gud-jdb-skip-whitespace () - (skip-chars-forward " \n\r\t\014")) - -;; Move point past a "// <eol>" type of comment. -(defun gud-jdb-skip-single-line-comment () - (end-of-line)) - -;; Move point past a "/* */" or "/** */" type of comment. -(defun gud-jdb-skip-traditional-or-documentation-comment () - (forward-char 2) - (catch 'break - (while (not (eobp)) - (if (eq (following-char) ?*) - (progn - (forward-char) - (if (not (eobp)) - (if (eq (following-char) ?/) - (progn - (forward-char) - (throw 'break nil))))) - (forward-char))))) - -;; Move point past any number of consecutive whitespace chars and/or comments. -(defun gud-jdb-skip-whitespace-and-comments () - (gud-jdb-skip-whitespace) - (catch 'done - (while t - (cond - ((looking-at "//") - (gud-jdb-skip-single-line-comment) - (gud-jdb-skip-whitespace)) - ((looking-at "/\\*") - (gud-jdb-skip-traditional-or-documentation-comment) - (gud-jdb-skip-whitespace)) - (t (throw 'done nil)))))) - -;; Move point past things that are id-like. The intent is to skip regular -;; id's, such as class or interface names as well as package and interface -;; names. -(defun gud-jdb-skip-id-ish-thing () - (skip-chars-forward "^ /\n\r\t\014,;{")) - -;; Move point past a string literal. -(defun gud-jdb-skip-string-literal () - (forward-char) - (while (not (cond - ((eq (following-char) ?\\) - (forward-char)) - ((eq (following-char) ?\042)))) - (forward-char)) - (forward-char)) - -;; Move point past a character literal. -(defun gud-jdb-skip-character-literal () - (forward-char) - (while - (progn - (if (eq (following-char) ?\\) - (forward-char 2)) - (not (eq (following-char) ?\'))) - (forward-char)) - (forward-char)) - -;; Move point past the following block. There may be (legal) cruft before -;; the block's opening brace. There must be a block or it's the end of life -;; in petticoat junction. -(defun gud-jdb-skip-block () - - ;; Find the begining of the block. - (while - (not (eq (following-char) ?{)) - - ;; Skip any constructs that can harbor literal block delimiter - ;; characters and/or the delimiters for the constructs themselves. - (cond - ((looking-at "//") - (gud-jdb-skip-single-line-comment)) - ((looking-at "/\\*") - (gud-jdb-skip-traditional-or-documentation-comment)) - ((eq (following-char) ?\042) - (gud-jdb-skip-string-literal)) - ((eq (following-char) ?\') - (gud-jdb-skip-character-literal)) - (t (forward-char)))) - - ;; Now at the begining of the block. - (forward-char) - - ;; Skip over the body of the block as well as the final brace. - (let ((open-level 1)) - (while (not (eq open-level 0)) - (cond - ((looking-at "//") - (gud-jdb-skip-single-line-comment)) - ((looking-at "/\\*") - (gud-jdb-skip-traditional-or-documentation-comment)) - ((eq (following-char) ?\042) - (gud-jdb-skip-string-literal)) - ((eq (following-char) ?\') - (gud-jdb-skip-character-literal)) - ((eq (following-char) ?{) - (setq open-level (+ open-level 1)) - (forward-char)) - ((eq (following-char) ?}) - (setq open-level (- open-level 1)) - (forward-char)) - (t (forward-char)))))) - -;; Find the package and class definitions in Java source file FILE. Assumes -;; that FILE contains a legal Java program. BUF is a scratch buffer used -;; to hold the source during analysis. -(defun gud-jdb-analyze-source (buf file) - (let ((l nil)) - (set-buffer buf) - (insert-file-contents file nil nil nil t) - (goto-char 0) - (catch 'abort - (let ((p "")) - (while (progn - (gud-jdb-skip-whitespace) - (not (eobp))) - (cond - - ;; Any number of semi's following a block is legal. Move point - ;; past them. Note that comments and whitespace may be - ;; interspersed as well. - ((eq (following-char) ?\073) - (forward-char)) - - ;; Move point past a single line comment. - ((looking-at "//") - (gud-jdb-skip-single-line-comment)) - - ;; Move point past a traditional or documentation comment. - ((looking-at "/\\*") - (gud-jdb-skip-traditional-or-documentation-comment)) - - ;; Move point past a package statement, but save the PackageName. - ((looking-at "package") - (forward-char 7) - (gud-jdb-skip-whitespace-and-comments) - (let ((s (point))) - (gud-jdb-skip-id-ish-thing) - (setq p (concat (buffer-substring s (point)) ".")) - (gud-jdb-skip-whitespace-and-comments) - (if (eq (following-char) ?\073) - (forward-char)))) - - ;; Move point past an import statement. - ((looking-at "import") - (forward-char 6) - (gud-jdb-skip-whitespace-and-comments) - (gud-jdb-skip-id-ish-thing) - (gud-jdb-skip-whitespace-and-comments) - (if (eq (following-char) ?\073) - (forward-char))) - - ;; Move point past the various kinds of ClassModifiers. - ((looking-at "public") - (forward-char 6)) - ((looking-at "abstract") - (forward-char 8)) - ((looking-at "final") - (forward-char 5)) - - ;; Move point past a ClassDeclaraction, but save the class - ;; Identifier. - ((looking-at "class") - (forward-char 5) - (gud-jdb-skip-whitespace-and-comments) - (let ((s (point))) - (gud-jdb-skip-id-ish-thing) - (setq - l (nconc l (list (concat p (buffer-substring s (point))))))) - (gud-jdb-skip-block)) - - ;; Move point past an interface statement. - ((looking-at "interface") - (forward-char 9) - (gud-jdb-skip-block)) - - ;; Anything else means the input is invalid. - (t - (message (format "Error parsing file %s." file)) - (throw 'abort nil)))))) - l)) - -(defun gud-jdb-build-class-source-alist-for-file (file) - (mapcar - (lambda (c) - (cons c file)) - (gud-jdb-analyze-source gud-jdb-analysis-buffer file))) - -;; Return an alist of fully qualified classes and the source files -;; holding their definitions. SOURCES holds a list of all the source -;; files to examine. -(defun gud-jdb-build-class-source-alist (sources) - (setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*")) - (prog1 - (apply - 'nconc - (mapcar - 'gud-jdb-build-class-source-alist-for-file - sources)) - (kill-buffer gud-jdb-analysis-buffer) - (setq gud-jdb-analysis-buffer nil))) - -;; Change what was given in the minibuffer to something that can be used to -;; invoke the debugger. -(defun gud-jdb-massage-args (file args) - ;; The jdb executable must have whitespace between "-classpath" and - ;; its value while gud-common-init expects all switch values to - ;; follow the switch keyword without intervening whitespace. We - ;; require that when the user enters the "-classpath" switch in the - ;; EMACS minibuffer that they do so without the intervening - ;; whitespace. This function adds it back (it's called after - ;; gud-common-init). There are more switches like this (for - ;; instance "-host" and "-password") but I don't care about them - ;; yet. - (if args - (let (massaged-args user-error) - - (while (and args (not user-error)) - (cond - ((setq user-error (string-match "-classpath$" (car args)))) - ((setq user-error (string-match "-sourcepath$" (car args)))) - ((string-match "-classpath\\(.+\\)" (car args)) - (setq massaged-args - (append massaged-args - (list "-classpath" - (setq gud-jdb-classpath-string - (match-string 1 (car args))))))) - ((string-match "-sourcepath\\(.+\\)" (car args)) - (setq massaged-args - (append massaged-args - (list "-sourcepath" - (setq gud-jdb-sourcepath - (match-string 1 (car args))))))) - (t (setq massaged-args (append massaged-args (list (car args)))))) - (setq args (cdr args))) - - ;; By this point the current directory is all screwed up. Maybe we - ;; could fix things and re-invoke gud-common-init, but for now I think - ;; issueing the error is good enough. - (if user-error - (progn - (kill-buffer (current-buffer)) - (error "Error: Omit whitespace between '-classpath or -sourcepath' and its value"))) - massaged-args))) - -;; Search for an association with P, a fully qualified class name, in -;; gud-jdb-class-source-alist. The asssociation gives the fully -;; qualified file name of the source file which produced the class. -(defun gud-jdb-find-source-file (p) - (cdr (assoc p gud-jdb-class-source-alist))) - -;; Note: Reset to this value every time a prompt is seen -(defvar gud-jdb-lowest-stack-level 999) - -(defun gud-jdb-find-source-using-classpath (p) -"Find source file corresponding to fully qualified class p. -Convert p from jdb's output, converted to a pathname -relative to a classpath directory." - (save-match-data - (let - (;; Replace dots with slashes and append ".java" to generate file - ;; name relative to classpath - (filename - (concat - (mapconcat 'identity - (split-string - ;; Eliminate any subclass references in the class - ;; name string. These start with a "$" - ((lambda (x) - (if (string-match "$.*" x) - (replace-match "" t t x) p)) - p) - "\\.") "/") - ".java")) - (cplist (append gud-jdb-sourcepath gud-jdb-classpath)) - found-file) - (while (and cplist - (not (setq found-file - (file-readable-p - (concat (car cplist) "/" filename))))) - (setq cplist (cdr cplist))) - (if found-file (concat (car cplist) "/" filename))))) - -(defun gud-jdb-find-source (string) -"Alias for function used to locate source files. -Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file' -during jdb initialization depending on the value of -`gud-jdb-use-classpath'." -nil) - -(defun gud-jdb-parse-classpath-string (string) -"Parse the classpath list and convert each item to an absolute pathname." - (mapcar (lambda (s) (if (string-match "[/\\]$" s) - (replace-match "" nil nil s) s)) - (mapcar 'file-truename - (split-string - string - (concat "[ \t\n\r,\"" path-separator "]+"))))) - -;; See comentary for other debugger's marker filters - there you will find -;; important notes about STRING. -(defun gud-jdb-marker-filter (string) - - ;; Build up the accumulator. - (setq gud-marker-acc - (if gud-marker-acc - (concat gud-marker-acc string) - string)) - - ;; Look for classpath information until gud-jdb-classpath-string is found - ;; (interactive, multiple settings of classpath from jdb - ;; not supported/followed) - (if (and gud-jdb-use-classpath - (not gud-jdb-classpath-string) - (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc) - (string-match "-classpath[ \t\"]+\\([^ \"]+\\)" gud-marker-acc))) - (setq gud-jdb-classpath - (gud-jdb-parse-classpath-string - (setq gud-jdb-classpath-string - (match-string 1 gud-marker-acc))))) - - ;; We process STRING from left to right. Each time through the - ;; following loop we process at most one marker. After we've found a - ;; marker, delete gud-marker-acc up to and including the match - (let (file-found) - ;; Process each complete marker in the input. - (while - - ;; Do we see a marker? - (string-match - ;; jdb puts out a string of the following form when it - ;; hits a breakpoint: - ;; - ;; <fully-qualified-class><method> (<class>:<line-number>) - ;; - ;; <fully-qualified-class>'s are composed of Java ID's - ;; separated by periods. <method> and <class> are - ;; also Java ID's. <method> begins with a period and - ;; may contain less-than and greater-than (constructors, - ;; for instance, are called <init> in the symbol table.) - ;; Java ID's begin with a letter followed by letters - ;; and/or digits. The set of letters includes underscore - ;; and dollar sign. - ;; - ;; The first group matches <fully-qualified-class>, - ;; the second group matches <class> and the third group - ;; matches <line-number>. We don't care about using - ;; <method> so we don't "group" it. - ;; - ;; FIXME: Java ID's are UNICODE strings, this matches ASCII - ;; ID's only. - ;; - ;; The "," in the last square-bracket is necessary because of - ;; Sun's total disrespect for backwards compatibility in - ;; reported line numbers from jdb - starting in 1.4.0 they - ;; introduced a comma at the thousands position (how - ;; ingenious!) - - "\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \ -\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9,]+\\)" - gud-marker-acc) - - ;; A good marker is one that: - ;; 1) does not have a "[n] " prefix (not part of a stack backtrace) - ;; 2) does have an "[n] " prefix and n is the lowest prefix seen - ;; since the last prompt - ;; Figure out the line on which to position the debugging arrow. - ;; Return the info as a cons of the form: - ;; - ;; (<file-name> . <line-number>) . - (if (if (match-beginning 1) - (let (n) - (setq n (string-to-int (substring - gud-marker-acc - (1+ (match-beginning 1)) - (- (match-end 1) 2)))) - (if (< n gud-jdb-lowest-stack-level) - (progn (setq gud-jdb-lowest-stack-level n) t))) - t) - (if (setq file-found - (gud-jdb-find-source (match-string 2 gud-marker-acc))) - (setq gud-last-frame - (cons file-found - (string-to-int - (let - ((numstr (match-string 4 gud-marker-acc))) - (if (string-match "," numstr) - (replace-match "" nil nil numstr) - numstr))))) - (message "Could not find source file."))) - - ;; Set the accumulator to the remaining text. - (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))) - - (if (string-match comint-prompt-regexp gud-marker-acc) - (setq gud-jdb-lowest-stack-level 999))) - - ;; Do not allow gud-marker-acc to grow without bound. If the source - ;; file information is not within the last 3/4 - ;; gud-marker-acc-max-length characters, well,... - (if (> (length gud-marker-acc) gud-marker-acc-max-length) - (setq gud-marker-acc - (substring gud-marker-acc - (- (/ (* gud-marker-acc-max-length 3) 4))))) - - ;; We don't filter any debugger output so just return what we were given. - string) - -(defvar gud-jdb-command-name "jdb" "Command that executes the Java debugger.") - -;;;###autoload -(defun jdb (command-line) - "Run jdb with command line COMMAND-LINE in a buffer. -The buffer is named \"*gud*\" if no initial class is given or -\"*gud-<initial-class-basename>*\" if there is. If the \"-classpath\" -switch is given, omit all whitespace between it and its value. - -See `gud-jdb-use-classpath' and `gud-jdb-classpath' documentation for -information on how jdb accesses source files. Alternatively (if -`gud-jdb-use-classpath' is nil), see `gud-jdb-directories' for the -original source file access method. - -For general information about commands available to control jdb from -gud, see `gud-mode'." - (interactive - (list (gud-query-cmdline 'jdb))) - (setq gud-jdb-classpath nil) - (setq gud-jdb-sourcepath nil) - - ;; Set gud-jdb-classpath from the CLASSPATH environment variable, - ;; if CLASSPATH is set. - (setq gud-jdb-classpath-string (getenv "CLASSPATH")) - (if gud-jdb-classpath-string - (setq gud-jdb-classpath - (gud-jdb-parse-classpath-string gud-jdb-classpath-string))) - (setq gud-jdb-classpath-string nil) ; prepare for next - - (gud-common-init command-line 'gud-jdb-massage-args - 'gud-jdb-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'jdb) - - ;; If a -classpath option was provided, set gud-jdb-classpath - (if gud-jdb-classpath-string - (setq gud-jdb-classpath - (gud-jdb-parse-classpath-string gud-jdb-classpath-string))) - (setq gud-jdb-classpath-string nil) ; prepare for next - ;; If a -sourcepath option was provided, parse it - (if gud-jdb-sourcepath - (setq gud-jdb-sourcepath - (gud-jdb-parse-classpath-string gud-jdb-sourcepath))) - - (gud-def gud-break "stop at %c:%l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-remove "clear %c:%l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step" "\C-s" "Step one source line with display.") - (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "cont" "\C-r" "Continue with display.") - (gud-def gud-finish "step up" "\C-f" "Continue until current method returns.") - (gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.") - (gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.") - (gud-def gud-run "run" nil "Run the program.") ;if VM start using jdb - - (setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'jdb-mode-hook) - - (if gud-jdb-use-classpath - ;; Get the classpath information from the debugger - (progn - (if (string-match "-attach" command-line) - (gud-call "classpath")) - (fset 'gud-jdb-find-source - 'gud-jdb-find-source-using-classpath)) - - ;; Else create and bind the class/source association list as well - ;; as the source file list. - (setq gud-jdb-class-source-alist - (gud-jdb-build-class-source-alist - (setq gud-jdb-source-files - (gud-jdb-build-source-files-list gud-jdb-directories - "\\.java$")))) - (fset 'gud-jdb-find-source 'gud-jdb-find-source-file))) - - -;; ====================================================================== -;; -;; BASHDB support. See http://bashdb.sourceforge.net -;; -;; AUTHOR: Rocky Bernstein <rocky@panix.com> -;; -;; CREATED: Sun Nov 10 10:46:38 2002 Rocky Bernstein. -;; -;; INVOCATION NOTES: -;; -;; You invoke bashdb-mode with: -;; -;; M-x bashdb <enter> -;; -;; It responds with: -;; -;; Run bashdb (like this): bash -;; - -;; History of argument lists passed to bashdb. -(defvar gud-bashdb-history nil) - -;; Convert a command line as would be typed normally to run a script -;; into one that invokes an Emacs-enabled debugging session. -;; "--debugger" in inserted as the first switch. - -;; There's no guarantee that Emacs will hand the filter the entire -;; marker at once; it could be broken up across several strings. We -;; might even receive a big chunk with several markers in it. If we -;; receive a chunk of text which looks like it might contain the -;; beginning of a marker, we save it here between calls to the -;; filter. -(defun gud-bashdb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - ;; Format of line looks like this: - ;; (/etc/init.d/ntp.init:16): - ;; but we also allow DOS drive letters - ;; (d:/etc/init.d/ntp.init:16): - (while (string-match "\\(^\\|\n\\)(\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\)):.*\n" - 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 4 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 (concat 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)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -(defcustom gud-bashdb-command-name "bash --debugger" - "File name for executing bash debugger." - :type 'string - :group 'gud) - -;;;###autoload -(defun bashdb (command-line) - "Run bashdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive - (list (read-from-minibuffer "Run bashdb (like this): " - (if (consp gud-bashdb-history) - (car gud-bashdb-history) - (concat gud-bashdb-command-name - " ")) - gud-minibuffer-local-map nil - '(gud-bashdb-history . 1)))) - - (gud-common-init command-line nil 'gud-bashdb-marker-filter) - - (set (make-local-variable 'gud-minor-mode) 'bashdb) - - (gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "tbreak %l" "\C-t" "Set temporary breakpoint at current line.") - (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step" "\C-s" "Step one source line with display.") - (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "continue" "\C-r" "Continue with display.") - (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") - (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") - (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "x %e" "\C-p" "Evaluate BASH expression at point.") - - ;; Is this right? - (gud-def gud-statement "eval %e" "\C-e" "Execute BASH statement at point.") - - (setq comint-prompt-regexp "^bashdb<+(*[0-9]+)*>+ ") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'bashdb-mode-hook) - ) - -;; -;; End of debugger-specific information -;; - - -;; When we send a command to the debugger via gud-call, it's annoying -;; to see the command and the new prompt inserted into the debugger's -;; buffer; we have other ways of knowing the command has completed. -;; -;; If the buffer looks like this: -;; -------------------- -;; (gdb) set args foo bar -;; (gdb) -!- -;; -------------------- -;; (the -!- marks the location of point), and we type `C-x SPC' in a -;; source file to set a breakpoint, we want the buffer to end up like -;; this: -;; -------------------- -;; (gdb) set args foo bar -;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. -;; (gdb) -!- -;; -------------------- -;; Essentially, the old prompt is deleted, and the command's output -;; and the new prompt take its place. -;; -;; Not echoing the command is easy enough; you send it directly using -;; process-send-string, and it never enters the buffer. However, -;; getting rid of the old prompt is trickier; you don't want to do it -;; when you send the command, since that will result in an annoying -;; flicker as the prompt is deleted, redisplay occurs while Emacs -;; waits for a response from the debugger, and the new prompt is -;; inserted. Instead, we'll wait until we actually get some output -;; from the subprocess before we delete the prompt. If the command -;; produced no output other than a new prompt, that prompt will most -;; likely be in the first chunk of output received, so we will delete -;; the prompt and then replace it with an identical one. If the -;; command produces output, the prompt is moving anyway, so the -;; flicker won't be annoying. -;; -;; So - when we want to delete the prompt upon receipt of the next -;; chunk of debugger output, we position gud-delete-prompt-marker at -;; the start of the prompt; the process filter will notice this, and -;; delete all text between it and the process output marker. If -;; gud-delete-prompt-marker points nowhere, we leave the current -;; prompt alone. -(defvar gud-delete-prompt-marker nil) - - -(put 'gud-mode 'mode-class 'special) - -(define-derived-mode gud-mode comint-mode "Debugger" - "Major mode for interacting with an inferior debugger process. - - You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, -M-x perldb, M-x xdb, or M-x jdb. Each entry point finishes by executing a -hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook', -`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' respectively. - -After startup, the following commands are available in both the GUD -interaction buffer and any source buffer GUD visits due to a breakpoint stop -or step operation: - -\\[gud-break] sets a breakpoint at the current file and line. In the -GUD buffer, the current file and line are those of the last breakpoint or -step. In a source buffer, they are the buffer's file and current line. - -\\[gud-remove] removes breakpoints on the current file and line. - -\\[gud-refresh] displays in the source window the last line referred to -in the gud buffer. - -\\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line, -step-one-line (not entering function calls), and step-one-instruction -and then update the source window with the current file and position. -\\[gud-cont] continues execution. - -\\[gud-print] tries to find the largest C lvalue or function-call expression -around point, and sends it to the debugger for value display. - -The above commands are common to all supported debuggers except xdb which -does not support stepping instructions. - -Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break], -except that the breakpoint is temporary; that is, it is removed when -execution stops on it. - -Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack -frame. \\[gud-down] drops back down through one. - -If you are using gdb or xdb, \\[gud-finish] runs execution to the return from -the current function and stops. - -All the keystrokes above are accessible in the GUD buffer -with the prefix C-c, and in all buffers through the prefix C-x C-a. - -All pre-defined functions for which the concept make sense repeat -themselves the appropriate number of times if you give a prefix -argument. - -You may use the `gud-def' macro in the initialization hook to define other -commands. - -Other commands for interacting with the debugger process are inherited from -comint mode, which see." - (setq mode-line-process '(":%s")) - (define-key (current-local-map) "\C-c\C-l" 'gud-refresh) - (set (make-local-variable 'gud-last-frame) nil) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) - (make-local-variable 'comint-prompt-regexp) - ;; Don't put repeated commands in command history many times. - (set (make-local-variable 'comint-input-ignoredups) t) - (make-local-variable 'paragraph-start) - (set (make-local-variable 'gud-delete-prompt-marker) (make-marker))) - -;; Cause our buffers to be displayed, by default, -;; in the selected window. -;;;###autoload (add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)") - -(defcustom gud-chdir-before-run t - "Non-nil if GUD should `cd' to the debugged executable." - :group 'gud - :type 'boolean) - -(defvar gud-target-name "--unknown--" - "The apparent name of the program being debugged in a gud buffer.") - -;; Perform initializations common to all debuggers. -;; The first arg is the specified command line, -;; which starts with the program to debug. -;; The other three args specify the values to use -;; for local variables in the debugger buffer. -(defun gud-common-init (command-line massage-args marker-filter - &optional find-file) - (let* ((words (split-string command-line)) - (program (car words)) - (dir default-directory) - ;; Extract the file name from WORDS - ;; and put t in its place. - ;; Later on we will put the modified file name arg back there. - (file-word (let ((w (cdr words))) - (while (and w (= ?- (aref (car w) 0))) - (setq w (cdr w))) - (and w - (prog1 (car w) - (setcar w t))))) - (file-subst - (and file-word (substitute-in-file-name file-word))) - (args (cdr words)) - ;; If a directory was specified, expand the file name. - ;; Otherwise, don't expand it, so GDB can use the PATH. - ;; A file name without directory is literally valid - ;; only if the file exists in ., and in that case, - ;; omitting the expansion here has no visible effect. - (file (and file-word - (if (file-name-directory file-subst) - (expand-file-name file-subst) - file-subst))) - (filepart (and file-word (concat "-" (file-name-nondirectory file))))) - (pop-to-buffer (concat "*gud" filepart "*")) - ;; Set the dir, in case the buffer already existed with a different dir. - (setq default-directory dir) - ;; Set default-directory to the file's directory. - (and file-word - gud-chdir-before-run - ;; Don't set default-directory if no directory was specified. - ;; In that case, either the file is found in the current directory, - ;; in which case this setq is a no-op, - ;; or it is found by searching PATH, - ;; in which case we don't know what directory it was found in. - (file-name-directory file) - (setq default-directory (file-name-directory file))) - (or (bolp) (newline)) - (insert "Current directory is " default-directory "\n") - ;; Put the substituted and expanded file name back in its place. - (let ((w args)) - (while (and w (not (eq (car w) t))) - (setq w (cdr w))) - (if w - (setcar w file))) - (apply 'make-comint (concat "gud" filepart) program nil - (if massage-args (funcall massage-args file args) args)) - ;; Since comint clobbered the mode, we don't set it until now. - (gud-mode) - (set (make-local-variable 'gud-target-name) - (and file-word (file-name-nondirectory file)))) - (set (make-local-variable 'gud-marker-filter) marker-filter) - (if find-file (set (make-local-variable 'gud-find-file) find-file)) - (setq gud-running nil) - (setq gud-last-last-frame nil) - - (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) - (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) - (gud-set-buffer)) - -(defun gud-set-buffer () - (when (eq major-mode 'gud-mode) - (setq gud-comint-buffer (current-buffer)))) - -(defvar gud-filter-defer-flag nil - "Non-nil means don't process anything from the debugger right now. -It is saved for when this flag is not set.") - -(defvar gud-filter-pending-text nil - "Non-nil means this is text that has been saved for later in `gud-filter'.") - -;; These functions are responsible for inserting output from your debugger -;; into the buffer. The hard work is done by the method that is -;; the value of gud-marker-filter. - -(defun gud-filter (proc string) - ;; Here's where the actual buffer insertion is done - (let (output process-window) - (if (buffer-name (process-buffer proc)) - (if gud-filter-defer-flag - ;; If we can't process any text now, - ;; save it for later. - (setq gud-filter-pending-text - (concat (or gud-filter-pending-text "") string)) - - ;; If we have to ask a question during the processing, - ;; defer any additional text that comes from the debugger - ;; during that time. - (let ((gud-filter-defer-flag t)) - ;; Process now any text we previously saved up. - (if gud-filter-pending-text - (setq string (concat gud-filter-pending-text string) - gud-filter-pending-text nil)) - - (with-current-buffer (process-buffer proc) - ;; If we have been so requested, delete the debugger prompt. - (save-restriction - (widen) - (if (marker-buffer gud-delete-prompt-marker) - (progn - (delete-region (process-mark proc) - gud-delete-prompt-marker) - (set-marker gud-delete-prompt-marker nil))) - ;; Save the process output, checking for source file markers. - (setq output (gud-marker-filter string)) - ;; Check for a filename-and-line number. - ;; Don't display the specified file - ;; unless (1) point is at or after the position where output appears - ;; and (2) this buffer is on the screen. - (setq process-window - (and gud-last-frame - (>= (point) (process-mark proc)) - (get-buffer-window (current-buffer))))) - - ;; Let the comint filter do the actual insertion. - ;; That lets us inherit various comint features. - (comint-output-filter proc output)) - - ;; Put the arrow on the source line. - ;; This must be outside of the save-excursion - ;; in case the source file is our current buffer. - (if process-window - (save-selected-window - (select-window process-window) - (gud-display-frame)) - ;; We have to be in the proper buffer, (process-buffer proc), - ;; but not in a save-excursion, because that would restore point. - (let ((old-buf (current-buffer))) - (set-buffer (process-buffer proc)) - (unwind-protect - (gud-display-frame) - (set-buffer old-buf))))) - - ;; If we deferred text that arrived during this processing, - ;; handle it now. - (if gud-filter-pending-text - (gud-filter proc "")))))) - -(defvar gud-minor-mode-type nil) - -(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) - (set-process-buffer proc nil) - (if (eq gud-minor-mode-type 'gdba) - (gdb-reset) - (gud-reset))) - ((memq (process-status proc) '(signal exit)) - ;; Stop displaying an arrow in a source file. - (setq overlay-arrow-position nil) - (with-current-buffer gud-comint-buffer - (if (eq gud-minor-mode 'gdba) - (gdb-reset) - (gud-reset))) - (let* ((obuf (current-buffer))) - ;; save-excursion isn't the right thing if - ;; process-buffer is current-buffer - (unwind-protect - (progn - ;; Write something in *compilation* and hack its mode line, - (set-buffer (process-buffer proc)) - ;; Fix the mode line. - (setq mode-line-process - (concat ":" - (symbol-name (process-status proc)))) - (force-mode-line-update) - (if (eobp) - (insert ?\n mode-name " " msg) - (save-excursion - (goto-char (point-max)) - (insert ?\n mode-name " " msg))) - ;; If buffer and mode line will show that the process - ;; is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc)) - ;; Restore old buffer, but don't restore old point - ;; if obuf is the gud buffer. - (set-buffer obuf)))))) - -(defun gud-kill-buffer-hook () - (if gud-minor-mode - (setq gud-minor-mode-type gud-minor-mode))) - -(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook) - -(defun gud-reset () - (dolist (buffer (buffer-list)) - (if (not (eq buffer gud-comint-buffer)) - (save-excursion - (set-buffer buffer) - (when gud-minor-mode - (setq gud-minor-mode nil) - (kill-local-variable 'tool-bar-map)))))) - -(defun gud-display-frame () - "Find and obey the last filename-and-line marker from the debugger. -Obeying it means displaying in another window the specified file and line." - (interactive) - (when gud-last-frame - (gud-set-buffer) - (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) - (setq gud-last-last-frame gud-last-frame - gud-last-frame nil))) - -;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen -;; and that its line LINE is visible. -;; Put the overlay-arrow on the line LINE in that buffer. -;; Most of the trickiness in here comes from wanting to preserve the current -;; region-restriction if that's possible. We use an explicit display-buffer -;; to get around the fact that this is called inside a save-excursion. - -(defun gud-display-line (true-file line) - (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. - (buffer - (with-current-buffer gud-comint-buffer - (gud-find-file true-file))) - (window (and buffer (or (get-buffer-window buffer) - (if (eq gud-minor-mode 'gdba) - (gdb-display-source-buffer buffer) - (display-buffer buffer))))) - (pos)) - (if buffer - (progn - (with-current-buffer buffer - (if (not (or (verify-visited-file-modtime buffer) gud-keep-buffer)) - (progn - (if - (yes-or-no-p - (format "File %s changed on disk. Reread from disk? " - (buffer-name))) - (revert-buffer t t) - (setq gud-keep-buffer t)))) - (save-restriction - (widen) - (goto-line line) - (setq pos (point)) - (setq overlay-arrow-string "=>") - (or overlay-arrow-position - (setq overlay-arrow-position (make-marker))) - (set-marker overlay-arrow-position (point) (current-buffer))) - (cond ((or (< pos (point-min)) (> pos (point-max))) - (widen) - (goto-char pos)))) - (set-window-point window overlay-arrow-position))))) - -;; The gud-call function must do the right thing whether its invoking -;; keystroke is from the GUD buffer itself (via major-mode binding) -;; or a C buffer. In the former case, we want to supply data from -;; gud-last-frame. Here's how we do it: - -(defun gud-format-command (str arg) - (let ((insource (not (eq (current-buffer) gud-comint-buffer))) - (frame (or gud-last-frame gud-last-last-frame)) - result) - (while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str)) - (let ((key (string-to-char (match-string 2 str))) - subst) - (cond - ((eq key ?f) - (setq subst (file-name-nondirectory (if insource - (buffer-file-name) - (car frame))))) - ((eq key ?F) - (setq subst (file-name-sans-extension - (file-name-nondirectory (if insource - (buffer-file-name) - (car frame)))))) - ((eq key ?d) - (setq subst (file-name-directory (if insource - (buffer-file-name) - (car frame))))) - ((eq key ?l) - (setq subst (int-to-string - (if insource - (save-restriction - (widen) - (+ (count-lines (point-min) (point)) - (if (bolp) 1 0))) - (cdr frame))))) - ((eq key ?e) - (setq subst (gud-find-c-expr))) - ((eq key ?a) - (setq subst (gud-read-address))) - ((eq key ?c) - (setq subst - (gud-find-class - (if insource - (buffer-file-name) - (car frame)) - (if insource - (save-restriction - (widen) - (+ (count-lines (point-min) (point)) - (if (bolp) 1 0))) - (cdr frame))))) - ((eq key ?p) - (setq subst (if arg (int-to-string arg))))) - (setq result (concat result (match-string 1 str) subst))) - (setq str (substring str (match-end 2)))) - ;; There might be text left in STR when the loop ends. - (concat result str))) - -(defun gud-read-address () - "Return a string containing the core-address found in the buffer at point." - (save-match-data - (save-excursion - (let ((pt (point)) found begin) - (setq found (if (search-backward "0x" (- pt 7) t) (point))) - (cond - (found (forward-char 2) - (buffer-substring found - (progn (re-search-forward "[^0-9a-f]") - (forward-char -1) - (point)))) - (t (setq begin (progn (re-search-backward "[^0-9]") - (forward-char 1) - (point))) - (forward-char 1) - (re-search-forward "[^0-9]") - (forward-char -1) - (buffer-substring begin (point)))))))) - -(defun gud-call (fmt &optional arg) - (let ((msg (gud-format-command fmt arg))) - (message "Command: %s" msg) - (sit-for 0) - (gud-basic-call msg))) - -(defun gud-basic-call (command) - "Invoke the debugger COMMAND displaying source in other window." - (interactive) - (gud-set-buffer) - (let ((proc (get-buffer-process gud-comint-buffer))) - (or proc (error "Current buffer has no process")) - ;; Arrange for the current prompt to get deleted. - (save-excursion - (set-buffer gud-comint-buffer) - (save-restriction - (widen) - (goto-char (process-mark proc)) - (forward-line 0) - (if (looking-at comint-prompt-regexp) - (set-marker gud-delete-prompt-marker (point))) - (if (eq gud-minor-mode 'gdba) - (apply comint-input-sender (list proc command)) - (process-send-string proc (concat command "\n"))))))) - -(defun gud-refresh (&optional arg) - "Fix up a possibly garbled display, and redraw the arrow." - (interactive "P") - (or gud-last-frame (setq gud-last-frame gud-last-last-frame)) - (gud-display-frame) - (recenter arg)) - -;; Code for parsing expressions out of C code. The single entry point is -;; find-c-expr, which tries to return an lvalue expression from around point. -;; -;; The rest of this file is a hacked version of gdbsrc.el by -;; Debby Ayers <ayers@asc.slb.com>, -;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. - -(defun gud-find-c-expr () - "Returns the C expr that surrounds point." - (interactive) - (save-excursion - (let (p expr test-expr) - (setq p (point)) - (setq expr (gud-innermost-expr)) - (setq test-expr (gud-prev-expr)) - (while (and test-expr (gud-expr-compound test-expr expr)) - (let ((prev-expr expr)) - (setq expr (cons (car test-expr) (cdr expr))) - (goto-char (car expr)) - (setq test-expr (gud-prev-expr)) - ;; If we just pasted on the condition of an if or while, - ;; throw it away again. - (if (member (buffer-substring (car test-expr) (cdr test-expr)) - '("if" "while" "for")) - (setq test-expr nil - expr prev-expr)))) - (goto-char p) - (setq test-expr (gud-next-expr)) - (while (gud-expr-compound expr test-expr) - (setq expr (cons (car expr) (cdr test-expr))) - (setq test-expr (gud-next-expr))) - (buffer-substring (car expr) (cdr expr))))) - -(defun gud-innermost-expr () - "Returns the smallest expr that point is in; move point to beginning of it. -The expr is represented as a cons cell, where the car specifies the point in -the current buffer that marks the beginning of the expr and the cdr specifies -the character after the end of the expr." - (let ((p (point)) begin end) - (gud-backward-sexp) - (setq begin (point)) - (gud-forward-sexp) - (setq end (point)) - (if (>= p end) - (progn - (setq begin p) - (goto-char p) - (gud-forward-sexp) - (setq end (point))) - ) - (goto-char begin) - (cons begin end))) - -(defun gud-backward-sexp () - "Version of `backward-sexp' that catches errors." - (condition-case nil - (backward-sexp) - (error t))) - -(defun gud-forward-sexp () - "Version of `forward-sexp' that catches errors." - (condition-case nil - (forward-sexp) - (error t))) - -(defun gud-prev-expr () - "Returns the previous expr, point is set to beginning of that expr. -The expr is represented as a cons cell, where the car specifies the point in -the current buffer that marks the beginning of the expr and the cdr specifies -the character after the end of the expr" - (let ((begin) (end)) - (gud-backward-sexp) - (setq begin (point)) - (gud-forward-sexp) - (setq end (point)) - (goto-char begin) - (cons begin end))) - -(defun gud-next-expr () - "Returns the following expr, point is set to beginning of that expr. -The expr is represented as a cons cell, where the car specifies the point in -the current buffer that marks the beginning of the expr and the cdr specifies -the character after the end of the expr." - (let ((begin) (end)) - (gud-forward-sexp) - (gud-forward-sexp) - (setq end (point)) - (gud-backward-sexp) - (setq begin (point)) - (cons begin end))) - -(defun gud-expr-compound-sep (span-start span-end) - "Scan from SPAN-START to SPAN-END for punctuation characters. -If `->' is found, return `?.'. If `.' is found, return `?.'. -If any other punctuation is found, return `??'. -If no punctuation is found, return `? '." - (let ((result ?\ ) - (syntax)) - (while (< span-start span-end) - (setq syntax (char-syntax (char-after span-start))) - (cond - ((= syntax ?\ ) t) - ((= syntax ?.) (setq syntax (char-after span-start)) - (cond - ((= syntax ?.) (setq result ?.)) - ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) - (setq result ?.) - (setq span-start (+ span-start 1))) - (t (setq span-start span-end) - (setq result ??))))) - (setq span-start (+ span-start 1))) - result)) - -(defun gud-expr-compound (first second) - "Non-nil if concatenating FIRST and SECOND makes a single C expression. -The two exprs are represented as a cons cells, where the car -specifies the point in the current buffer that marks the beginning of the -expr and the cdr specifies the character after the end of the expr. -Link exprs of the form: - Expr -> Expr - Expr . Expr - Expr (Expr) - Expr [Expr] - (Expr) Expr - [Expr] Expr" - (let ((span-start (cdr first)) - (span-end (car second)) - (syntax)) - (setq syntax (gud-expr-compound-sep span-start span-end)) - (cond - ((= (car first) (car second)) nil) - ((= (cdr first) (cdr second)) nil) - ((= syntax ?.) t) - ((= syntax ?\ ) - (setq span-start (char-after (- span-start 1))) - (setq span-end (char-after span-end)) - (cond - ((= span-start ?)) t) - ((= span-start ?]) t) - ((= span-end ?() t) - ((= span-end ?[) t) - (t nil))) - (t nil)))) - -(defun gud-find-class (f line) - "Find fully qualified class in file F at line LINE. -This function uses the `gud-jdb-classpath' (and optional -`gud-jdb-sourcepath') list(s) to derive a file -pathname relative to its classpath directory. The values in -`gud-jdb-classpath' are assumed to have been converted to absolute -pathname standards using file-truename. -If F is visited by a buffer and its mode is CC-mode(Java), -syntactic information of LINE is used to find the enclosing (nested) -class string which is appended to the top level -class of the file (using s to separate nested class ids)." - ;; Convert f to a standard representation and remove suffix - (if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath)) - (save-match-data - (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) - (fbuffer (get-file-buffer f)) - class-found) - (setq f (file-name-sans-extension (file-truename f))) - ;; Search through classpath list for an entry that is - ;; contained in f - (while (and cplist (not class-found)) - (if (string-match (car cplist) f) - (setq class-found - (mapconcat 'identity - (split-string - (substring f (+ (match-end 0) 1)) - "/") "."))) - (setq cplist (cdr cplist))) - ;; if f is visited by a java(cc-mode) buffer, walk up the - ;; syntactic information chain and collect any 'inclass - ;; symbols until 'topmost-intro is reached to find out if - ;; point is within a nested class - (if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode")) - (save-excursion - (set-buffer fbuffer) - (let ((nclass) (syntax)) - ;; While the c-syntactic information does not start - ;; with the 'topmost-intro symbol, there may be - ;; nested classes... - (while (not (eq 'topmost-intro - (car (car (c-guess-basic-syntax))))) - ;; Check if the current position c-syntactic - ;; analysis has 'inclass - (setq syntax (c-guess-basic-syntax)) - (while - (and (not (eq 'inclass (car (car syntax)))) - (cdr syntax)) - (setq syntax (cdr syntax))) - (if (eq 'inclass (car (car syntax))) - (progn - (goto-char (cdr (car syntax))) - ;; Now we're at the beginning of a class - ;; definition. Find class name - (looking-at - "[A-Za-z0-9 \t\n]*?class[ \t\n]+\\([^ \t\n]+\\)") - (setq nclass - (append (list (match-string-no-properties 1)) - nclass))) - (setq syntax (c-guess-basic-syntax)) - (while (and (not (cdr (car syntax))) (cdr syntax)) - (setq syntax (cdr syntax))) - (goto-char (cdr (car syntax))) - )) - (string-match (concat (car nclass) "$") class-found) - (setq class-found - (replace-match (mapconcat 'identity nclass "$") - t t class-found))))) - (if (not class-found) - (message "gud-find-class: class for file %s not found!" f)) - class-found)) - ;; Not using classpath - try class/source association list - (let ((class-found (rassoc f gud-jdb-class-source-alist))) - (if class-found - (car class-found) - (message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f) - nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; GDB script mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gdb-script-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?' "\"" st) - (modify-syntax-entry ?# "<" st) - (modify-syntax-entry ?\n ">" st) - st)) - -(defvar gdb-script-font-lock-keywords - '(("^define\\s-+\\(\\w+\\)" (1 font-lock-function-name-face)) - ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face)))) - -(defvar gdb-script-font-lock-syntactic-keywords - '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ;; It would be best to change the \n in front, but it's more difficult. - ("^en\\(d\\)\\>" (1 "> b")))) - -(defun gdb-script-font-lock-syntactic-face (state) - (cond - ((nth 3 state) font-lock-string-face) - ((nth 7 state) font-lock-doc-face) - (t font-lock-comment-face))) - -(defvar gdb-script-basic-indent 2) - -(defun gdb-script-skip-to-head () - "We're just in front of an `end' and we need to go to its head." - (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\)\\>" nil 'move) - (match-end 2)) - (gdb-script-skip-to-head))) - -(defun gdb-script-calculate-indentation () - (cond - ((looking-at "end\\>") - (gdb-script-skip-to-head) - (current-indentation)) - ((looking-at "else\\>") - (while (and (re-search-backward "^\\s-*\\(if\\|\\(end\\)\\)\\>" nil 'move) - (match-end 2)) - (gdb-script-skip-to-head)) - (current-indentation)) - (t - (forward-comment (- (point-max))) - (forward-line 0) - (skip-chars-forward " \t") - (+ (current-indentation) - (if (looking-at "\\(if\\|while\\|define\\|else\\)\\>") - gdb-script-basic-indent 0))))) - -(defun gdb-script-indent-line () - "Indent current line of GDB script." - (interactive) - (if (and (eq (get-text-property (point) 'face) font-lock-doc-face) - (save-excursion - (forward-line 0) - (skip-chars-forward " \t") - (not (looking-at "end\\>")))) - 'noindent - (let* ((savep (point)) - (indent (condition-case nil - (save-excursion - (forward-line 0) - (skip-chars-forward " \t") - (if (>= (point) savep) (setq savep nil)) - (max (gdb-script-calculate-indentation) 0)) - (error 0)))) - (if savep - (save-excursion (indent-line-to indent)) - (indent-line-to indent))))) - -;;;###autoload -(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode)) - -;;;###autoload -(define-derived-mode gdb-script-mode nil "GDB-Script" - "Major mode for editing GDB scripts" - (set (make-local-variable 'comment-start) "#") - (set (make-local-variable 'comment-start-skip) "#+\\s-*") - (set (make-local-variable 'outline-regexp) "[ \t]") - (set (make-local-variable 'imenu-generic-expression) - '((nil "^define[ \t]+\\(\\w+\\)" 1))) - (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line) - (set (make-local-variable 'font-lock-defaults) - '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-keywords - . gdb-script-font-lock-syntactic-keywords) - (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face)))) - -(provide 'gud) - -;;; gud.el ends here