X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b33c71f58623306001d4d4fe4f7354d8c360edaa..88f43129a846b261d4144956bcce59d73e75318b:/lisp/progmodes/gud.el diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 1549150dfa..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, 2006 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, @@ -49,7 +49,6 @@ (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) @@ -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) @@ -102,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 () @@ -131,10 +130,10 @@ Used to grey out relevant togolbar icons.") (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) @@ -142,40 +141,42 @@ Used to grey out relevant togolbar icons.") :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" gud-stop-subjob - :visible (or (not (eq gud-minor-mode 'gdba)) + :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)))) + :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) @@ -184,23 +185,23 @@ Used to grey out relevant togolbar icons.") '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))) ([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 @@ -212,7 +213,45 @@ Used to grey out relevant togolbar icons.") :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))) @@ -253,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)) @@ -303,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 @@ -390,8 +436,6 @@ 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 "p" 'gud-pp)) @@ -440,38 +484,55 @@ required by the caller." (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)) - (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))) + (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 ?? 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 @@ -482,37 +543,15 @@ required by the caller." (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))) + (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:")) @@ -543,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)))) @@ -624,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) @@ -680,15 +720,21 @@ 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." +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))) - (if (and gud-comint-buffer + (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))) - (error "Multiple debugging is only supported with \"gdb --fullname\"")) + (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) @@ -1457,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) @@ -1518,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) @@ -1562,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) @@ -1861,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 () @@ -2049,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))) @@ -2217,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 @@ -2263,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) @@ -2284,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 @@ -2540,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 @@ -2568,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. @@ -2588,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. @@ -2696,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 @@ -2763,7 +2693,8 @@ Obeying it means displaying in another window the specified file and line." (gud-find-file true-file))) (window (and buffer (or (get-buffer-window buffer) (if (memq gud-minor-mode '(gdbmi gdba)) - (gdb-display-source-buffer buffer)) + (unless (gdb-display-source-buffer buffer) + (gdb-display-buffer buffer nil))) (display-buffer buffer)))) (pos)) (if buffer @@ -2793,7 +2724,10 @@ Obeying it means displaying in another window the specified file and line." (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) @@ -2804,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 @@ -2927,7 +2863,9 @@ Obeying it means displaying in another window the specified file and line." (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 " = "))))) + (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 @@ -3167,14 +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-*\\(\\(\\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). (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 @@ -3250,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" @@ -3314,7 +3269,8 @@ Treats actions as defuns." (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 @@ -3363,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." @@ -3399,7 +3361,7 @@ 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." +With arg, dereference expr if ARG is positive, otherwise do not derereference." (interactive "P") (setq gud-tooltip-dereference (if (null arg) @@ -3428,9 +3390,8 @@ With arg, dereference expr iff arg is positive." (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. @@ -3481,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))