(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)
(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)
(if (boundp sym) (symbol-value sym))))
(defvar gud-running nil
- "Non-nil if debuggee is running.
-Used to grey out relevant togolbar icons.")
+ "Non-nil if debugged program is running.
+Used to grey out relevant toolbar icons.")
;; Use existing Info buffer, if possible.
(defun gud-goto-info ()
(defun gud-stop-subjob ()
(interactive)
- (if (string-equal
- (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs")
- (comint-stop-subjob)
- (comint-interrupt-subjob)))
+ (with-current-buffer gud-comint-buffer
+ (if (string-equal gud-target-name "emacs")
+ (comint-stop-subjob)
+ (comint-interrupt-subjob))))
(easy-mmode-defmap gud-menu-map
'(([help] "Info" . gud-goto-info)
:enable (and (not emacs-basic-display)
(display-graphic-p)
(fboundp 'x-show-tip))
+ :visible (memq gud-minor-mode
+ '(gdbmi gdba dbx sdb xdb pdb))
:button (:toggle . gud-tooltip-mode))
([refresh] "Refresh" . gud-refresh)
([run] menu-item "Run" gud-run
- :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
+ :enable (not gud-running)
+ :visible (and (memq gud-minor-mode '(gdbmi gdb dbx jdb))
+ (not (eq gud-minor-mode 'gdba))))
+ ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
:visible (and (not gud-running)
(eq gud-minor-mode 'gdba)))
([stop] menu-item "Stop" gud-stop-subjob
(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))
+ :enable (not gud-running)
+ :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb))
+ (gud-tool-bar-item-visible-no-fringe)))
([remove] menu-item "Remove Breakpoint" gud-remove
:enable (not gud-running)
:visible (gud-tool-bar-item-visible-no-fringe))
([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
- :enable (memq gud-minor-mode
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode
'(gdbmi gdba gdb sdb xdb bashdb)))
([break] menu-item "Set Breakpoint" gud-break
: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
- '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
+ :enable (not gud-running)
+ :visible (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
- '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
- ([pp] menu-item "Print the emacs s-expression" gud-pp
+ :enable (not gud-running)
+ :visible (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
'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))))
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdba gdb)))
([print] menu-item "Print Expression" gud-print
:enable (not gud-running))
([watch] menu-item "Watch Expression" gud-watch
- :enable (and (not gud-running)
- (memq gud-minor-mode '(gdbmi gdba))))
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdba)))
([finish] menu-item "Finish Function" gud-finish
- :enable (and (not gud-running)
- (memq gud-minor-mode
- '(gdbmi gdba gdb xdb jdb pdb bashdb))))
+ :enable (not gud-running)
+ :visible (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 '(gdbmi gdba gdb dbx))))
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
([nexti] menu-item "Next Instruction" gud-nexti
- :enable (and (not gud-running)
- (memq gud-minor-mode '(gdbmi gdba gdb dbx))))
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
([step] menu-item "Step Line" gud-step
:enable (not gud-running))
([next] menu-item "Next Line" gud-next
(gud-run . "gud/run")
(gud-go . "gud/go")
(gud-stop-subjob . "gud/stop")
- ;; gud-s, gud-si etc. instead of gud-step,
- ;; gud-stepi, to avoid file-name clashes on DOS
- ;; 8+3 filesystems.
(gud-cont . "gud/cont")
(gud-until . "gud/until")
(gud-next . "gud/next")
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
(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 4 var)
- (speedbar-message "%s" (nth 3 var)))))
+ (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."
(buffer-name gud-comint-buffer))
(let* ((minor-mode (with-current-buffer buffer gud-minor-mode))
(window (get-buffer-window (current-buffer) 0))
+ (start (window-start window))
(p (window-point window)))
(cond
((memq minor-mode '(gdbmi gdba))
- (when (or gdb-force-update
- (not (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t))
- (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))
- (expr (car var)) (varnum (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)))
+ (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 ?? nil nil
- (concat expr "\t" value)
+ '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
(t t)))
t)
depth)
- (if (eq status 'out-of-scope) (setq parent 'shadow))
- (if (and (cadr var-list)
- (string-match (concat varnum "\\.")
- (cadr (cadr 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 status)
- nil 'gdb-edit-value)
- nil
- (if (and (or parent (eq status 'out-of-scope))
- gdb-show-changed-values) 'shadow 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)))
+ (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)))))
(t (unless (and (save-excursion
(goto-char (point-min))
(looking-at "Current Stack:"))
(t (error "Should never be here")))
frame t))))
(setq gud-last-speedbar-stackframe gud-last-last-frame))))
+ (set-window-start window start)
(set-window-point window p))))
\f
(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\""))
;; 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
(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"))
+ (error "This program is already being debugged"))
;; 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.
((memq (process-status proc) '(signal exit))
;; Stop displaying an arrow in a source file.
(setq gud-overlay-arrow-position nil)
- (with-current-buffer gud-comint-buffer
- (if (memq gud-minor-mode-type '(gdbmi gdba))
- (gdb-reset)
- (gud-reset)))
+ (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+ '(gdba gdbmi))
+ (gdb-reset)
+ (gud-reset))
(let* ((obuf (current-buffer)))
;; save-excursion isn't the right thing if
;; process-buffer is current-buffer
(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 (memq gud-minor-mode '(gdbmi gdba))
(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>,
(defvar gdb-script-font-lock-keywords
'(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face))
("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
- ("^\\s-*\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face))))
+ ("^\\s-*\\(\\w\\(\\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).
(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
- (with-current-buffer gud-comint-buffer
- (memq gud-minor-mode '(gdbmi gdba))))
+ (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))
(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)
+(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode
+ python-mode)
"List of modes for which to enable GUD tooltips."
:type 'sexp
:group 'gud
(defvar gud-tooltip-mouse-motions-active nil
"Locally t in a buffer if tooltip processing of mouse motion is enabled.")
+;; We don't set track-mouse globally because this is a big redisplay
+;; problem in buffers having a pre-command-hook or such installed,
+;; which does a set-buffer, like the summary buffer of Gnus. Calling
+;; set-buffer prevents redisplay optimizations, so every mouse motion
+;; would be accompanied by a full redisplay.
+
(defun gud-tooltip-activate-mouse-motions (activatep)
"Activate/deactivate mouse motion events for the current buffer.
ACTIVATEP non-nil means activate mouse motion events."
(case gud-minor-mode
(gdba (concat "server print " expr))
((dbx gdbmi) (concat "print " expr))
- (xdb (concat "p " expr))
- (sdb (concat expr "/"))
- (perldb expr)))
+ ((xdb pdb) (concat "p " expr))
+ (sdb (concat expr "/"))))
(defun gud-tooltip-tips (event)
"Show tip for identifier or selection under the mouse.
gdb-server-prefix "macro expand " expr "\n")
`(lambda () (gdb-tooltip-print-1 ,expr))))
(gdb-enqueue-input
- (list (concat cmd "\n") 'gdb-tooltip-print)))
+ (list (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))