(require 'comint)
(require 'etags)
(defgroup gud nil
"Grand Unified Debugger mode for gdb and other debuggers under Emacs.
Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), and jdb."
: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)
(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)
(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))))
(defun gud-find-file (file)
(while (string-match "//+" file)
(setq file (replace-match "/" t t file)))
(let ((minor-mode gud-minor-mode)
(buf (funcall gud-find-file file)))
(when buf
(with-current-buffer buf
(set (make-local-variable 'gud-minor-mode) minor-mode))
buf)))
(easy-mmode-defmap gud-menu-map
'(([refresh] "Refresh" . gud-refresh)
([remove] "Remove Breakpoint" . gud-remove)
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
:enable (memq gud-minor-mode '(gdb sdb xdb)))
([break] "Set Breakpoint" . gud-break)
([up] menu-item "Up Stack" gud-up
:enable (memq gud-minor-mode '(gdb dbx xdb)))
([down] menu-item "Down Stack" gud-down
:enable (memq gud-minor-mode '(gdb dbx xdb)))
([print] "Print Expression" . gud-print)
([finish] menu-item "Finish Function" gud-finish
:enable (memq gud-minor-mode '(gdb xdb)))
([stepi] "Step Instruction" . gud-stepi)
([step] "Step Line" . gud-step)
([next] "Next Line" . gud-next)
([cont] "Continue" . gud-cont))
"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
(make-sparse-keymap)
"`gud-mode' keymap.")
(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)."
(list 'progn
(list 'defun func '(arg)
(or doc "")
'(interactive "p")
(list 'gud-call cmd 'arg))
(if key
(list 'define-key
'(current-local-map)
(concat "\C-c" key)
(list 'quote func)))
(if key
(list 'global-set-key
(list 'concat 'gud-key-prefix key)
(list 'quote func)))))
(defvar gud-last-frame nil)
(defvar gud-last-last-frame nil)
(eval-when-compile (require 'speedbar))
(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
'(["Jump to stack frame" speedbar-edit-line t])
"Additional menu items to add the the speedbar frame.")
(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* ((ff (save-excursion (set-buffer buffer) gud-find-file))
(frames
(cond ((eq ff 'gud-gdb-find-file)
(gud-gdb-get-stackframe buffer)
)
(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 (car (car frames))
'speedbar-directory-face
nil nil nil t))
(speedbar-insert-button (car (car frames))
'speedbar-file-face
'speedbar-highlight-face
(cond ((eq ff 'gud-gdb-find-file)
'gud-gdb-goto-stackframe)
(t (error "Should never be here")))
(car frames) t))
(setq frames (cdr frames)))
)
(setq gud-last-speedbar-stackframe gud-last-last-frame)))
(defvar gud-gdb-history nil)
(defun gud-gdb-massage-args (file args)
(cons "-fullname" args))
(defvar gud-gdb-marker-regexp
(concat "\032\032\\(.:?[^" ":" "\n]*\\)" ":"
"\\([0-9]*\\)" ":" ".*\n"))
(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 ""))
(while (string-match gud-gdb-marker-regexp gud-marker-acc)
(setq
gud-last-frame
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
(string-to-int (substring gud-marker-acc
(match-beginning 2)
(match-end 2))))
output (concat output
(substring gud-marker-acc 0 (match-beginning 0)))
gud-marker-acc (substring gud-marker-acc (match-end 0))))
(if (string-match "\032.*\\'" gud-marker-acc)
(progn
(setq output (concat output (substring gud-marker-acc
0 (match-beginning 0))))
(setq gud-marker-acc
(substring gud-marker-acc (match-beginning 0))))
(setq output (concat output gud-marker-acc)
gud-marker-acc ""))
output))
(defun gud-gdb-find-file (f)
(find-file-noselect f 'nowarn))
(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)) " " init))
gud-minibuffer-local-map nil
hist-sym)))
(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 'gud-gdb-massage-args
'gud-gdb-marker-filter 'gud-gdb-find-file)
(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-cont "cont" "\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 "print %e" "\C-p" "Evaluate C expression at point.")
(local-set-key "\C-i" 'gud-gdb-complete-command)
(local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'gdb-mode-hook)
)
(defvar gud-gdb-complete-in-progress)
(defvar gud-gdb-complete-string)
(defvar gud-gdb-complete-break)
(defvar gud-gdb-complete-list)
(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)
(string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
(setq gud-gdb-complete-break (match-beginning 2)
command-word (substring command gud-gdb-complete-break))
(let ((gud-marker-filter 'gud-gdb-complete-filter))
(gud-basic-call (concat "complete " command))
(setq gud-gdb-complete-in-progress t
gud-gdb-complete-string nil
gud-gdb-complete-list nil)
(while gud-gdb-complete-in-progress
(accept-process-output (get-buffer-process gud-comint-buffer))))
(and gud-gdb-complete-list
(string-match "^Undefined command: \"complete\""
(car gud-gdb-complete-list))
(error "This version of GDB doesn't support the `complete' command"))
(setq gud-gdb-complete-list
(sort gud-gdb-complete-list (function string-lessp)))
(let ((first gud-gdb-complete-list)
(second (cdr gud-gdb-complete-list)))
(while second
(if (string-equal (car first) (car second))
(setcdr first (setq second (cdr second)))
(setq first second
second (cdr second)))))
(and (= (length gud-gdb-complete-list) 1)
(let ((str (car gud-gdb-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 gud-gdb-complete-list (list (concat str "'"))))))
(comint-dynamic-simple-complete command-word gud-gdb-complete-list)))
(defun gud-gdb-complete-filter (string)
(setq string (concat gud-gdb-complete-string string))
(while (string-match "\n" string)
(setq gud-gdb-complete-list
(cons (substring string gud-gdb-complete-break (match-beginning 0))
gud-gdb-complete-list))
(setq string (substring string (match-end 0))))
(if (string-match comint-prompt-regexp string)
(progn
(setq gud-gdb-complete-in-progress nil)
string)
(progn
(setq gud-gdb-complete-string string)
"")))
(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 "frame " (nth 1 token)))
(sit-for 1)))
(defvar gud-gdb-fetched-stack-frame nil
"Stack frames we are fetching from GDB.")
(defvar gud-gdb-fetched-stack-frame-list nil
"List of stack frames we are fetching from GDB.")
(defun gud-gdb-get-stackframe (buffer)
"Extract the current stack frame out of the GUD GDB BUFFER."
(let ((newlst nil)
(gud-gdb-fetched-stack-frame-list nil))
(gud-gdb-run-command-fetch-lines "backtrace" buffer)
(if (and (car gud-gdb-fetched-stack-frame-list)
(string-match "No stack" (car gud-gdb-fetched-stack-frame-list)))
nil
(while gud-gdb-fetched-stack-frame-list
(let ((e (car gud-gdb-fetched-stack-frame-list))
(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))))
(setq gud-gdb-fetched-stack-frame-list
(cdr gud-gdb-fetched-stack-frame-list)))
(nreverse newlst))))
(defun gud-gdb-run-command-fetch-lines (command buffer)
"Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full.
BUFFER is the GUD buffer in which to run the command."
(save-excursion
(set-buffer buffer)
(if (save-excursion
(goto-char (point-max))
(forward-line 0)
(not (looking-at comint-prompt-regexp)))
nil
(let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter))
(gud-basic-call command)
(setq gud-gdb-complete-in-progress t gud-gdb-complete-string nil
gud-gdb-complete-list nil)
(while gud-gdb-complete-in-progress
(accept-process-output (get-buffer-process gud-comint-buffer)))
(setq gud-gdb-fetched-stack-frame nil
gud-gdb-fetched-stack-frame-list
(nreverse gud-gdb-fetched-stack-frame-list))))))
(defun gud-gdb-speedbar-stack-filter (string)
"Filter used to read in the current GDB stack."
(setq string (concat gud-gdb-fetched-stack-frame string))
(while (string-match "\n" string)
(setq gud-gdb-fetched-stack-frame-list
(cons (substring string 0 (match-beginning 0))
gud-gdb-fetched-stack-frame-list))
(setq string (substring string (match-end 0))))
(if (string-match comint-prompt-regexp string)
(progn
(setq gud-gdb-complete-in-progress nil)
string)
(progn
(setq gud-gdb-complete-string string)
"")))
(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-massage-args (file args) args)
(defun gud-sdb-marker-filter (string)
(setq gud-marker-acc
(if gud-marker-acc (concat gud-marker-acc string) string))
(let (start)
(while
(cond
((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n"
gud-marker-acc start)
(setq gud-last-frame
(cons
(substring gud-marker-acc (match-beginning 3) (match-end 3))
(string-to-int
(substring gud-marker-acc (match-beginning 4) (match-end 4))))))
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):"
gud-marker-acc start)
(setq gud-sdb-lastfile
(substring gud-marker-acc (match-beginning 2) (match-end 2)))
(setq gud-last-frame
(cons
gud-sdb-lastfile
(string-to-int
(substring gud-marker-acc (match-beginning 3) (match-end 3))))))
((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
gud-marker-acc start)
(setq gud-sdb-lastfile
(substring gud-marker-acc (match-beginning 2) (match-end 2))))
((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):"
gud-marker-acc start))
(setq gud-last-frame
(cons
gud-sdb-lastfile
(string-to-int
(substring gud-marker-acc (match-beginning 1) (match-end 1))))))
(t
(setq gud-sdb-lastfile nil)))
(setq start (match-end 0)))
(while (string-match "\n" gud-marker-acc start)
(setq start (match-end 0)))
(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)))
(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 'gud-sdb-massage-args
'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)
(local-set-key [menu-bar debug tbreak]
'("Temporary Breakpoint" . gud-tbreak))
(run-hooks 'sdb-mode-hook)
)
(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-file-name (f)
"Transform a relative file name to an absolute file name, for dbx."
(let ((result nil))
(if (file-exists-p f)
(setq result (expand-file-name f))
(let ((directories gud-dbx-directories))
(while directories
(let ((path (concat (car directories) "/" f)))
(if (file-exists-p path)
(setq result (expand-file-name path)
directories nil)))
(setq directories (cdr directories)))))
result))
(defun gud-dbx-marker-filter (string)
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
(let (start)
(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
(substring gud-marker-acc (match-beginning 2) (match-end 2))
(string-to-int
(substring gud-marker-acc (match-beginning 1) (match-end 1))))
start (match-end 0)))
(while (string-match "\n" gud-marker-acc start)
(setq start (match-end 0)))
(setq gud-marker-acc
(if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start)
(substring gud-marker-acc (match-beginning 0))
nil)))
string)
(defvar gud-mips-p
(or (string-match "^mips-[^-]*-ultrix" system-configuration)
(string-match "^mips-[^-]*-riscos" system-configuration)
(string-match "^mips-[^-]*-osf1" system-configuration)
(string-match "^alpha[^-]*-[^-]*-osf" system-configuration))
"Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').")
(defun gud-mipsdbx-massage-args (file args)
(cons "-emacs" args))
(defun gud-mipsdbx-marker-filter (string)
(setq gud-marker-acc (concat gud-marker-acc string))
(let ((output ""))
(while (string-match
"[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
gud-marker-acc)
(setq
gud-last-frame
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
(string-to-int (substring gud-marker-acc
(match-beginning 2)
(match-end 2))))
output (concat output
(substring gud-marker-acc 0 (match-beginning 0)))
gud-marker-acc (substring gud-marker-acc (match-end 0))))
(if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc)
(progn
(setq output (concat output (substring gud-marker-acc
0 (match-beginning 0))))
(setq gud-marker-acc
(substring gud-marker-acc (match-beginning 0))))
(setq output (concat output gud-marker-acc)
gud-marker-acc ""))
output))
(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'.")
(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
((string-match
"^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n"
result)
(process-send-string (get-buffer-process gud-comint-buffer)
"printf \"\032\032%1d:\",(int)$curline;file\n"))
((string-match
"^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n"
result)
(let ((file (substring result (match-beginning 1)
(match-end 1))))
(if (file-exists-p file)
(setq gud-last-frame
(cons
(substring
result (match-beginning 1) (match-end 1))
(string-to-int
(substring
result (match-beginning 2) (match-end 2)))))))
result)
((string-match "\032\032\\([0-9]*\\):\\(.*\\)\n" result)
(let ((file (gud-dbx-file-name
(substring result (match-beginning 2) (match-end 2)))))
(if (and file (file-exists-p file))
(setq gud-last-frame
(cons
file
(string-to-int
(substring
result (match-beginning 1) (match-end 1)))))))
(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.")
(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)
(while (string-match re gud-marker-acc start)
(setq gud-last-frame
(cons
(substring gud-marker-acc (match-beginning 4) (match-end 4))
(string-to-int (substring gud-marker-acc
(match-beginning 3) (match-end 3))))
start (match-end 0)))
(while (string-match "\n" gud-marker-acc start)
(setq start (match-end 0)))
(setq gud-marker-acc
(if (string-match "Stopped\\|Frame" gud-marker-acc start)
(substring gud-marker-acc (match-beginning 0))
nil)))
string)
(defun gud-dbx-find-file (f)
(save-excursion
(let ((realf (gud-dbx-file-name f)))
(if realf
(find-file-noselect realf)))))
(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 'gud-mipsdbx-massage-args
'gud-mipsdbx-marker-filter 'gud-dbx-find-file))
(gud-irix-p
(gud-common-init command-line 'gud-dbx-massage-args
'gud-irixdbx-marker-filter 'gud-dbx-find-file))
(gud-dgux-p
(gud-common-init command-line 'gud-dbx-massage-args
'gud-dguxdbx-marker-filter 'gud-dbx-find-file))
(t
(gud-common-init command-line 'gud-dbx-massage-args
'gud-dbx-marker-filter 'gud-dbx-find-file)))
(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.")
(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)
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
(run-hooks 'dbx-mode-hook)
)
(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))
(defun gud-xdb-file-name (f)
"Transform a relative pathname to a full pathname in xdb mode"
(let ((result nil))
(if (file-exists-p f)
(setq result (expand-file-name f))
(let ((directories gud-xdb-directories))
(while directories
(let ((path (concat (car directories) "/" f)))
(if (file-exists-p path)
(setq result (expand-file-name path)
directories nil)))
(setq directories (cdr directories)))))
result))
(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
(substring result (match-beginning 2) (match-end 2))))
(file (gud-xdb-file-name
(substring result (match-beginning 1) (match-end 1)))))
(if file
(setq gud-last-frame (cons file line))))))
(or result "")))
(defun gud-xdb-find-file (f)
(save-excursion
(let ((realf (gud-xdb-file-name f)))
(if realf
(find-file-noselect realf)))))
(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 'gud-xdb-find-file)
(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)
(local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
(run-hooks 'xdb-mode-hook))
(defvar gud-perldb-history nil)
(defun gud-perldb-massage-args (file args)
(let* ((new-args (list "-d"))
(seen-e nil)
(shift (lambda ()
(setq new-args (cons (car args) new-args))
(setq args (cdr args)))))
(while (and args
(string-match "^-" (car args))
(not (equal "-" (car args)))
(not (equal "--" (car args))))
(when (equal "-e" (car args))
(or (funcall shift)
(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"))
(funcall shift))
(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)))
(defun gud-perldb-marker-filter (string)
(setq gud-marker-acc (concat gud-marker-acc string))
(let ((output ""))
(while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n"
gud-marker-acc)
(setq
gud-last-frame
(cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
(string-to-int (substring gud-marker-acc
(match-beginning 3)
(match-end 3))))
output (concat output
(substring gud-marker-acc 0 (match-beginning 0)))
gud-marker-acc (substring gud-marker-acc (match-end 0))))
(if (string-match "\032.*\\'" gud-marker-acc)
(progn
(setq output (concat output (substring gud-marker-acc
0 (match-beginning 0))))
(setq gud-marker-acc
(substring gud-marker-acc (match-beginning 0))))
(setq output (concat output gud-marker-acc)
gud-marker-acc ""))
output))
(defun gud-perldb-find-file (f)
(find-file-noselect f))
(defcustom gud-perldb-command-name "perl"
"File name for executing Perl."
:type 'string
:group 'gud)
(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 'gud-perldb-find-file)
(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-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))
(defvar gud-pdb-history nil)
(defun gud-pdb-massage-args (file args)
args)
(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 "^> ")
(defun gud-pdb-marker-filter (string)
(setq gud-marker-acc (concat gud-marker-acc string))
(let ((output ""))
(while (string-match gud-pdb-marker-regexp gud-marker-acc)
(setq
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 (concat output (substring gud-marker-acc 0 (match-end 0)))
gud-marker-acc (substring gud-marker-acc (match-end 0))))
(if (string-match gud-pdb-marker-regexp-start gud-marker-acc)
(progn
(setq output (concat output (substring gud-marker-acc
0 (match-beginning 0))))
(setq gud-marker-acc
(substring gud-marker-acc (match-beginning 0))))
(setq output (concat output gud-marker-acc)
gud-marker-acc ""))
output))
(defun gud-pdb-find-file (f)
(find-file-noselect f))
(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)
(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 'gud-pdb-massage-args
'gud-pdb-marker-filter 'gud-pdb-find-file)
(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 %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.")
(gud-def gud-statement "! %e" "\C-e" "Execute Python statement at point.")
(local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
(local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
(local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
(setq comint-prompt-regexp "^(Pdb) *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'pdb-mode-hook))
(defvar gud-jdb-history nil)
(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)
(defvar gud-jdb-class-source-alist nil)
(defvar gud-jdb-analysis-buffer nil)
(defun gud-jdb-build-source-files-list (path extn)
(apply 'nconc (mapcar (lambda (d)
(when (file-directory-p d)
(directory-files d t extn nil)))
path)))
(defun gud-jdb-skip-whitespace ()
(skip-chars-forward " \n\r\t\014"))
(defun gud-jdb-skip-single-line-comment ()
(end-of-line))
(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)))))
(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))))))
(defun gud-jdb-skip-id-ish-thing ()
(skip-chars-forward "^ /\n\r\t\014,;{"))
(defun gud-jdb-skip-string-literal ()
(forward-char)
(while (not (cond
((eq (following-char) ?\\)
(forward-char))
((eq (following-char) ?\042))))
(forward-char))
(forward-char))
(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))
(defun gud-jdb-skip-block ()
(while
(not (eq (following-char) ?{))
(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))))
(forward-char)
(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))))))
(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
((eq (following-char) ?\073)
(forward-char))
((looking-at "//")
(gud-jdb-skip-single-line-comment))
((looking-at "/\\*")
(gud-jdb-skip-traditional-or-documentation-comment))
((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))))
((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)))
((looking-at "public")
(forward-char 6))
((looking-at "abstract")
(forward-char 8))
((looking-at "final")
(forward-char 5))
((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))
((looking-at "interface")
(forward-char 9)
(gud-jdb-skip-block))
(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)))
(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)))
(defun gud-jdb-massage-args (file args)
(if args
(let (massaged-args user-error)
(while
(and args
(not (string-match "-classpath\\(.+\\)" (car args)))
(not (setq user-error
(string-match "-classpath$" (car args)))))
(setq massaged-args (append massaged-args (list (car args))))
(setq args (cdr args)))
(if user-error
(progn
(kill-buffer (current-buffer))
(error "Error: Omit whitespace between '-classpath' and its value")))
(if args
(setq massaged-args
(append
massaged-args
(list "-classpath")
(list
(substring
(car args)
(match-beginning 1) (match-end 1)))
(cdr args)))
massaged-args))))
(defun gud-jdb-find-source-file (p)
(cdr (assoc p gud-jdb-class-source-alist)))
(defun gud-jdb-marker-filter (string)
(setq gud-marker-acc
(if gud-marker-acc
(concat gud-marker-acc string)
string))
(let (start file-found)
(while
(string-match
"\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>]+ (\\([a-zA-Z0-9$_]+\\):\\([0-9]+\\))"
gud-marker-acc start)
(if (setq
file-found
(gud-jdb-find-source-file
(substring gud-marker-acc
(match-beginning 1)
(match-end 1))))
(setq gud-last-frame
(cons
file-found
(string-to-int
(substring gud-marker-acc
(match-beginning 3)
(match-end 3)))))
(message "Could not find source file."))
(setq start (match-end 0))))
string)
(defun gud-jdb-find-file (f)
(and (file-readable-p f)
(find-file-noselect f)))
(defvar gud-jdb-command-name "jdb" "Command that executes the Java debugger.")
(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 it's value."
(interactive
(list (gud-query-cmdline 'jdb)))
(gud-common-init command-line 'gud-jdb-massage-args
'gud-jdb-marker-filter 'gud-jdb-find-file)
(set (make-local-variable 'gud-minor-mode) 'jdb)
(gud-def gud-break "stop at %F:%l" "\C-b" "Set 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 "cont" "\C-r" "Continue with display.")
(setq comint-prompt-regexp "^> \\|^.+\\[[0-9]+\\] ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'jdb-mode-hook)
(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$")))))
(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, or M-x xdb. Each entry point finishes by executing a
hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook',
`perldb-mode-hook', or `xdb-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)
(make-local-variable 'comint-prompt-regexp)
(set (make-local-variable 'comint-input-ignoredups) t)
(make-local-variable 'paragraph-start)
(set (make-local-variable 'gud-delete-prompt-marker) (make-marker)))
(defcustom gud-chdir-before-run t
"Non-nil if GUD should `cd' to the debugged executable."
:group 'gud
:type 'boolean)
(defun gud-common-init (command-line massage-args marker-filter &optional find-file)
(let* ((words (split-string command-line))
(program (car words))
(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))
(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 "*"))
(and file-word
gud-chdir-before-run
(file-name-directory file)
(setq default-directory (file-name-directory file)))
(or (bolp) (newline))
(insert "Current directory is " default-directory "\n")
(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
(funcall massage-args file args)))
(gud-mode)
(make-local-variable 'gud-marker-filter)
(setq gud-marker-filter marker-filter)
(if find-file (set (make-local-variable 'gud-find-file) find-file))
(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'.")
(defun gud-filter (proc string)
(let (output process-window)
(if (buffer-name (process-buffer proc))
(if gud-filter-defer-flag
(setq gud-filter-pending-text
(concat (or gud-filter-pending-text "") string))
(let ((gud-filter-defer-flag t))
(if gud-filter-pending-text
(setq string (concat gud-filter-pending-text string)
gud-filter-pending-text nil))
(with-current-buffer (process-buffer proc)
(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)))
(setq output (gud-marker-filter string))
(setq process-window
(and gud-last-frame
(>= (point) (process-mark proc))
(get-buffer-window (current-buffer)))))
(comint-output-filter proc output))
(if process-window
(save-selected-window
(select-window process-window)
(gud-display-frame))
(let ((old-buf (current-buffer)))
(set-buffer (process-buffer proc))
(unwind-protect
(gud-display-frame)
(set-buffer old-buf)))))
(if gud-filter-pending-text
(gud-filter proc ""))))))
(defun gud-sentinel (proc msg)
(cond ((null (buffer-name (process-buffer proc)))
(setq overlay-arrow-position nil)
(set-process-buffer proc nil))
((memq (process-status proc) '(signal exit))
(setq overlay-arrow-position nil)
(let* ((obuf (current-buffer)))
(unwind-protect
(progn
(set-buffer (process-buffer proc))
(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)))
(delete-process proc))
(set-buffer obuf))))))
(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)
(if gud-last-frame
(progn
(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))))
(defun gud-display-line (true-file line)
(let* ((last-nonmenu-event t) (buffer
(save-excursion
(or (eq (current-buffer) gud-comint-buffer)
(set-buffer gud-comint-buffer))
(gud-find-file true-file)))
(window (and buffer (or (get-buffer-window buffer)
(display-buffer buffer))))
(pos))
(if buffer
(progn
(save-excursion
(set-buffer buffer)
(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)))))
(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 "\\([^%]*\\)%\\([adeflp]\\)" str))
(let ((key (string-to-char (substring str (match-beginning 2))))
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 (if insource
(save-excursion
(beginning-of-line)
(save-restriction
(widen)
(int-to-string (1+ (count-lines 1 (point))))))
(cdr frame))))
((eq key ?e)
(setq subst (gud-find-c-expr)))
((eq key ?a)
(setq subst (gud-read-address)))
((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))))
(concat result str)))
(defun gud-read-address ()
"Return a string containing the core-address found in the buffer at point."
(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 ((command (concat command "\n"))
(proc (get-buffer-process gud-comint-buffer)))
(or proc (error "Current buffer has no process"))
(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)))))
(process-send-string proc command)))
(defun gud-refresh (&optional arg)
"Fix up a possibly garbled display, and redraw the arrow."
(interactive "P")
(recenter arg)
(or gud-last-frame (setq gud-last-frame gud-last-last-frame))
(gud-display-frame))
(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 (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))))
(provide 'gud)