X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab1dc14b220747e527d507d40905a24ba5c692d9..974ebc9ccfaafea7cda98d6a4bb4f63d1fa303fb:/lisp/progmodes/gud.el diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 2e3858b2cc..4097a9cd97 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1,6 +1,6 @@ ;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -;; Copyright (C) 1992-1996, 1998, 2000-2012 Free Software Foundation, Inc. +;; Copyright (C) 1992-1996, 1998, 2000-2013 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: FSF @@ -45,11 +45,8 @@ (defvar gdb-show-changed-values) (defvar gdb-source-window) (defvar gdb-var-list) -(defvar gdb-speedbar-auto-raise) -(defvar gud-tooltip-mode) (defvar hl-line-mode) (defvar hl-line-sticky-flag) -(defvar tool-bar-map) ;; ====================================================================== @@ -69,7 +66,7 @@ pdb (Python), and jdb." :group 'gud) (global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh) -(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack +;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack (defvar gud-marker-filter nil) (put 'gud-marker-filter 'permanent-local t) @@ -148,7 +145,8 @@ Used to gray out relevant toolbar icons.") ([run] menu-item "Run" gud-run :enable (not gud-running) :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) - ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go + ([go] menu-item (if (bound-and-true-p gdb-active-process) + "Continue" "Run") gud-go :visible (and (eq gud-minor-mode 'gdbmi) (gdb-show-run-p))) ([stop] menu-item "Stop" gud-stop-subjob @@ -178,7 +176,7 @@ Used to gray out relevant toolbar icons.") '(gdbmi gdb dbx xdb jdb pdb))) ([pp] menu-item "Print S-expression" gud-pp :enable (and (not gud-running) - gdb-active-process) + (bound-and-true-p gdb-active-process)) :visible (and (string-equal (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs") @@ -322,8 +320,9 @@ Uses `gud--directories' to find the source files." (when buf ;; Copy `gud-minor-mode' to the found buffer to turn on the menu. (with-current-buffer buf - (set (make-local-variable 'gud-minor-mode) minor-mode) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (setq-local gud-minor-mode minor-mode) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map gud-tool-bar-map)) (when (and gud-tooltip-mode (eq gud-minor-mode 'gdbmi)) (make-local-variable 'gdb-define-alist) @@ -414,7 +413,7 @@ we're in the GUD buffer)." ;; ====================================================================== ;; speedbar support functions and variables. -(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer. +(eval-when-compile (require 'dframe)) ; for dframe-with-attached-buffer (defvar gud-last-speedbar-stackframe nil "Description of the currently displayed GUD stack. @@ -423,19 +422,24 @@ The value 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.") +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-message "dframe" (fmt &rest args)) + (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 7 var) - (speedbar-message "%s: %s" (nth 7 var) (nth 3 var)) - (speedbar-message "%s" (nth 3 var))))) + (dframe-message "%s: %s" (nth 7 var) (nth 3 var)) + (dframe-message "%s" (nth 3 var))))) + +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(defvar speedbar-mode-functions-list) (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb." - (if gud-speedbar-key-map - nil + (unless gud-speedbar-key-map (setq gud-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key gud-speedbar-key-map "j" 'speedbar-edit-line) (define-key gud-speedbar-key-map "e" 'speedbar-edit-line) (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line) @@ -484,6 +488,13 @@ The value t means that there is no stack, and we are in display-file mode.") DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) +(declare-function speedbar-remove-localized-speedbar-support "speedbar" + (buffer)) +(declare-function speedbar-insert-button "speedbar" + (text face mouse function &optional token prevline)) + (defun gud-speedbar-buttons (buffer) "Create a speedbar display based on the current state of GUD. If the GUD BUFFER is not running a supported debugger, then turn @@ -705,6 +716,16 @@ The option \"--fullname\" must be included in this value." (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") +;; One of the nice features of GDB is its impressive support for +;; context-sensitive command completion. We preserve that feature +;; in the GUD buffer by using a GDB command designed just for Emacs. + +(defvar gud-gdb-completion-function nil + "Completion function for GDB commands. +It receives two arguments: COMMAND, the prefix for which we seek +completion; and CONTEXT, the text before COMMAND on the line. +It should return a list of completion strings.") + ;; If in gdb mode, gdb-mi is loaded. (declare-function gdb-restore-windows "gdb-mi" ()) @@ -765,16 +786,6 @@ directory and source-file directory for your debugger." (setq gud-filter-pending-text nil) (run-hooks 'gud-gdb-mode-hook)) -;; One of the nice features of GDB is its impressive support for -;; context-sensitive command completion. We preserve that feature -;; in the GUD buffer by using a GDB command designed just for Emacs. - -(defvar gud-gdb-completion-function nil - "Completion function for GDB commands. -It receives two arguments: COMMAND, the prefix for which we seek -completion; and CONTEXT, the text before COMMAND on the line. -It should return a list of completion strings.") - ;; The completion process filter indicates when it is finished. (defvar gud-gdb-fetch-lines-in-progress) @@ -882,9 +893,14 @@ It is passed through `gud-gdb-marker-filter' before we look at it." ;; gdb speedbar functions +;; Part of the macro expansion of dframe-with-attached-buffer. +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-select-attached-frame "dframe" (&optional frame)) +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) (sit-for 1))) @@ -1485,14 +1501,38 @@ into one that invokes an Emacs-enabled debugging session. (let ((output "")) ;; Process all the complete markers in this chunk. - (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc) + ;; + ;; Here I match the string coming out of perldb. + ;; The strings can look like any of + ;; + ;; "\032\032/tmp/tst.pl:6:0\n" + ;; "\032\032(eval 5)[/tmp/tst.pl:6]:3:0\n" + ;; "\032\032(eval 17)[Basic/Core/Core.pm.PL (i.e. PDL::Core.pm):2931]:1:0\n" + ;; + ;; From those I want the filename and the line number. First I look for + ;; the eval case. If that doesn't match, I look for the "normal" case. + (while + (string-match + (eval-when-compile + (let ((file-re "\\(?:[a-zA-Z]:\\)?[^:\n]*")) + (concat "\032\032\\(?:" + (concat + "(eval [0-9]+)\\[" + "\\(" file-re "\\)" ; Filename. + "\\(?: (i\\.e\\. [^)]*)\\)?" + ":\\([0-9]*\\)\\]") ; Line number. + "\\|" + (concat + "\\(?1:" file-re "\\)" ; Filename. + ":\\(?2:[0-9]*\\)") ; Line number. + "\\):.*\n"))) + gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (match-string 1 gud-marker-acc) - (string-to-number (match-string 3 gud-marker-acc))) + (string-to-number (match-string 2 gud-marker-acc))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. @@ -2119,10 +2159,8 @@ relative to a classpath directory." (split-string ;; Eliminate any subclass references in the class ;; name string. These start with a "$" - ((lambda (x) - (if (string-match "$.*" x) - (replace-match "" t t x) p)) - p) + (if (string-match "$.*" p) + (replace-match "" t t p) p) "\\.") "/") ".java")) (cplist (append gud-jdb-sourcepath gud-jdb-classpath)) @@ -2442,7 +2480,8 @@ comint mode, which see." (setq mode-line-process '(":%s")) (define-key (current-local-map) "\C-c\C-l" 'gud-refresh) (set (make-local-variable 'gud-last-frame) nil) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map gud-tool-bar-map)) (make-local-variable 'comint-prompt-regexp) ;; Don't put repeated commands in command history many times. (set (make-local-variable 'comint-input-ignoredups) t) @@ -2610,6 +2649,8 @@ It is saved for when this flag is not set.") (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) (declare-function gdb-reset "gdb-mi" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new)) +(defvar speedbar-previously-used-expansion-list-name) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) @@ -2617,7 +2658,7 @@ It is saved for when this flag is not set.") ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) (set-process-buffer proc nil) - (if (and (boundp 'speedbar-frame) + (if (and (boundp 'speedbar-initial-expansion-list-name) (string-equal speedbar-initial-expansion-list-name "GUD")) (speedbar-change-initial-expansion-list speedbar-previously-used-expansion-list-name)) @@ -2700,42 +2741,39 @@ 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 (eq gud-minor-mode 'gdbmi) - (display-buffer buffer nil 'visible)) (display-buffer buffer)))) (pos)) - (if buffer - (progn - (with-current-buffer buffer - (unless (or (verify-visited-file-modtime buffer) gud-keep-buffer) - (if (yes-or-no-p - (format "File %s changed on disk. Reread from disk? " - (buffer-name))) - (revert-buffer t t) - (setq gud-keep-buffer t))) - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- 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)) - ;; 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)))) - (when window - (set-window-point window gud-overlay-arrow-position) - (if (eq gud-minor-mode 'gdbmi) - (setq gdb-source-window window))))))) + (when buffer + (with-current-buffer buffer + (unless (or (verify-visited-file-modtime buffer) gud-keep-buffer) + (if (yes-or-no-p + (format "File %s changed on disk. Reread from disk? " + (buffer-name))) + (revert-buffer t t) + (setq gud-keep-buffer t))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- 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)) + ;; 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)))) + (when window + (set-window-point window gud-overlay-arrow-position) + (if (eq gud-minor-mode 'gdbmi) + (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) @@ -3243,6 +3281,8 @@ Treats actions as defuns." ;;; Customizable settings +(defvar tooltip-mode) + ;;;###autoload (define-minor-mode gud-tooltip-mode "Toggle the display of GUD tooltips. @@ -3313,6 +3353,9 @@ only tooltips in the buffer containing the overlay arrow." :group 'gud :group 'tooltip) +(make-obsolete-variable 'gud-tooltip-echo-area + "disable Tooltip mode instead" "24.4" 'set) + ;;; Reacting on mouse movements (defun gud-tooltip-change-major-mode () @@ -3364,9 +3407,6 @@ ACTIVATEP non-nil means activate mouse motion events." ;;; Tips for `gud' -(defvar gud-tooltip-original-filter nil - "Process filter to restore after GUD output has been received.") - (defvar gud-tooltip-dereference nil "Non-nil means print expressions with a `*' in front of them. For C this would dereference a pointer expression.") @@ -3397,12 +3437,13 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ; the tooltip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and ; it may be difficult to do better. Using GDB/MI as in -; gdb-mi.el gets round this problem. +; gdb-mi.el gets around this problem. (defun gud-tooltip-process-output (process output) "Process debugger output and show it in a tooltip window." - (set-process-filter process gud-tooltip-original-filter) + (remove-function (process-filter process) #'gud-tooltip-process-output) (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area tooltip-use-echo-area))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode)))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." @@ -3412,7 +3453,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ((or `xdb `pdb) (concat "p " expr)) (`sdb (concat expr "/")))) -(declare-function gdb-input "gdb-mi" (command handler)) +(declare-function gdb-input "gdb-mi" (command handler &optional trigger)) (declare-function tooltip-expr-to-print "tooltip" (event)) (declare-function tooltip-event-buffer "tooltip" (event)) @@ -3445,7 +3486,8 @@ This function must return nil if it doesn't handle EVENT." (unless (null define-elt) (tooltip-show (cdr define-elt) - (or gud-tooltip-echo-area tooltip-use-echo-area)) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode))) expr)))) (when gud-tooltip-dereference (setq expr (concat "*" expr))) @@ -3467,8 +3509,8 @@ so they have been disabled.")) (gdb-input (concat cmd "\n") `(lambda () (gdb-tooltip-print ,expr)))) - (setq gud-tooltip-original-filter (process-filter process)) - (set-process-filter process 'gud-tooltip-process-output) + (add-function :override (process-filter process) + #'gud-tooltip-process-output) (gud-basic-call cmd)) expr))))))))