;; Maintainer: FSF
;; Keywords: unix, tools
-;; Copyright (C) 1992,93,94,95,96,1998,2000,02,2003 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, 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.)
+;; 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> Barry
+;; Warsaw <bwarsaw@cen.com> 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:
+(eval-when-compile (require 'cl)) ; for case macro
+
(require 'comint)
-(require 'etags)
+
+(defvar gdb-active-process)
+(defvar gdb-define-alist)
+(defvar gdb-macro-info)
+(defvar gdb-server-prefix)
+(defvar gdb-show-changed-values)
+(defvar gdb-force-update)
+(defvar gdb-var-list)
+(defvar gdb-speedbar-auto-raise)
+(defvar tool-bar-map)
;; ======================================================================
;; GUD commands must be visible in C buffers visited by GUD
(defvar gud-minor-mode nil)
(put 'gud-minor-mode 'permanent-local t)
+(defvar gud-comint-buffer nil)
+
(defvar gud-keep-buffer nil)
(defun gud-symbol (sym &optional soft minor-mode)
(defvar gud-running nil
"Non-nil if debuggee is running.
-Used to grey out relevant toolbar icons.")
+Used to grey out relevant togolbar icons.")
+
+;; Use existing Info buffer, if possible.
+(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 (memq gud-minor-mode '(gdbmi gdba))
+ (info "(emacs)GDB Graphical Interface")
+ (info "(emacs)Debuggers"))))
+
+(defun gud-tool-bar-item-visible-no-fringe ()
+ (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode)
+ (and (memq gud-minor-mode '(gdbmi gdba))
+ (> (car (window-fringes)) 0)))))
+
+(defun gud-stop-subjob ()
+ (interactive)
+ (if (string-equal
+ (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs")
+ (comint-stop-subjob)
+ (comint-interrupt-subjob)))
(easy-mmode-defmap gud-menu-map
- '(([refresh] "Refresh" . gud-refresh)
+ '(([help] "Info" . gud-goto-info)
+ ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode
+ :enable (and (not emacs-basic-display)
+ (display-graphic-p)
+ (fboundp 'x-show-tip))
+ :button (:toggle . gud-tooltip-mode))
+ ([refresh] "Refresh" . gud-refresh)
([run] menu-item "Run" gud-run
- :enable (and (not gud-running)
- (memq gud-minor-mode '(gdba gdb dbx jdb))))
- ([goto] menu-item "Continue to selection" gud-until
- :enable (and (not gud-running)
- (memq gud-minor-mode '(gdba gdb))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
+ :visible (not (eq gud-minor-mode 'gdba)))
+ ([go] menu-item "Run/Continue" gud-go
+ :visible (and (not gud-running)
+ (eq gud-minor-mode 'gdba)))
+ ([stop] menu-item "Stop" gud-stop-subjob
+ :visible (or (not (eq gud-minor-mode 'gdba))
+ (and gud-running
+ (eq gud-minor-mode 'gdba))))
+ ([until] menu-item "Continue to selection" gud-until
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdba gdb perldb)))
+ :visible (gud-tool-bar-item-visible-no-fringe))
([remove] menu-item "Remove Breakpoint" gud-remove
- :enable (not gud-running))
+ :enable (not gud-running)
+ :visible (gud-tool-bar-item-visible-no-fringe))
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
- :enable (memq gud-minor-mode '(gdba gdb sdb xdb bashdb)))
+ :enable (memq gud-minor-mode
+ '(gdbmi gdba gdb sdb xdb bashdb)))
([break] menu-item "Set Breakpoint" gud-break
- :enable (not gud-running))
+ :enable (not gud-running)
+ :visible (gud-tool-bar-item-visible-no-fringe))
([up] menu-item "Up Stack" gud-up
- :enable (and (not gud-running)
- (memq gud-minor-mode
- '(gdba gdb dbx xdb jdb pdb bashdb))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode
+ '(gdbmi 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))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode
+ '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
+ ([pp] menu-item "Print S-expression" gud-pp
+ :enable (and (not gud-running)
+ gdb-active-process)
+ :visible (and (string-equal
+ (buffer-local-value
+ 'gud-target-name gud-comint-buffer) "emacs")
+ (eq gud-minor-mode 'gdba)))
+ ([print*] menu-item "Print Dereference" gud-pstar
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdba gdb))))
([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)))
+ :enable (not gud-running))
+ ([watch] menu-item "Watch Expression" gud-watch
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdba))))
([finish] menu-item "Finish Function" gud-finish
- :enable (and (not gud-running)
- (memq gud-minor-mode
- '(gdba gdb xdb jdb pdb bashdb))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode
+ '(gdbmi 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))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdba gdb dbx))))
([nexti] menu-item "Next Instruction" gud-nexti
- :enable (and (not gud-running)
- (memq gud-minor-mode
- '(gdba gdb dbx))))
+ :enable (and (not gud-running)
+ (memq gud-minor-mode '(gdbmi gdba gdb dbx))))
([step] menu-item "Step Line" gud-step
- :enable (not gud-running))
+ :enable (not gud-running))
([next] menu-item "Next Line" gud-next
- :enable (not gud-running))
+ :enable (not gud-running))
([cont] menu-item "Continue" gud-cont
- :enable (not gud-running)))
+ :enable (not gud-running)
+ :visible (not (eq gud-minor-mode 'gdba))))
"Menu for `gud-mode'."
:name "Gud")
(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"))
+ (dolist (x '((gud-break . "gud/break")
+ (gud-remove . "gud/remove")
+ (gud-print . "gud/print")
+ (gud-pstar . "gud/pstar")
+ (gud-pp . "gud/pp")
+ (gud-watch . "gud/watch")
+ (gud-run . "gud/run")
+ (gud-go . "gud/go")
+ (gud-stop-subjob . "gud/stop")
+ (gud-cont . "gud/cont")
+ (gud-until . "gud/until")
+ (gud-next . "gud/next")
+ (gud-step . "gud/step")
+ (gud-finish . "gud/finish")
+ (gud-nexti . "gud/nexti")
+ (gud-stepi . "gud/stepi")
+ (gud-up . "gud/up")
+ (gud-down . "gud/down")
+ (gud-goto-info . "info"))
map)
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map)))))
(with-current-buffer buf
(set (make-local-variable 'gud-minor-mode) minor-mode)
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (when (and gud-tooltip-mode
+ (memq gud-minor-mode '(gdbmi gdba)))
+ (make-local-variable 'gdb-define-alist)
+ (unless gdb-define-alist (gdb-create-define-alist))
+ (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
(make-local-variable 'gud-keep-buffer))
buf)))
\f
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
+ %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.
+ %c -- Fully qualified class name derived from the expression
+ surrounding point (jdb only).
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
;; 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-speedbar-item-info ()
+ "Display the data type of the watch expression element."
+ (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)))
+ (if (nth 6 var)
+ (speedbar-message "%s: %s" (nth 6 var) (nth 3 var))
+ (speedbar-message "%s" (nth 3 var)))))
+
(defun gud-install-speedbar-variables ()
"Install those variables used by speedbar to enhance gud/gdb."
(if gud-speedbar-key-map
(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)))
+ (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)
+ (define-key gud-speedbar-key-map " " 'speedbar-toggle-line-expansion)
+ (define-key gud-speedbar-key-map "[" 'speedbar-expand-line-descendants)
+ (define-key gud-speedbar-key-map "]" 'speedbar-contract-line-descendants)
+ (define-key gud-speedbar-key-map "D" 'gdb-var-delete)
+ (define-key gud-speedbar-key-map "p" 'gud-pp))
+
+ (speedbar-add-expansion-list '("GUD" gud-speedbar-menu-items
+ gud-speedbar-key-map
+ gud-expansion-speedbar-buttons))
+
+ (add-to-list
+ 'speedbar-mode-functions-list
+ '("GUD" (speedbar-item-info . gud-speedbar-item-info)
+ (speedbar-line-directory . ignore))))
(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])
+ '(["Jump to stack frame" speedbar-edit-line
+ :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdbmi gdba)))]
+ ["Edit value" speedbar-edit-line
+ :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdbmi gdba))]
+ ["Delete expression" gdb-var-delete
+ :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdbmi gdba))]
+ ["Auto raise frame" gdb-speedbar-auto-raise
+ :style toggle :selected gdb-speedbar-auto-raise
+ :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdbmi gdba))])
"Additional menu items to add to the speedbar frame.")
;; Make sure our special speedbar mode is loaded
(gud-install-speedbar-variables)
(add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
+(defun gud-expansion-speedbar-buttons (directory zero)
+ "Wrapper for call to speedbar-add-expansion-list. DIRECTORY and
+ZERO are not used, but are required by the caller."
+ (gud-speedbar-buttons gud-comint-buffer))
+
(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)
+off the specialized speedbar mode. BUFFER is not used, but are
+required by the caller."
+ (when (and gud-comint-buffer
+ ;; gud-comint-buffer might be killed
+ (buffer-name gud-comint-buffer))
(let* ((minor-mode (with-current-buffer buffer gud-minor-mode))
- (frames
- (cond ((memq minor-mode '(gdba gdb))
+ (window (get-buffer-window (current-buffer) 0))
+ (p (window-point window)))
+ (cond
+ ((memq minor-mode '(gdbmi gdba))
+ (when (or gdb-force-update
+ (not (save-excursion
+ (goto-char (point-min))
+ (looking-at "Watch Expressions:"))))
+ (erase-buffer)
+ (insert "Watch Expressions:\n")
+ (if gdb-speedbar-auto-raise
+ (raise-frame speedbar-frame))
+ (let ((var-list gdb-var-list) parent)
+ (while var-list
+ (let* (char (depth 0) (start 0) (var (car var-list))
+ (varnum (car var)) (expr (nth 1 var))
+ (type (nth 3 var)) (value (nth 4 var))
+ (status (nth 5 var)))
+ (put-text-property
+ 0 (length expr) 'face font-lock-variable-name-face expr)
+ (put-text-property
+ 0 (length type) 'face font-lock-type-face type)
+ (while (string-match "\\." varnum start)
+ (setq depth (1+ depth)
+ start (1+ (match-beginning 0))))
+ (if (eq depth 0) (setq parent nil))
+ (if (or (equal (nth 2 var) "0")
+ (and (equal (nth 2 var) "1")
+ (string-match "char \\*$" type)))
+ (speedbar-make-tag-line
+ 'bracket ?? nil nil
+ (concat expr "\t" value)
+ (if (or parent (eq status 'out-of-scope))
+ 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)))
+ t)
+ depth)
+ (if (eq status 'out-of-scope) (setq parent 'shadow))
+ (if (and (nth 1 var-list)
+ (string-match (concat varnum "\\.")
+ (car (nth 1 var-list))))
+ (setq char ?-)
+ (setq char ?+))
+ (if (string-match "\\*$" type)
+ (speedbar-make-tag-line
+ 'bracket char
+ 'gdb-speedbar-expand-node varnum
+ (concat expr "\t" type "\t" value)
+ (if (or parent (eq status 'out-of-scope))
+ 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)))
+ t)
+ depth)
+ (speedbar-make-tag-line
+ 'bracket char
+ 'gdb-speedbar-expand-node varnum
+ (concat expr "\t" type)
+ nil nil
+ (if (and (or parent status) gdb-show-changed-values)
+ 'shadow t)
+ depth))))
+ (setq var-list (cdr var-list))))
+ (setq gdb-force-update nil)))
+ (t (unless (and (save-excursion
+ (goto-char (point-min))
+ (looking-at "Current Stack:"))
+ (equal gud-last-last-frame gud-last-speedbar-stackframe))
+ (let ((gud-frame-list
+ (cond ((eq minor-mode '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)))
+ (t (speedbar-remove-localized-speedbar-support buffer)
+ nil))))
+ (erase-buffer)
+ (if (not gud-frame-list)
+ (insert "No Stack frames\n")
+ (insert "Current Stack:\n"))
+ (dolist (frame gud-frame-list)
+ (insert (nth 1 frame) ":\n")
+ (if (= (length frame) 2)
+ (progn
+ (speedbar-insert-button (car frame)
+ 'speedbar-directory-face
+ nil nil nil t))
+ (speedbar-insert-button
+ (car frame)
+ 'speedbar-file-face
+ 'speedbar-highlight-face
+ (cond ((memq minor-mode '(gdbmi gdba gdb))
+ 'gud-gdb-goto-stackframe)
+ (t (error "Should never be here")))
+ frame t))))
+ (setq gud-last-speedbar-stackframe gud-last-last-frame))))
+ (set-window-point window p))))
\f
;; ======================================================================
;; History of argument lists passed to gdb.
(defvar gud-gdb-history nil)
-(defcustom gud-gdb-command-name "gdb --fullname"
+(defcustom gud-gdb-command-name "gdb --annotate=3"
"Default command to execute an executable under the GDB debugger."
:type 'string
:group 'gud)
;; 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)))
+ (string-to-number (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.
;; Set the accumulator to the remaining text.
gud-marker-acc (substring gud-marker-acc (match-end 0))))
+ ;; Check for annotations and change gud-minor-mode to 'gdba if
+ ;; they are found.
+ (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
+ (let ((match (match-string 1 gud-marker-acc)))
+
+ ;; Pick up stopped annotation if attaching to process.
+ (if (string-equal match "stopped") (setq gdb-active-process t))
+
+ ;; Using annotations, switch to gud-gdba-marker-filter.
+ (when (string-equal match "prompt")
+ (require 'gdb-ui)
+ (gdb-prompt nil))
+
+ (setq
+ ;; 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)))
+
+ ;; Pick up any errors that occur before first prompt annotation.
+ (if (string-equal match "error-begin")
+ (put-text-property 0 (length gud-marker-acc)
+ 'face font-lock-warning-face
+ gud-marker-acc))))
+
;; 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)
+ (if (string-match "\n\\(\032.*\\)?\\'" gud-marker-acc)
(progn
;; Everything before the potential marker start can be output.
(setq output (concat output (substring gud-marker-acc
gud-minibuffer-local-map nil
hist-sym)))
+(defvar gdb-first-prompt t)
+
+(defvar gud-filter-pending-text nil
+ "Non-nil means this is text that has been saved for later in `gud-filter'.")
+
;;;###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."
+The directory containing FILE becomes the initial working
+directory and source-file directory for your debugger. By
+default this command starts GDB using a graphical interface. See
+`gdba' for more information.
+
+To run GDB in text command mode, set `gud-gdb-command-name' to
+\"gdb --fullname\" and include the pathname, if necessary."
(interactive (list (gud-query-cmdline 'gdb)))
+ (if (and gud-comint-buffer
+ (buffer-name gud-comint-buffer)
+ (get-buffer-process gud-comint-buffer)
+ (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
+ (error "Multiple debugging is only supported with \"gdb --fullname\""))
+
(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.")
+ (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
+ (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l"))
+ "\C-j" "Set execution address to current line.")
+
+ (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-pstar "print* %e" nil
+ "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-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)
- )
+ (setq gdb-first-prompt t)
+ (setq gud-filter-pending-text nil)
+ (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
;; The completion list is constructed by the process filter.
(defvar gud-gdb-fetched-lines)
-(defvar gud-comint-buffer nil)
-
-(defun gud-gdb-complete-command ()
+(defun gud-gdb-complete-command (&optional command a b)
"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
+ (if command
+ ;; Used by gud-watch in mini-buffer.
+ (setq command (concat "p " command))
+ ;; Used in GUD buffer.
+ (let ((end (point)))
+ (setq command (buffer-substring (comint-line-beginning-position) end))))
+ (let* ((command-word
;; Find the word break. This match will always succeed.
(and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
(substring command (match-beginning 2))))
(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.
+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 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)))
+ (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.
(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))))
+ `(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)))
+ (accept-process-output (get-buffer-process gud-comint-buffer)))
(nreverse gud-gdb-fetched-lines)))))
\f
gud-marker-acc start)
(setq gud-last-frame
(cons (match-string 3 gud-marker-acc)
- (string-to-int (match-string 4 gud-marker-acc)))))
+ (string-to-number (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)))))
+ (string-to-number (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)
gud-marker-acc start))
(setq gud-last-frame
(cons gud-sdb-lastfile
- (string-to-int (match-string 1 gud-marker-acc)))))
+ (string-to-number (match-string 1 gud-marker-acc)))))
(t
(setq gud-sdb-lastfile nil)))
(setq start (match-end 0)))
and source-file directory for your debugger."
(interactive (list (gud-query-cmdline 'sdb)))
+ (if gud-sdb-needs-tags (require 'etags))
(if (and gud-sdb-needs-tags
(not (and (boundp 'tags-file-name)
(stringp tags-file-name)
gud-marker-acc start))
(setq gud-last-frame
(cons (match-string 2 gud-marker-acc)
- (string-to-int (match-string 1 gud-marker-acc)))
+ (string-to-number (match-string 1 gud-marker-acc)))
start (match-end 0)))
;; Search for the last incomplete line in this chunk
;; 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)))
+ (string-to-number (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.
(if (file-exists-p file)
(setq gud-last-frame
(cons (match-string 1 result)
- (string-to-int (match-string 2 result))))))
+ (string-to-number (match-string 2 result))))))
result)
((string-match ; kluged-up marker as above
"\032\032\\([0-9]*\\):\\(.*\\)\n" result)
(if (and file (file-exists-p file))
(setq gud-last-frame
(cons file
- (string-to-int (match-string 1 result))))))
+ (string-to-number (match-string 1 result))))))
(setq result (substring result 0 (match-beginning 0))))))
(or result "")))
(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)))
+ (string-to-number (match-string 3 gud-marker-acc)))
start (match-end 0)))
;; Search for the last incomplete line in this chunk
result)
(string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
result))
- (let ((line (string-to-int (match-string 2 result)))
+ (let ((line (string-to-number (match-string 2 result)))
(file (gud-file-name (match-string 1 result))))
(if file
(setq gud-last-frame (cons file line))))))
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
+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)))
;; 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)))
+ (string-to-number (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.
(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-remove "B %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.")
+ (gud-def gud-print "p %e" "\C-p" "Evaluate perl expression at point.")
+ (gud-def gud-until "c %l" "\C-u" "Continue to current line.")
+
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ")
(setq paragraph-start comint-prompt-regexp)
gud-last-frame
(let ((file (match-string gud-pdb-marker-regexp-file-group
gud-marker-acc))
- (line (string-to-int
+ (line (string-to-number
(match-string gud-pdb-marker-regexp-line-group
gud-marker-acc))))
(if (string-equal file "<string>")
;; Anything else means the input is invalid.
(t
- (message (format "Error parsing file %s." file))
+ (message "Error parsing file %s." file)
(throw 'abort nil))))))
l))
;; 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
+ ;; The ".," in the last square-bracket are 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!)
+ ;; print line numbers using LOCALE, inserting a comma or a
+ ;; period at the thousands positions (how ingenious!).
- "\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \
-\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9,]+\\)"
+ "\\(\\[[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:
;; (<file-name> . <line-number>) .
(if (if (match-beginning 1)
(let (n)
- (setq n (string-to-int (substring
+ (setq n (string-to-number (substring
gud-marker-acc
(1+ (match-beginning 1))
(- (match-end 1) 2))))
(gud-jdb-find-source (match-string 2 gud-marker-acc)))
(setq gud-last-frame
(cons file-found
- (string-to-int
+ (string-to-number
(let
((numstr (match-string 4 gud-marker-acc)))
- (if (string-match "," numstr)
+ (if (string-match "[.,]" numstr)
(replace-match "" nil nil numstr)
numstr)))))
(message "Could not find source file.")))
;; 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)))
+ (string-to-number (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.
;; 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)))
+ (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.
(if (file-name-directory file-subst)
(expand-file-name file-subst)
file-subst)))
- (filepart (and file-word (concat "-" (file-name-nondirectory file)))))
+ (filepart (and file-word (concat "-" (file-name-nondirectory file))))
+ (existing-buffer (get-buffer (concat "*gud" filepart "*"))))
(pop-to-buffer (concat "*gud" filepart "*"))
+ (when (and existing-buffer (get-buffer-process existing-buffer))
+ (error "This program is already running under gdb"))
;; 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.
"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.
(save-restriction
(widen)
(if (marker-buffer gud-delete-prompt-marker)
- (progn
+ (let ((inhibit-read-only t))
(delete-region (process-mark proc)
gud-delete-prompt-marker)
+ (comint-update-fence)
(set-marker gud-delete-prompt-marker nil)))
;; Save the process output, checking for source file markers.
(setq output (gud-marker-filter string))
;; 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)
+ (with-selected-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)))))
+ (with-current-buffer (process-buffer proc)
+ (gud-display-frame))))
;; If we deferred text that arrived during this processing,
;; handle it now.
(gud-filter proc ""))))))
(defvar gud-minor-mode-type nil)
+(defvar gud-overlay-arrow-position nil)
+(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
(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)
+ (setq gud-overlay-arrow-position nil)
(set-process-buffer proc nil)
- (if (eq gud-minor-mode-type 'gdba)
+ (if (and (boundp 'speedbar-frame)
+ (string-equal speedbar-initial-expansion-list-name "GUD"))
+ (speedbar-change-initial-expansion-list
+ speedbar-previously-used-expansion-list-name))
+ (if (memq gud-minor-mode-type '(gdbmi gdba))
(gdb-reset)
(gud-reset)))
((memq (process-status proc) '(signal exit))
;; Stop displaying an arrow in a source file.
- (setq overlay-arrow-position nil)
+ (setq gud-overlay-arrow-position nil)
(with-current-buffer gud-comint-buffer
- (if (eq gud-minor-mode 'gdba)
+ (if (memq gud-minor-mode-type '(gdbmi gdba))
(gdb-reset)
(gud-reset)))
(let* ((obuf (current-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)
+ (setq gud-minor-mode-type gud-minor-mode)
+ (condition-case nil
+ (kill-process (get-buffer-process (current-buffer)))
+ (error nil)))
(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))))))
+ (unless (eq buffer gud-comint-buffer)
+ (with-current-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.
(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)))))
+ (if (memq gud-minor-mode '(gdbmi gdba))
+ (gdb-display-source-buffer buffer))
+ (display-buffer buffer))))
(pos))
(if buffer
(progn
(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)))
+ (or gud-overlay-arrow-position
+ (setq gud-overlay-arrow-position (make-marker)))
+ (set-marker gud-overlay-arrow-position (point) (current-buffer))
+ ;; If they turned on hl-line, move the hl-line highlight to
+ ;; the arrow's line.
+ (when (featurep 'hl-line)
+ (cond
+ (global-hl-line-mode
+ (global-hl-line-highlight))
+ ((and hl-line-mode hl-line-sticky-flag)
+ (hl-line-highlight)))))
(cond ((or (< pos (point-min)) (> pos (point-max)))
(widen)
(goto-char pos))))
- (if window (set-window-point window overlay-arrow-position))))))
+ (if window (set-window-point window gud-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)
(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))
+ (while (and str
+ (let ((case-fold-search nil))
+ (string-match "\\([^%]*\\)%\\([adefFlpc]\\)" str)))
(let ((key (string-to-char (match-string 2 str)))
subst)
(cond
(set-buffer gud-comint-buffer)
(save-restriction
(widen)
- (goto-char (process-mark proc))
- (forward-line 0)
+ (if (marker-position gud-delete-prompt-marker)
+ ;; We get here when printing an expression.
+ (goto-char gud-delete-prompt-marker)
+ (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)
+ (if (memq gud-minor-mode '(gdbmi gdba))
(apply comint-input-sender (list proc command))
(process-send-string proc (concat command "\n")))))))
(defvar gud-find-expr-function 'gud-find-c-expr)
(defun gud-find-expr (&rest args)
- (apply gud-find-expr-function args))
+ (let ((expr (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ (apply gud-find-expr-function args))))
+ (save-match-data
+ (if (string-match "\n" expr)
+ (error "Expression must not include a newline"))
+ (with-current-buffer gud-comint-buffer
+ (save-excursion
+ (goto-char (process-mark (get-buffer-process gud-comint-buffer)))
+ (forward-line 0)
+ (when (looking-at comint-prompt-regexp)
+ (set-marker gud-delete-prompt-marker (point))
+ (set-marker-insertion-type gud-delete-prompt-marker t))
+ (insert (concat expr " = ")))))
+ expr))
;; The next eight functions are hacked from gdbsrc.el by
;; Debby Ayers <ayers@asc.slb.com>,
If `->' is found, return `?.'. If `.' is found, return `?.'.
If any other punctuation is found, return `??'.
If no punctuation is found, return `? '."
- (let ((result ?\ )
+ (let ((result ?\s)
(syntax))
(while (< span-start span-end)
(setq syntax (char-syntax (char-after span-start)))
(cond
- ((= syntax ?\ ) t)
+ ((= syntax ?\s) t)
((= syntax ?.) (setq syntax (char-after span-start))
(cond
((= syntax ?.) (setq result ?.))
((= (car first) (car second)) nil)
((= (cdr first) (cdr second)) nil)
((= syntax ?.) t)
- ((= syntax ?\ )
+ ((= syntax ?\s)
(setq span-start (char-after (- span-start 1)))
(setq span-end (char-after span-end))
(cond
(save-match-data
(let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath))
(fbuffer (get-file-buffer f))
- class-found)
+ syntax-symbol syntax-point class-found)
(setq f (file-name-sans-extension (file-truename f)))
+ ;; Syntax-symbol returns the symbol of the *first* element
+ ;; in the syntactical analysis result list, syntax-point
+ ;; returns the buffer position of same
+ (fset 'syntax-symbol (lambda (x) (c-langelem-sym (car x))))
+ (fset 'syntax-point (lambda (x) (c-langelem-pos (car x))))
;; Search through classpath list for an entry that is
;; contained in f
(while (and cplist (not class-found))
;; with the 'topmost-intro symbol, there may be
;; nested classes...
(while (not (eq 'topmost-intro
- (car (car (c-guess-basic-syntax)))))
+ (syntax-symbol (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))))
+ (and (not (eq 'inclass (syntax-symbol syntax)))
(cdr syntax))
(setq syntax (cdr syntax)))
- (if (eq 'inclass (car (car syntax)))
+ (if (eq 'inclass (syntax-symbol syntax))
(progn
- (goto-char (cdr (car syntax)))
+ (goto-char (syntax-point syntax))
;; Now we're at the beginning of a class
;; definition. Find class name
(looking-at
(append (list (match-string-no-properties 1))
nclass)))
(setq syntax (c-guess-basic-syntax))
- (while (and (not (cdr (car syntax))) (cdr syntax))
+ (while (and (not (syntax-point syntax)) (cdr syntax))
(setq syntax (cdr syntax)))
- (goto-char (cdr (car syntax)))
+ (goto-char (syntax-point syntax))
))
(string-match (concat (car nclass) "$") class-found)
(setq class-found
(message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f)
nil))))
+\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GDB script mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar gdb-script-font-lock-keywords
'(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face))
("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
- ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face))))
+ ("^\\s-*\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face))))
+;; FIXME: The keyword "end" associated with "document"
+;; should have font-lock-keyword-face (currently font-lock-doc-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.
(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)
+ (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\|commands\\)\\>" nil 'move)
(match-end 2))
(gdb-script-skip-to-head)))
(forward-line 0)
(skip-chars-forward " \t")
(+ (current-indentation)
- (if (looking-at "\\(if\\|while\\|define\\|else\\)\\>")
+ (if (looking-at "\\(if\\|while\\|define\\|else\\|commands\\)\\>")
gdb-script-basic-indent 0)))))
(defun gdb-script-indent-line ()
(save-excursion (indent-line-to indent))
(indent-line-to indent)))))
+;; Derived from cfengine.el.
+(defun gdb-script-beginning-of-defun ()
+ "`beginning-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+ (unless (<= (current-column) (current-indentation))
+ (end-of-line))
+ (if (re-search-backward "^define \\|^document " nil t)
+ (beginning-of-line)
+ (goto-char (point-min)))
+ t)
+
+;; Derived from cfengine.el.
+(defun gdb-script-end-of-defun ()
+ "`end-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+ (end-of-line)
+ (if (re-search-forward "^end" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ t)
+
;;;###autoload
(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode))
(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 'beginning-of-defun-function)
+ #'gdb-script-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ #'gdb-script-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
(font-lock-syntactic-keywords
(font-lock-syntactic-face-function
. gdb-script-font-lock-syntactic-face))))
+\f
+;;; tooltips for GUD
+
+;;; Customizable settings
+
+(define-minor-mode gud-tooltip-mode
+ "Toggle the display of GUD tooltips."
+ :global t
+ :group 'gud
+ :group 'tooltip
+ (require 'tooltip)
+ (if gud-tooltip-mode
+ (progn
+ (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
+ (add-hook 'pre-command-hook 'tooltip-hide)
+ (add-hook 'tooltip-hook 'gud-tooltip-tips)
+ (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
+ (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
+ (remove-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
+ (remove-hook 'tooltip-hook 'gud-tooltip-tips)
+ (define-key global-map [mouse-movement] 'ignore)))
+ (gud-tooltip-activate-mouse-motions-if-enabled)
+ (if (and gud-comint-buffer
+ (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
+ (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdbmi gdba)))
+ (if gud-tooltip-mode
+ (progn
+ (dolist (buffer (buffer-list))
+ (unless (eq buffer gud-comint-buffer)
+ (with-current-buffer buffer
+ (when (and (memq gud-minor-mode '(gdbmi gdba))
+ (not (string-match "\\`\\*.+\\*\\'"
+ (buffer-name))))
+ (make-local-variable 'gdb-define-alist)
+ (gdb-create-define-alist)
+ (add-hook 'after-save-hook
+ 'gdb-create-define-alist nil t))))))
+ (kill-local-variable 'gdb-define-alist)
+ (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
+
+(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode)
+ "List of modes for which to enable GUD tooltips."
+ :type 'sexp
+ :group 'gud
+ :group 'tooltip)
+
+(defcustom gud-tooltip-display
+ '((eq (tooltip-event-buffer gud-tooltip-event)
+ (marker-buffer gud-overlay-arrow-position)))
+ "List of forms determining where GUD tooltips are displayed.
+
+Forms in the list are combined with AND. The default is to display
+only tooltips in the buffer containing the overlay arrow."
+ :type 'sexp
+ :group 'gud
+ :group 'tooltip)
+
+(defcustom gud-tooltip-echo-area nil
+ "Use the echo area instead of frames for GUD tooltips."
+ :type 'boolean
+ :group 'gud
+ :group 'tooltip)
+
+(define-obsolete-variable-alias 'tooltip-gud-modes
+ 'gud-tooltip-modes "22.1")
+(define-obsolete-variable-alias 'tooltip-gud-display
+ 'gud-tooltip-display "22.1")
+
+;;; Reacting on mouse movements
+
+(defun gud-tooltip-change-major-mode ()
+ "Function added to `change-major-mode-hook' when tooltip mode is on."
+ (add-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled))
+
+(defun gud-tooltip-activate-mouse-motions-if-enabled ()
+ "Reconsider for all buffers whether mouse motion events are desired."
+ (remove-hook 'post-command-hook
+ 'gud-tooltip-activate-mouse-motions-if-enabled)
+ (dolist (buffer (buffer-list))
+ (save-excursion
+ (set-buffer buffer)
+ (if (and gud-tooltip-mode
+ (memq major-mode gud-tooltip-modes))
+ (gud-tooltip-activate-mouse-motions t)
+ (gud-tooltip-activate-mouse-motions nil)))))
+
+(defvar gud-tooltip-mouse-motions-active nil
+ "Locally t in a buffer if tooltip processing of mouse motion is enabled.")
+
+(defun gud-tooltip-activate-mouse-motions (activatep)
+ "Activate/deactivate mouse motion events for the current buffer.
+ACTIVATEP non-nil means activate mouse motion events."
+ (if activatep
+ (progn
+ (make-local-variable 'gud-tooltip-mouse-motions-active)
+ (setq gud-tooltip-mouse-motions-active t)
+ (make-local-variable 'track-mouse)
+ (setq track-mouse t))
+ (when gud-tooltip-mouse-motions-active
+ (kill-local-variable 'gud-tooltip-mouse-motions-active)
+ (kill-local-variable 'track-mouse))))
+
+(defun gud-tooltip-mouse-motion (event)
+ "Command handler for mouse movement events in `global-map'."
+ (interactive "e")
+ (tooltip-hide)
+ (when (car (mouse-pixel-position))
+ (setq tooltip-last-mouse-motion-event (copy-sequence event))
+ (tooltip-start-delayed-tip)))
+
+;;; Tips for `gud'
+
+(defvar gud-tooltip-original-filter nil
+ "Process filter to restore after GUD output has been received.")
+
+(defvar gud-tooltip-dereference nil
+ "Non-nil means print expressions with a `*' in front of them.
+For C this would dereference a pointer expression.")
+
+(defvar gud-tooltip-event nil
+ "The mouse movement event that led to a tooltip display.
+This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
+
+(defun gud-tooltip-dereference (&optional arg)
+ "Toggle whether tooltips should show `* expr' or `expr'.
+With arg, dereference expr iff arg is positive."
+ (interactive "P")
+ (setq gud-tooltip-dereference
+ (if (null arg)
+ (not gud-tooltip-dereference)
+ (> (prefix-numeric-value arg) 0)))
+ (message "Dereferencing is now %s."
+ (if gud-tooltip-dereference "on" "off")))
+
+(define-obsolete-function-alias 'tooltip-gud-toggle-dereference
+ 'gud-tooltip-dereference "22.1")
+
+; This will only display data that comes in one chunk.
+; Larger arrays (say 400 elements) are displayed in
+; the tooltip incompletely and spill over into the gud buffer.
+; Switching the process-filter creates timing problems and
+; it may be difficult to do better. Using annotations as in
+; gdb-ui.el gets round this problem.
+(defun gud-tooltip-process-output (process output)
+ "Process debugger output and show it in a tooltip window."
+ (set-process-filter process gud-tooltip-original-filter)
+ (tooltip-show (tooltip-strip-prompt process output)
+ (or gud-tooltip-echo-area tooltip-use-echo-area)))
+
+(defun gud-tooltip-print-command (expr)
+ "Return a suitable command to print the expression EXPR."
+ (case gud-minor-mode
+ (gdba (concat "server print " expr))
+ ((dbx gdbmi) (concat "print " expr))
+ (xdb (concat "p " expr))
+ (sdb (concat expr "/"))
+ (perldb expr)))
+
+(defun gud-tooltip-tips (event)
+ "Show tip for identifier or selection under the mouse.
+The mouse must either point at an identifier or inside a selected
+region for the tip window to be shown. If gud-tooltip-dereference is t,
+add a `*' in front of the printed expression. In the case of a C program
+controlled by GDB, show the associated #define directives when program is
+not executing.
+
+This function must return nil if it doesn't handle EVENT."
+ (let (process)
+ (when (and (eventp event)
+ gud-tooltip-mode
+ gud-comint-buffer
+ (buffer-name gud-comint-buffer); might be killed
+ (setq process (get-buffer-process gud-comint-buffer))
+ (posn-point (event-end event))
+ (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
+ (progn (setq gud-tooltip-event event)
+ (eval (cons 'and gud-tooltip-display)))))
+ (let ((expr (tooltip-expr-to-print event)))
+ (when expr
+ (if (and (eq gud-minor-mode 'gdba)
+ (not gdb-active-process))
+ (progn
+ (with-current-buffer
+ (window-buffer (let ((mouse (mouse-position)))
+ (window-at (cadr mouse)
+ (cddr mouse))))
+ (let ((define-elt (assoc expr gdb-define-alist)))
+ (unless (null define-elt)
+ (tooltip-show
+ (cdr define-elt)
+ (or gud-tooltip-echo-area tooltip-use-echo-area))
+ expr))))
+ (when gud-tooltip-dereference
+ (setq expr (concat "*" expr)))
+ (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\
+so they have been disabled."))
+ (unless (null cmd) ; CMD can be nil if unknown debugger
+ (if (memq gud-minor-mode '(gdba gdbmi))
+ (if gdb-macro-info
+ (gdb-enqueue-input
+ (list (concat
+ gdb-server-prefix "macro expand " expr "\n")
+ `(lambda () (gdb-tooltip-print-1 ,expr))))
+ (gdb-enqueue-input
+ (list (concat cmd "\n") 'gdb-tooltip-print)))
+ (setq gud-tooltip-original-filter (process-filter process))
+ (set-process-filter process 'gud-tooltip-process-output)
+ (gud-basic-call cmd))
+ expr))))))))
+
(provide 'gud)
+;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4
;;; gud.el ends here