X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1099930585662f32278796f9943ac8b50a1179f1..a64bfdfa5a90731b804c057f2bcc74a8ba02937c:/lisp/progmodes/gud.el diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d20a14682c..7b3a289361 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1,7 +1,6 @@ ;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992-1996, 1998, 2000-2011 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: FSF @@ -113,20 +112,9 @@ Used to grey out relevant toolbar icons.") (defun gud-goto-info () "Go to relevant Emacs info node." (interactive) - (let ((same-window-regexps same-window-regexps) - (display-buffer-reuse-frames t)) - (catch 'info-found - (walk-windows - '(lambda (window) - (if (eq (window-buffer window) (get-buffer "*info*")) - (progn - (setq same-window-regexps nil) - (throw 'info-found nil)))) - nil 0) - (select-frame (make-frame))) - (if (eq gud-minor-mode 'gdbmi) - (info "(emacs)GDB Graphical Interface") - (info "(emacs)Debuggers")))) + (if (eq gud-minor-mode 'gdbmi) + (info-other-window "(emacs)GDB Graphical Interface") + (info-other-window "(emacs)Debuggers"))) (defun gud-tool-bar-item-visible-no-fringe () (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) @@ -380,13 +368,13 @@ step (if we're in the GUD buffer). source file) or the source line number at the last break or step (if we're in the GUD buffer)." `(progn - (defun ,func (arg) + (defalias ',func (lambda (arg) ,@(if doc (list doc)) (interactive "p") (if (not gud-running) ,(if (stringp cmd) `(gud-call ,cmd arg) - cmd))) + cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) @@ -492,7 +480,7 @@ The value t means that there is no stack, and we are in display-file mode.") (gud-install-speedbar-variables) (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) -(defun gud-expansion-speedbar-buttons (directory zero) +(defun gud-expansion-speedbar-buttons (_directory _zero) "Wrapper for call to `speedbar-add-expansion-list'. DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) @@ -658,17 +646,15 @@ The option \"--fullname\" must be included in this value." gud-marker-acc (substring gud-marker-acc (match-end 0)))) (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((match (match-string 1 gud-marker-acc))) - - (setq - ;; Append any text before the marker to the output we're going - ;; to return - we don't include the marker in this text. - output (concat output - (substring gud-marker-acc 0 (match-beginning 0))) + (setq + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-marker-acc 0 (match-beginning 0))) - ;; Set the accumulator to the remaining text. + ;; Set the accumulator to the remaining text. - gud-marker-acc (substring gud-marker-acc (match-end 0))))) + 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 @@ -768,7 +754,9 @@ directory and source-file directory for your debugger." (gud-def gud-until "until %l" "\C-u" "Continue to current line.") (gud-def gud-run "run" nil "Run the program.") - (local-set-key "\C-i" 'gud-gdb-complete-command) + (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point + nil 'local) + (local-set-key "\C-i" 'completion-at-point) (setq comint-prompt-regexp "^(.*gdb[+]?) *") (setq paragraph-start comint-prompt-regexp) (setq gdb-first-prompt t) @@ -792,26 +780,28 @@ directory and source-file directory for your debugger." ;; The completion list is constructed by the process filter. (defvar gud-gdb-fetched-lines) -(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) - (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)))) - (complete-list - (gud-gdb-run-command-fetch-lines (concat "complete " command) +(defun gud-gdb-completions (context command) + "Completion table for GDB commands. +COMMAND is the prefix for which we seek completion. +CONTEXT is the text before COMMAND on the line." + (let* ((start (- (point) (field-beginning))) + (complete-list + (gud-gdb-run-command-fetch-lines (concat "complete " context command) (current-buffer) ;; From string-match above. - (match-beginning 2)))) + (length context)))) + ;; `gud-gdb-run-command-fetch-lines' has some nasty side-effects on the + ;; buffer (via `gud-delete-prompt-marker'): it removes the prompt and then + ;; re-adds it later, thus messing up markers and overlays along the way. + ;; This is a problem for completion-in-region which uses an overlay to + ;; create a field. + ;; So we restore completion-in-region's field if needed. + ;; FIXME: change gud-gdb-run-command-fetch-lines so it doesn't modify the + ;; buffer at all. + (when (/= start (- (point) (field-beginning))) + (dolist (ol (overlays-at (1- (point)))) + (when (eq (overlay-get ol 'field) 'completion) + (move-overlay ol (- (point) start) (overlay-end ol))))) ;; Protect against old versions of GDB. (and complete-list (string-match "^Undefined command: \"complete\"" (car complete-list)) @@ -837,8 +827,27 @@ available with older versions of GDB." pos (match-end 0))) (and (= (mod count 2) 1) (setq complete-list (list (concat str "'")))))) - ;; Let comint handle the rest. - (comint-dynamic-simple-complete command-word complete-list))) + complete-list)) + +(defun gud-gdb-completion-at-point () + "Return the data to complete the GDB command before point." + (let ((end (point)) + (start + (save-excursion + (skip-chars-backward "^ " (comint-line-beginning-position)) + (point)))) + (list start end + (completion-table-dynamic + (apply-partially #'gud-gdb-completions + (buffer-substring (comint-line-beginning-position) + start)))))) + +;; (defun gud-gdb-complete-command () +;; "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) +;; (apply #'completion-in-region (gud-gdb-completion-at-point))) ;; The completion process filter is installed temporarily to slurp the ;; output of GDB up to the next prompt and build the completion list. @@ -862,7 +871,7 @@ It is passed through FILTER before we look at it." ;; gdb speedbar functions -(defun gud-gdb-goto-stackframe (text token indent) +(defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." (speedbar-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) @@ -1052,7 +1061,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-dbx-massage-args (file args) +(defun gud-dbx-massage-args (_file args) (nconc (let ((directories gud-dbx-directories) (result nil)) (while directories @@ -1364,7 +1373,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-xdb-massage-args (file args) +(defun gud-xdb-massage-args (_file args) (nconc (let ((directories gud-xdb-directories) (result nil)) (while directories @@ -1428,7 +1437,7 @@ directories if your program contains sources from more than one directory." ;; History of argument lists passed to perldb. (defvar gud-perldb-history nil) -(defun gud-perldb-massage-args (file args) +(defun gud-perldb-massage-args (_file args) "Convert a command line as would be typed normally to run perldb into one that invokes an Emacs-enabled debugging session. \"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." @@ -1561,7 +1570,8 @@ 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\r]*\\)?[\n\r]") + (defvar gud-pdb-marker-regexp-file-group 1) (defvar gud-pdb-marker-regexp-line-group 2) (defvar gud-pdb-marker-regexp-fnname-group 3) @@ -2050,7 +2060,7 @@ extension EXTN. Normally EXTN is given as the regular expression ;; Change what was given in the minibuffer to something that can be used to ;; invoke the debugger. -(defun gud-jdb-massage-args (file args) +(defun gud-jdb-massage-args (_file args) ;; The jdb executable must have whitespace between "-classpath" and ;; its value while gud-common-init expects all switch values to ;; follow the switch keyword without intervening whitespace. We @@ -2129,7 +2139,7 @@ relative to a classpath directory." (setq cplist (cdr cplist))) (if found-file (concat (car cplist) "/" filename))))) -(defun gud-jdb-find-source (string) +(defun gud-jdb-find-source (_string) "Alias for function used to locate source files. Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file' during jdb initialization depending on the value of @@ -2445,10 +2455,6 @@ comint mode, which see." (set (make-local-variable 'gud-delete-prompt-marker) (make-marker)) (add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t)) -;; Cause our buffers to be displayed, by default, -;; in the selected window. -;;;###autoload (add-hook 'same-window-regexps (purecopy "\\*gud-.*\\*\\(\\|<[0-9]+>\\)")) - (defcustom gud-chdir-before-run t "Non-nil if GUD should `cd' to the debugged executable." :group 'gud @@ -2490,7 +2496,7 @@ comint mode, which see." file-subst))) (filepart (and file-word (concat "-" (file-name-nondirectory file)))) (existing-buffer (get-buffer (concat "*gud" filepart "*")))) - (pop-to-buffer (concat "*gud" filepart "*")) + (switch-to-buffer (concat "*gud" filepart "*")) (when (and existing-buffer (get-buffer-process existing-buffer)) (error "This program is already being debugged")) ;; Set the dir, in case the buffer already existed with a different dir. @@ -2533,7 +2539,7 @@ comint mode, which see." (gud-set-buffer)) (defun gud-set-buffer () - (when (eq major-mode 'gud-mode) + (when (derived-mode-p 'gud-mode) (setq gud-comint-buffer (current-buffer)))) (defvar gud-filter-defer-flag nil @@ -3022,10 +3028,8 @@ Link exprs of the form: (declare-function c-langelem-sym "cc-defs" (langelem)) (declare-function c-langelem-pos "cc-defs" (langelem)) -(declare-function syntax-symbol "gud" (x)) -(declare-function syntax-point "gud" (x)) -(defun gud-find-class (f line) +(defun gud-find-class (f _line) "Find fully qualified class in file F at line LINE. This function uses the `gud-jdb-classpath' (and optional `gud-jdb-sourcepath') list(s) to derive a file @@ -3041,13 +3045,13 @@ class of the file (using s to separate nested class ids)." (save-match-data (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) (fbuffer (get-file-buffer f)) - syntax-symbol syntax-point class-found) + class-found + ;; Syntax-symbol returns the symbol of the *first* element + ;; in the syntactical analysis result list, syntax-point + ;; returns the buffer position of same + (syntax-symbol (lambda (x) (c-langelem-sym (car x)))) + (syntax-point (lambda (x) (c-langelem-pos (car x))))) (setq f (file-name-sans-extension (file-truename f))) - ;; Syntax-symbol returns the symbol of the *first* element - ;; in the syntactical analysis result list, syntax-point - ;; returns the buffer position of same - (fset 'syntax-symbol (lambda (x) (c-langelem-sym (car x)))) - (fset 'syntax-point (lambda (x) (c-langelem-pos (car x)))) ;; Search through classpath list for an entry that is ;; contained in f (while (and cplist (not class-found)) @@ -3062,6 +3066,7 @@ class of the file (using s to separate nested class ids)." ;; syntactic information chain and collect any 'inclass ;; symbols until 'topmost-intro is reached to find out if ;; point is within a nested class + ;; FIXME: Yuck!!! cc-mode should provide a function instead. (if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode")) (with-current-buffer fbuffer (let ((nclass) (syntax)) @@ -3069,17 +3074,17 @@ class of the file (using s to separate nested class ids)." ;; with the 'topmost-intro symbol, there may be ;; nested classes... (while (not (eq 'topmost-intro - (syntax-symbol (c-guess-basic-syntax)))) + (funcall syntax-symbol (c-guess-basic-syntax)))) ;; Check if the current position c-syntactic ;; analysis has 'inclass (setq syntax (c-guess-basic-syntax)) (while - (and (not (eq 'inclass (syntax-symbol syntax))) + (and (not (eq 'inclass (funcall syntax-symbol syntax))) (cdr syntax)) (setq syntax (cdr syntax))) - (if (eq 'inclass (syntax-symbol syntax)) + (if (eq 'inclass (funcall syntax-symbol syntax)) (progn - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) ;; Now we're at the beginning of a class ;; definition. Find class name (looking-at @@ -3088,9 +3093,9 @@ class of the file (using s to separate nested class ids)." (append (list (match-string-no-properties 1)) nclass))) (setq syntax (c-guess-basic-syntax)) - (while (and (not (syntax-point syntax)) (cdr syntax)) + (while (and (not (funcall syntax-point syntax)) (cdr syntax)) (setq syntax (cdr syntax))) - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) )) (string-match (concat (car nclass) "$") class-found) (setq class-found @@ -3123,10 +3128,14 @@ class of the file (using s to separate nested class ids)." ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) -(defvar gdb-script-font-lock-syntactic-keywords - '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ("^end\\>" - (0 (unless (eq (match-beginning 0) (point-min)) +(defconst gdb-script-syntax-propertize-function + (syntax-propertize-rules + ("^document\\s-.*\\(\n\\)" (1 "< b")) + ("^end\\(\\>\\)" + (1 (ignore + (when (and (> (match-beginning 0) (point-min)) + (eq 1 (nth 7 (save-excursion + (syntax-ppss (1- (match-beginning 0))))))) ;; 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 @@ -3138,10 +3147,9 @@ class of the file (using s to separate nested class ids)." 'syntax-table (eval-when-compile (string-to-syntax "> b"))) ;; Make sure that rehighlighting the previous line won't erase our - ;; syntax-table property. + ;; syntax-table property and that modifying `end' will. (put-text-property (1- (match-beginning 0)) (match-end 0) - 'font-lock-multiline t) - nil))))) + 'syntax-multiline t))))))) (defun gdb-script-font-lock-syntactic-face (state) (cond @@ -3217,15 +3225,8 @@ 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 (cons (purecopy "/\\.[a-z0-9-]*gdbinit") 'gdb-script-mode)) - ;;;###autoload -(define-derived-mode gdb-script-mode nil "GDB-Script" +(define-derived-mode gdb-script-mode prog-mode "GDB-Script" "Major mode for editing GDB scripts." (set (make-local-variable 'comment-start) "#") (set (make-local-variable 'comment-start-skip) "#+\\s-*") @@ -3239,10 +3240,13 @@ Treats actions as defuns." #'gdb-script-end-of-defun) (set (make-local-variable 'font-lock-defaults) '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-keywords - . gdb-script-font-lock-syntactic-keywords) (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face)))) + . gdb-script-font-lock-syntactic-face))) + ;; Recognize docstrings. + (set (make-local-variable 'syntax-propertize-function) + gdb-script-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local)) ;;; tooltips for GUD @@ -3251,7 +3255,10 @@ Treats actions as defuns." ;;;###autoload (define-minor-mode gud-tooltip-mode - "Toggle the display of GUD tooltips." + "Toggle the display of GUD tooltips. +With a prefix argument ARG, enable the feature if ARG is +positive, and disable it otherwise. If called from Lisp, enable +it if ARG is omitted or nil." :global t :group 'gud :group 'tooltip @@ -3347,10 +3354,8 @@ only tooltips in the buffer containing the overlay arrow." ACTIVATEP non-nil means activate mouse motion events." (if activatep (progn - (make-local-variable 'gud-tooltip-mouse-motions-active) - (setq gud-tooltip-mouse-motions-active t) - (make-local-variable 'track-mouse) - (setq track-mouse t)) + (set (make-local-variable 'gud-tooltip-mouse-motions-active) t) + (set (make-local-variable 'track-mouse) t)) (when gud-tooltip-mouse-motions-active (kill-local-variable 'gud-tooltip-mouse-motions-active) (kill-local-variable 'track-mouse)))) @@ -3461,14 +3466,14 @@ This function must return nil if it doesn't handle EVENT." so they have been disabled.")) (unless (null cmd) ; CMD can be nil if unknown debugger (if (eq gud-minor-mode 'gdbmi) - (if gdb-macro-info - (gdb-input - (list (concat - "server macro expand " expr "\n") - `(lambda () (gdb-tooltip-print-1 ,expr)))) - (gdb-input - (list (concat cmd "\n") - `(lambda () (gdb-tooltip-print ,expr))))) + (if gdb-macro-info + (gdb-input + (list (concat + "server macro expand " expr "\n") + `(lambda () (gdb-tooltip-print-1 ,expr)))) + (gdb-input + (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)) @@ -3476,5 +3481,4 @@ so they have been disabled.")) (provide 'gud) -;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4 ;;; gud.el ends here