X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7b75b9937c61cbd8ac6a0fbb32cb52430f762322..bdaf8a62d53cf8d5a0dc4f0dc530ecd6fc1f44fe:/lisp/progmodes/gud.el diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 993013786c..4b0dec7002 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -5,13 +5,13 @@ ;; Keywords: unix, tools ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -43,15 +43,14 @@ (eval-when-compile (require 'cl)) ; for case macro (require 'comint) -(require 'font-lock) (defvar gdb-active-process) (defvar gdb-define-alist) (defvar gdb-macro-info) (defvar gdb-server-prefix) (defvar gdb-show-changed-values) -(defvar gdb-var-changed) (defvar gdb-var-list) +(defvar gdb-speedbar-auto-raise) (defvar tool-bar-map) ;; ====================================================================== @@ -59,8 +58,8 @@ (defgroup gud nil "Grand Unified Debugger mode for gdb and other debuggers under Emacs. -Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and bash." - :group 'unix +Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb." + :group 'processes :group 'tools) @@ -83,6 +82,8 @@ Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and b (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) @@ -100,8 +101,8 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist." (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 () @@ -127,83 +128,130 @@ Used to grey out relevant togolbar icons.") (and (memq gud-minor-mode '(gdbmi gdba)) (> (car (window-fringes)) 0))))) +(defun gud-stop-subjob () + (interactive) + (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) ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode :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 (memq gud-minor-mode '(gdbmi gdb dbx jdb))) + ([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" comint-stop-subjob - :visible (or (not (eq gud-minor-mode 'gdba)) + ([stop] menu-item "Stop" gud-stop-subjob + :visible (or (not (memq gud-minor-mode '(gdba pdb))) (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 - '(gdbmi gdba gdb sdb xdb bashdb))) + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdba gdb sdb xdb))) ([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))) ([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 (and (not gud-running) + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdba gdb dbx xdb jdb pdb))) + ([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))) + :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)))) + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba gdb))) ([print] menu-item "Print Expression" gud-print - :enable (not gud-running)) + :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))) ([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)) + :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) - :visible (not (eq gud-minor-mode 'gdba)))) + :enable (not gud-running) + :visible (not (eq gud-minor-mode 'gdba)))) "Menu for `gud-mode'." :name "Gud") (easy-mmode-defmap gud-minor-mode-map - `(([menu-bar debug] . ("Gud" . ,gud-menu-map))) + (append + `(([menu-bar debug] . ("Gud" . ,gud-menu-map))) + ;; Get tool bar like functionality from the menu bar on a text only + ;; terminal. + (unless window-system + `(([menu-bar down] + . (,(propertize "down" 'face 'font-lock-doc-face) . gud-down)) + ([menu-bar up] + . (,(propertize "up" 'face 'font-lock-doc-face) . gud-up)) + ([menu-bar finish] + . (,(propertize "finish" 'face 'font-lock-doc-face) . gud-finish)) + ([menu-bar step] + . (,(propertize "step" 'face 'font-lock-doc-face) . gud-step)) + ([menu-bar next] + . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) + ([menu-bar until] menu-item + ,(propertize "until" 'face 'font-lock-doc-face) gud-until + :visible (memq gud-minor-mode '(gdbmi gdba gdb perldb))) + ([menu-bar cont] menu-item + ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont + :visible (not (eq gud-minor-mode 'gdba))) + ([menu-bar run] menu-item + ,(propertize "run" 'face 'font-lock-doc-face) gud-run + :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) + ([menu-bar go] menu-item + ,(propertize " go " 'face 'font-lock-doc-face) gud-go + :visible (and (not gud-running) + (eq gud-minor-mode 'gdba))) + ([menu-bar stop] menu-item + ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob + :visible (or gud-running + (not (eq gud-minor-mode 'gdba)))) + ([menu-bar print] + . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) + ([menu-bar tools] . undefined) + ([menu-bar buffer] . undefined) + ([menu-bar options] . undefined) + ([menu-bar edit] . undefined) + ([menu-bar file] . undefined)))) "Map used in visited files.") (let ((m (assq 'gud-minor-mode minor-mode-map-alist))) @@ -226,10 +274,7 @@ Used to grey out relevant togolbar icons.") (gud-watch . "gud/watch") (gud-run . "gud/run") (gud-go . "gud/go") - (comint-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-stop-subjob . "gud/stop") (gud-cont . "gud/cont") (gud-until . "gud/until") (gud-next . "gud/next") @@ -247,6 +292,11 @@ Used to grey out relevant togolbar icons.") (defun gud-file-name (f) "Transform a relative file name to an absolute file name. Uses `gud--directories' to find the source files." + ;; When `default-directory' is a remote file name, prepend its + ;; remote part to f, which is the local file name. Fortunately, + ;; `file-remote-p' returns exactly this remote file name part (or + ;; nil otherwise). + (setq f (concat (or (file-remote-p default-directory) "") f)) (if (file-exists-p f) (expand-file-name f) (let ((directories (gud-val 'directories)) (result nil)) @@ -297,13 +347,15 @@ Uses `gud--directories' to find the source files." 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 @@ -367,6 +419,13 @@ 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 @@ -377,24 +436,32 @@ t means that there is no stack, and we are in display-file mode.") (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 " " '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 "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))) + 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 '(["Jump to stack frame" speedbar-edit-line - :visible (with-current-buffer gud-comint-buffer - (not (memq gud-minor-mode '(gdbmi gdba))))] + :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + '(gdbmi gdba)))] ["Edit value" speedbar-edit-line - :visible (with-current-buffer gud-comint-buffer - (memq gud-minor-mode '(gdbmi gdba)))] + :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + '(gdbmi gdba))] ["Delete expression" gdb-var-delete - (with-current-buffer gud-comint-buffer - (memq gud-minor-mode '(gdbmi gdba)))]) + :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 @@ -412,54 +479,83 @@ ZERO are not used, but are required by the caller." If the GUD BUFFER is not running a supported debugger, then turn off the specialized speedbar mode. BUFFER is not used, but are required by the caller." - (when (and (boundp 'gud-comint-buffer) - gud-comint-buffer + (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)) (window (get-buffer-window (current-buffer) 0)) + (start (window-start window)) (p (window-point window))) (cond ((memq minor-mode '(gdbmi gdba)) - (when (or gdb-var-changed - (not (save-excursion + (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 (if (nth 3 var) (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))))) + (t (unless (and (save-excursion (goto-char (point-min)) - (let ((case-fold-search t)) - (looking-at "Watch Expressions:"))))) - (erase-buffer) - (insert "Watch Expressions:\n") - (let ((var-list gdb-var-list)) - (while var-list - (let* ((depth 0) (start 0) (char ?+) - (var (car var-list)) (varnum (nth 1 var))) - (while (string-match "\\." varnum start) - (setq depth (1+ depth) - start (1+ (match-beginning 0)))) - (if (or (equal (nth 2 var) "0") - (and (equal (nth 2 var) "1") - (string-match "char \\*" (nth 3 var)))) - (speedbar-make-tag-line 'bracket ?? nil nil - (concat (car var) "\t" (nth 4 var)) - 'gdb-edit-value - nil - (if (and (nth 5 var) - gdb-show-changed-values) - 'font-lock-warning-face - nil) depth) - (if (and (cadr var-list) - (string-match varnum (cadr (cadr var-list)))) - (setq char ?-)) - (speedbar-make-tag-line 'bracket char - 'gdb-speedbar-expand-node varnum - (concat (car var) "\t" (nth 3 var)) - nil nil nil depth))) - (setq var-list (cdr var-list)))) - (setq gdb-var-changed nil))) - (t (if (and (save-excursion - (goto-char (point-min)) - (looking-at "Current Stack:")) - (equal gud-last-last-frame gud-last-speedbar-stackframe)) - nil + (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)) @@ -486,6 +582,7 @@ required by the caller." (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)))) @@ -540,6 +637,11 @@ required by the caller." ;; 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)) @@ -553,6 +655,8 @@ required by the caller." ;; 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 @@ -560,7 +664,7 @@ required by the caller." ;; 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 + ;; 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 "\n\\(\032.*\\)?\\'" gud-marker-acc) @@ -611,10 +715,27 @@ required by the caller." ;;;###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, replace the GDB \"--annotate=3\" +option with \"--fullname\" either in the minibuffer for the +current Emacs session, or the custom variable +`gud-gdb-command-name' for all future sessions. You need to use +text command mode to debug multiple programs within one Emacs +session." (interactive (list (gud-query-cmdline 'gdb))) + (when (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))) + (gdb-restore-windows) + (error + "Multiple debugging requires restarting in text command mode")) + (gud-common-init command-line nil 'gud-gdb-marker-filter) (set (make-local-variable 'gud-minor-mode) 'gdb) @@ -639,7 +760,6 @@ and source-file directory for your debugger." "Evaluate C dereferenced pointer expression at point.") ;; For debugging Emacs only. - (gud-def gud-pp "pp1 %e" nil "Print the emacs s-expression.") (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.") @@ -668,16 +788,18 @@ and source-file directory for your debugger." ;; 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)))) @@ -796,13 +918,14 @@ It is passed through FILTER before we look at it." (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. @@ -811,12 +934,13 @@ SKIP is the number of chars to skip on each lines, it defaults to 0." (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))))) @@ -1379,7 +1503,7 @@ into one that invokes an Emacs-enabled debugging session. ;; 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 + ;; 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) @@ -1440,7 +1564,7 @@ and source-file directory for your debugger." ;; Last group is for return value, e.g. "> test.py(2)foo()->None" ;; Either file or function name may be omitted: "> (0)?()" (defvar gud-pdb-marker-regexp - "^> \\([-a-zA-Z0-9_/.:\\]*\\|\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\)()\\(->[^\n]*\\)?\n") + "^> \\([-a-zA-Z0-9_/.:\\]*\\|\\)(\\([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) @@ -1484,7 +1608,7 @@ and source-file directory for your debugger." ;; 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 + ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match gud-pdb-marker-regexp-start gud-marker-acc) @@ -1783,7 +1907,7 @@ extension EXTN. Normally EXTN is given as the regular expression (forward-char)) (forward-char)) -;; Move point past the following block. There may be (legal) cruft before +;; Move point past the following block. There may be (legal) cruft before ;; the block's opening brace. There must be a block or it's the end of life ;; in petticoat junction. (defun gud-jdb-skip-block () @@ -1971,7 +2095,7 @@ extension EXTN. Normally EXTN is given as the regular expression 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 asssociation gives the fully ;; qualified file name of the source file which produced the class. (defun gud-jdb-find-source-file (p) (cdr (assoc p gud-jdb-class-source-alist))) @@ -2083,7 +2207,7 @@ nil) ;; 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$_<>(),]+ \ + "\\(\\[[0-9]+] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \ \\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9.,]+\\)" gud-marker-acc) @@ -2139,7 +2263,7 @@ nil) (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-*\" if there is. If the \"-classpath\" +\"*gud-*\" if there is. If the \"-classpath\" switch is given, omit all whitespace between it and its value. See `gud-jdb-use-classpath' and `gud-jdb-classpath' documentation for @@ -2185,6 +2309,8 @@ gud, see `gud-mode'." (gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.") (gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.") (gud-def gud-run "run" nil "Run the program.") ;if VM start using jdb + (gud-def gud-print "print %e" "\C-p" "Evaluate Java expression at point.") + (setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") (setq paragraph-start comint-prompt-regexp) @@ -2206,127 +2332,6 @@ gud, see `gud-mode'." (gud-jdb-build-source-files-list gud-jdb-directories "\\.java$")))) (fset 'gud-jdb-find-source 'gud-jdb-find-source-file))) - - -;; ====================================================================== -;; -;; BASHDB support. See http://bashdb.sourceforge.net -;; -;; AUTHOR: Rocky Bernstein -;; -;; CREATED: Sun Nov 10 10:46:38 2002 Rocky Bernstein. -;; -;; INVOCATION NOTES: -;; -;; You invoke bashdb-mode with: -;; -;; M-x bashdb -;; -;; It responds with: -;; -;; Run bashdb (like this): bash -;; - -;; History of argument lists passed to bashdb. -(defvar gud-bashdb-history nil) - -;; Convert a command line as would be typed normally to run a script -;; into one that invokes an Emacs-enabled debugging session. -;; "--debugger" in inserted as the first switch. - -;; There's no guarantee that Emacs will hand the filter the entire -;; marker at once; it could be broken up across several strings. We -;; might even receive a big chunk with several markers in it. If we -;; receive a chunk of text which looks like it might contain the -;; beginning of a marker, we save it here between calls to the -;; filter. -(defun gud-bashdb-marker-filter (string) - (setq gud-marker-acc (concat gud-marker-acc string)) - (let ((output "")) - - ;; Process all the complete markers in this chunk. - ;; Format of line looks like this: - ;; (/etc/init.d/ntp.init:16): - ;; but we also allow DOS drive letters - ;; (d:/etc/init.d/ntp.init:16): - (while (string-match "\\(^\\|\n\\)(\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\)):.*\n" - gud-marker-acc) - (setq - - ;; Extract the frame position from the marker. - gud-last-frame - (cons (match-string 2 gud-marker-acc) - (string-to-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. - output (concat output - (substring gud-marker-acc 0 (match-beginning 0))) - - ;; Set the accumulator to the remaining text. - gud-marker-acc (substring gud-marker-acc (match-end 0)))) - - ;; Does the remaining text look like it might end with the - ;; beginning of another marker? If it does, then keep it in - ;; gud-marker-acc until we receive the rest of it. Since we - ;; know the full marker regexp above failed, it's pretty simple to - ;; test for marker starts. - (if (string-match "\032.*\\'" gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output (concat output (substring gud-marker-acc - 0 (match-beginning 0)))) - - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc - (substring gud-marker-acc (match-beginning 0)))) - - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - - output)) - -(defcustom gud-bashdb-command-name "bash --debugger" - "File name for executing bash debugger." - :type 'string - :group 'gud) - -;;;###autoload -(defun bashdb (command-line) - "Run bashdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger." - (interactive - (list (read-from-minibuffer "Run bashdb (like this): " - (if (consp gud-bashdb-history) - (car gud-bashdb-history) - (concat gud-bashdb-command-name - " ")) - gud-minibuffer-local-map nil - '(gud-bashdb-history . 1)))) - - (gud-common-init command-line nil 'gud-bashdb-marker-filter) - - (set (make-local-variable 'gud-minor-mode) 'bashdb) - - (gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "tbreak %l" "\C-t" "Set temporary breakpoint at current line.") - (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step" "\C-s" "Step one source line with display.") - (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") - (gud-def gud-cont "continue" "\C-r" "Continue with display.") - (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") - (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") - (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "x %e" "\C-p" "Evaluate BASH expression at point.") - - ;; Is this right? - (gud-def gud-statement "eval %e" "\C-e" "Execute BASH statement at point.") - - (setq comint-prompt-regexp "^bashdb<+(*[0-9]+)*>+ ") - (setq paragraph-start comint-prompt-regexp) - (run-hooks 'bashdb-mode-hook) - ) ;; ;; End of debugger-specific information @@ -2462,7 +2467,7 @@ comint mode, which see." ;; for local variables in the debugger buffer. (defun gud-common-init (command-line massage-args marker-filter &optional find-file) - (let* ((words (split-string command-line)) + (let* ((words (split-string-and-unquote command-line)) (program (car words)) (dir default-directory) ;; Extract the file name from WORDS @@ -2490,7 +2495,7 @@ comint mode, which see." (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. @@ -2510,7 +2515,10 @@ comint mode, which see." (while (and w (not (eq (car w) t))) (setq w (cdr w))) (if w - (setcar w file))) + (setcar w + (if (file-remote-p default-directory) + (setq file (file-name-nondirectory file)) + file)))) (apply 'make-comint (concat "gud" filepart) program nil (if massage-args (funcall massage-args file args) args)) ;; Since comint clobbered the mode, we don't set it until now. @@ -2618,10 +2626,10 @@ It is saved for when this flag is not set.") ((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 @@ -2684,7 +2692,10 @@ Obeying it means displaying in another window the specified file and line." (with-current-buffer gud-comint-buffer (gud-find-file true-file))) (window (and buffer (or (get-buffer-window buffer) - (display-buffer buffer)))) + (if (memq gud-minor-mode '(gdbmi gdba)) + (unless (gdb-display-source-buffer buffer) + (gdb-display-buffer buffer nil))) + (display-buffer buffer)))) (pos)) (if buffer (progn @@ -2701,11 +2712,22 @@ Obeying it means displaying in another window the specified file and line." (setq pos (point)) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) - (set-marker gud-overlay-arrow-position (point) (current-buffer))) + (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 gud-overlay-arrow-position)))))) + (when window + (set-window-point window gud-overlay-arrow-position) + (if (memq gud-minor-mode '(gdbmi gdba)) + (setq gdb-source-window window))))))) ;; The gud-call function must do the right thing whether its invoking ;; keystroke is from the GUD buffer itself (via major-mode binding) @@ -2716,7 +2738,9 @@ Obeying it means displaying in another window the specified file and line." (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 @@ -2801,8 +2825,11 @@ Obeying it means displaying in another window the specified file and line." (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)) @@ -2823,7 +2850,23 @@ Obeying it means displaying in another window the specified file and line." (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)) + (unless (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'jdb) + (insert (concat expr " = ")))))) + expr)) ;; The next eight functions are hacked from gdbsrc.el by ;; Debby Ayers , @@ -3062,12 +3105,27 @@ class of the file (using s to separate nested class ids)." (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\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) (defvar gdb-script-font-lock-syntactic-keywords '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ;; It would be best to change the \n in front, but it's more difficult. - ("^en\\(d\\)\\>" (1 "> b")))) + ("^end\\>" + (0 (unless (eq (match-beginning 0) (point-min)) + ;; We change the \n in front, which is more difficult, but results + ;; in better highlighting. If the doc is empty, the single \n is + ;; both the beginning and the end of the docstring, which can't be + ;; expressed in syntax-tables. Instead, we place the "> b" after + ;; placing the "< b", so the start marker is overwritten by the + ;; termination marker and in the end Emacs simply considers that + ;; there's no docstring at all, which is fine. + (put-text-property (1- (match-beginning 0)) (match-beginning 0) + 'syntax-table (eval-when-compile + (string-to-syntax "> b"))) + ;; Make sure that rehighlighting the previous line won't erase our + ;; syntax-table property. + (put-text-property (1- (match-beginning 0)) (match-end 0) + 'font-lock-multiline t) + nil))))) (defun gdb-script-font-lock-syntactic-face (state) (cond @@ -3079,7 +3137,7 @@ class of the file (using s to separate nested class ids)." (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))) @@ -3098,7 +3156,7 @@ class of the file (using s to separate nested class ids)." (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 () @@ -3143,8 +3201,12 @@ Treats actions as defuns." (goto-char (point-max))) t) +;; Besides .gdbinit, gdb documents other names to be usable for init +;; files, cross-debuggers can use something like +;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files +;; don't interfere with each other. ;;;###autoload -(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode)) +(add-to-list 'auto-mode-alist '("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)) ;;;###autoload (define-derived-mode gdb-script-mode nil "GDB-Script" @@ -3170,10 +3232,48 @@ Treats actions as defuns." ;;; tooltips for GUD ;;; Customizable settings -(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode) - "List of modes for which to enable GUD tips." + +(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 + python-mode) + "List of modes for which to enable GUD tooltips." :type 'sexp - :tag "GUD modes" + :group 'gud :group 'tooltip) (defcustom gud-tooltip-display @@ -3184,13 +3284,13 @@ Treats actions as defuns." Forms in the list are combined with AND. The default is to display only tooltips in the buffer containing the overlay arrow." :type 'sexp - :tag "GUD buffers predicate" + :group 'gud :group 'tooltip) (defcustom gud-tooltip-echo-area nil "Use the echo area instead of frames for GUD tooltips." :type 'boolean - :tag "Use echo area" + :group 'gud :group 'tooltip) (define-obsolete-variable-alias 'tooltip-gud-modes @@ -3219,6 +3319,12 @@ only tooltips in the buffer containing the overlay arrow." (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." @@ -3253,53 +3359,19 @@ For C this would dereference a pointer expression.") "The mouse movement event that led to a tooltip display. This event can be examined by forms in GUD-TOOLTIP-DISPLAY.") -(defun toggle-gud-tooltip-dereference () - "Toggle whether tooltips should show `* expr' or `expr'." - (interactive) - (setq gud-tooltip-dereference (not gud-tooltip-dereference)) - (when (interactive-p) - (message "Dereferencing is now %s." - (if gud-tooltip-dereference "on" "off")))) +(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." + (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 - 'toggle-gud-tooltip-dereference "22.1") - -;;;###autoload -(define-minor-mode gud-tooltip-mode - "Toggle the display of GUD tooltips." - :global t - :group 'gud - (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 kille - (with-current-buffer gud-comint-buffer - (memq gud-minor-mode '(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)))) + 'gud-tooltip-dereference "22.1") ; This will only display data that comes in one chunk. ; Larger arrays (say 400 elements) are displayed in @@ -3314,16 +3386,12 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.") (or gud-tooltip-echo-area tooltip-use-echo-area))) (defun gud-tooltip-print-command (expr) - "Return a suitable command to print the expression EXPR. -If GUD-TOOLTIP-DEREFERENCE is t, also prepend a `*' to EXPR." - (when gud-tooltip-dereference - (setq expr (concat "*" 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))) + ((xdb pdb) (concat "p " expr)) + (sdb (concat expr "/")))) (defun gud-tooltip-tips (event) "Show tip for identifier or selection under the mouse. @@ -3337,9 +3405,8 @@ This function must return nil if it doesn't handle EVENT." (let (process) (when (and (eventp event) gud-tooltip-mode - (boundp 'gud-comint-buffer) gud-comint-buffer - (buffer-name gud-comint-buffer); gud-comint-buffer might be killed + (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)) @@ -3360,6 +3427,8 @@ This function must return nil if it doesn't handle EVENT." (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) @@ -3373,7 +3442,8 @@ so they have been disabled.")) 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))