;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
-;; Copyright (C) 1992-1996, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
;;; Code:
-(eval-when-compile (require 'cl)) ; for case macro
-
(require 'comint)
(defvar gdb-active-process)
;; 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) and jdb."
+ "The \"Grand Unified Debugger\" interface.
+Supported debuggers include gdb, sdb, dbx, xdb, perldb,
+pdb (Python), and jdb."
:group 'processes
:group 'tools)
(defcustom gud-key-prefix "\C-x\C-a"
"Prefix of all GUD commands valid in C buffers."
- :type 'string
+ :type 'key-sequence
:group 'gud)
-(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
+(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack
(defvar gud-marker-filter nil)
(defvar gud-running nil
"Non-nil if debugged program is running.
-Used to grey out relevant toolbar icons.")
+Used to gray out relevant toolbar icons.")
(defvar gud-target-name "--unknown--"
"The apparent name of the program being debugged in a gud buffer.")
(defun gud-goto-info ()
"Go to relevant Emacs info node."
(interactive)
- (let ((same-window-regexps same-window-regexps)
- (display-buffer-reuse-frames t))
- (catch 'info-found
- (walk-windows
- '(lambda (window)
- (if (eq (window-buffer window) (get-buffer "*info*"))
- (progn
- (setq same-window-regexps nil)
- (throw 'info-found nil))))
- nil 0)
- (select-frame (make-frame)))
- (if (eq gud-minor-mode 'gdbmi)
- (info "(emacs)GDB Graphical Interface")
- (info "(emacs)Debuggers"))))
+ (if (eq gud-minor-mode 'gdbmi)
+ (info-other-window "(emacs)GDB Graphical Interface")
+ (info-other-window "(emacs)Debuggers")))
(defun gud-tool-bar-item-visible-no-fringe ()
(not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(if (eq status 'out-of-scope) (setq parent 'shadow))
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(speedbar-make-tag-line
"Evaluate C dereferenced pointer expression at point.")
;; For debugging Emacs only.
- (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.")
+ (gud-def gud-pv "pv %e" "\C-v" "Print the value of the lisp variable.")
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
+ (set (make-local-variable 'gud-gdb-completion-function) 'gud-gdb-completions)
+
(local-set-key "\C-i" 'completion-at-point)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq paragraph-start comint-prompt-regexp)
;; context-sensitive command completion. We preserve that feature
;; in the GUD buffer by using a GDB command designed just for Emacs.
+(defvar gud-gdb-completion-function nil
+ "Completion function for GDB commands.
+It receives two arguments: COMMAND, the prefix for which we seek
+completion; and CONTEXT, the text before COMMAND on the line.
+It should return a list of completion strings.")
+
;; The completion process filter indicates when it is finished.
(defvar gud-gdb-fetch-lines-in-progress)
(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 "'"))))))
- complete-list))
+ (gud-gdb-completions-1 complete-list)))
+
+;; This function is also used by `gud-gdbmi-completions'.
+(defun gud-gdb-completions-1 (complete-list)
+ ;; 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 "'"))))))
+ complete-list)
(defun gud-gdb-completion-at-point ()
"Return the data to complete the GDB command before point."
(point))))
(list start end
(completion-table-dynamic
- (apply-partially #'gud-gdb-completions
+ (apply-partially gud-gdb-completion-function
(buffer-substring (comint-line-beginning-position)
start))))))
;; 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)
+(defun gud-gdb-fetch-lines-filter (string)
"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))
+It is passed through `gud-gdb-marker-filter' before we look at it."
+ (setq string (gud-gdb-marker-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))
(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)
BUFFER is the current buffer which may be the GUD buffer in which to run.
SKIP is the number of chars to skip on each line, it defaults to 0."
(with-current-buffer gud-comint-buffer
- (if (and (eq gud-comint-buffer buffer)
- (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.
+ (unless (and (eq gud-comint-buffer buffer)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line 0)
+ (not (looking-at comint-prompt-regexp))))
(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))))
+ (gud-marker-filter #'gud-gdb-fetch-lines-filter))
;; Issue the command to GDB.
(gud-basic-call command)
;; Slurp the output.
(defvar gud-dbx-history nil)
(defcustom gud-dbx-directories nil
- "*A list of directories that dbx should search for source code.
+ "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.
;; 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
+;; recognize 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
(defvar gud-xdb-history nil)
(defcustom gud-xdb-directories nil
- "*A list of directories that xdb should search for source code.
+ "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.
;; 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_]*\\|\\?\\|<module>\\)()\\(->[^\n]*\\)?\n")
+ "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]")
+
(defvar gud-pdb-marker-regexp-file-group 1)
(defvar gud-pdb-marker-regexp-line-group 2)
(defvar gud-pdb-marker-regexp-fnname-group 3)
(gud-common-init command-line nil 'gud-pdb-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'pdb)
- (gud-def gud-break "break %f:%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-break "break %d%f:%l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-remove "clear %d%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.")
;; 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)
+;; Supply a fully qualified classname (these don't 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').
;; 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
+;; be really nice to analyze the files only as necessary (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
;; List of Java source file directories.
(defvar gud-jdb-directories (list ".")
- "*A list of directories that gud jdb should search for source code.
+ "A list of directories that gud jdb should search for source code.
The file names should be absolute, or relative to the current
directory.
;; in petticoat junction.
(defun gud-jdb-skip-block ()
- ;; Find the begining of the block.
+ ;; Find the beginning of the block.
(while
(not (eq (following-char) ?{))
(gud-jdb-skip-character-literal))
(t (forward-char))))
- ;; Now at the begining of the block.
+ ;; Now at the beginning of the block.
(forward-char)
;; Skip over the body of the block as well as the final brace.
((looking-at "final")
(forward-char 5))
- ;; Move point past a ClassDeclaraction, but save the class
+ ;; Move point past a ClassDeclaration, but save the class
;; Identifier.
((looking-at "class")
(forward-char 5)
;; 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.
+ ;; issuing the error is good enough.
(if user-error
(progn
(kill-buffer (current-buffer))
massaged-args)))
;; Search for an association with P, a fully qualified class name, in
-;; gud-jdb-class-source-alist. The asssociation gives the fully
+;; gud-jdb-class-source-alist. The association 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)))
string
(concat "[ \t\n\r,\"" path-separator "]+")))))
-;; See comentary for other debugger's marker filters - there you will find
+;; See commentary for other debugger's marker filters - there you will find
;; important notes about STRING.
(defun gud-jdb-marker-filter (string)
(set (make-local-variable 'gud-delete-prompt-marker) (make-marker))
(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t))
-;; Cause our buffers to be displayed, by default,
-;; in the selected window.
-;;;###autoload (add-hook 'same-window-regexps (purecopy "\\*gud-.*\\*\\(\\|<[0-9]+>\\)"))
-
(defcustom gud-chdir-before-run t
"Non-nil if GUD should `cd' to the debugged executable."
:group 'gud
file-subst)))
(filepart (and file-word (concat "-" (file-name-nondirectory file))))
(existing-buffer (get-buffer (concat "*gud" filepart "*"))))
- (pop-to-buffer (concat "*gud" filepart "*"))
+ (switch-to-buffer (concat "*gud" filepart "*"))
(when (and existing-buffer (get-buffer-process existing-buffer))
(error "This program is already being debugged"))
;; Set the dir, in case the buffer already existed with a different dir.
(declare-function global-hl-line-highlight "hl-line" ())
(declare-function hl-line-highlight "hl-line" ())
(declare-function gdb-display-source-buffer "gdb-mi" (buffer))
-(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size))
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its line LINE is visible.
(window (and buffer
(or (get-buffer-window buffer)
(if (eq gud-minor-mode 'gdbmi)
- (or (if (get-buffer-window buffer 'visible)
- (display-buffer buffer nil 'visible))
- (unless (gdb-display-source-buffer buffer)
- (gdb-display-buffer buffer nil 'visible))))
+ (display-buffer buffer nil 'visible))
(display-buffer buffer))))
(pos))
(if buffer
(buffer-file-name)
(car frame)))))
((eq key ?F)
- (setq subst (file-name-sans-extension
- (file-name-nondirectory (if insource
- (buffer-file-name)
- (car frame))))))
+ (setq subst (file-name-base (if insource
+ (buffer-file-name)
+ (car frame)))))
((eq key ?d)
(setq subst (file-name-directory (if insource
(buffer-file-name)
;;;###autoload
(define-minor-mode gud-tooltip-mode
- "Toggle the display of GUD tooltips."
+ "Toggle the display of GUD tooltips.
+With a prefix argument ARG, enable the feature if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+it if ARG is omitted or nil."
:global t
:group 'gud
:group 'tooltip
(defun gud-tooltip-dereference (&optional arg)
"Toggle whether tooltips should show `* expr' or `expr'.
-With arg, dereference expr if ARG is positive, otherwise do not derereference."
+With arg, dereference expr if ARG is positive, otherwise do not dereference."
(interactive "P")
(setq gud-tooltip-dereference
(if (null arg)
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
- (case gud-minor-mode
- (gdbmi (concat "-data-evaluate-expression " expr))
- (dbx (concat "print " expr))
- ((xdb pdb) (concat "p " expr))
- (sdb (concat expr "/"))))
+ (pcase gud-minor-mode
+ (`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+ (`dbx (concat "print " expr))
+ ((or `xdb `pdb) (concat "p " expr))
+ (`sdb (concat expr "/"))))
-(declare-function gdb-input "gdb-mi" (item))
+(declare-function gdb-input "gdb-mi" (command handler))
(declare-function tooltip-expr-to-print "tooltip" (event))
(declare-function tooltip-event-buffer "tooltip" (event))
(let ((cmd (gud-tooltip-print-command expr)))
(when (and gud-tooltip-mode (eq gud-minor-mode 'gdb))
(gud-tooltip-mode -1)
- (message-box "Using GUD tooltips in this mode is unsafe\n\
+ ;; The blank before the newline is for MS-Windows,
+ ;; whose emulation of message box removes newlines and
+ ;; displays a single long line.
+ (message-box "Using GUD tooltips in this mode is unsafe \n\
so they have been disabled."))
(unless (null cmd) ; CMD can be nil if unknown debugger
(if (eq gud-minor-mode 'gdbmi)
(if gdb-macro-info
(gdb-input
- (list (concat
- "server macro expand " expr "\n")
- `(lambda () (gdb-tooltip-print-1 ,expr))))
+ (concat
+ "server macro expand " expr "\n")
+ `(lambda () (gdb-tooltip-print-1 ,expr)))
(gdb-input
- (list (concat cmd "\n")
- `(lambda () (gdb-tooltip-print ,expr)))))
+ (concat cmd "\n")
+ `(lambda () (gdb-tooltip-print ,expr))))
(setq gud-tooltip-original-filter (process-filter process))
(set-process-filter process 'gud-tooltip-process-output)
(gud-basic-call cmd))
HCoop / bpt / emacs.git / blobdiff