X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..0b5c5d8291f82556c149013f10372234b0df9bc2:/lisp/progmodes/gud.el diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 4e56383f3a..dc97b0913d 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1,12 +1,12 @@ ;;; 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, 2011 Free Software Foundation, Inc. + ;; Author: Eric S. Raymond ;; Maintainer: FSF ;; Keywords: unix, tools -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -45,7 +45,6 @@ (defvar gdb-active-process) (defvar gdb-define-alist) (defvar gdb-macro-info) -(defvar gdb-server-prefix) (defvar gdb-show-changed-values) (defvar gdb-source-window) (defvar gdb-var-list) @@ -125,23 +124,29 @@ Used to grey out relevant toolbar icons.") (throw 'info-found nil)))) nil 0) (select-frame (make-frame))) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (info "(emacs)GDB Graphical Interface") (info "(emacs)Debuggers")))) (defun gud-tool-bar-item-visible-no-fringe () (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) - (and (memq gud-minor-mode '(gdbmi gdba)) + (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode) + (and (eq gud-minor-mode 'gdbmi) (> (car (window-fringes)) 0))))) +(declare-function gdb-gud-context-command "gdb-mi.el") + (defun gud-stop-subjob () (interactive) (with-current-buffer gud-comint-buffer - (if (string-equal gud-target-name "emacs") - (comint-stop-subjob) - (if (eq gud-minor-mode 'jdb) - (gud-call "suspend") - (comint-interrupt-subjob))))) + (cond ((string-equal gud-target-name "emacs") + (comint-stop-subjob)) + ((eq gud-minor-mode 'jdb) + (gud-call "suspend")) + ((eq gud-minor-mode 'gdbmi) + (gud-call (gdb-gud-context-command "-exec-interrupt"))) + (t + (comint-interrupt-subjob))))) (easy-mmode-defmap gud-menu-map '(([help] "Info (debugger)" . gud-goto-info) @@ -150,22 +155,21 @@ Used to grey out relevant toolbar icons.") (display-graphic-p) (fboundp 'x-show-tip)) :visible (memq gud-minor-mode - '(gdbmi gdba dbx sdb xdb pdb)) + '(gdbmi dbx sdb xdb pdb)) :button (:toggle . gud-tooltip-mode)) ([refresh] "Refresh" . gud-refresh) ([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 - :visible (and (not gud-running) - (eq gud-minor-mode 'gdba))) + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))) ([stop] menu-item "Stop" gud-stop-subjob - :visible (or (not (memq gud-minor-mode '(gdba pdb))) - (and gud-running - (eq gud-minor-mode 'gdba)))) + :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) + (gdb-show-stop-p))) ([until] menu-item "Continue to selection" gud-until :enable (not gud-running) - :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb)) + :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) (gud-tool-bar-item-visible-no-fringe))) ([remove] menu-item "Remove Breakpoint" gud-remove :enable (not gud-running) @@ -173,50 +177,52 @@ Used to grey out relevant toolbar icons.") ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb sdb xdb))) + '(gdbmi 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 (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb))) + '(gdbmi gdb dbx xdb jdb pdb))) ([down] menu-item "Down Stack" gud-down :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb))) + '(gdbmi 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))) - ([print*] menu-item "Print Dereference" gud-pstar + (eq gud-minor-mode 'gdbmi))) + ([print*] menu-item (if (eq gud-minor-mode 'jdb) + "Dump object" + "Print Dereference") gud-pstar :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb))) + :visible (memq gud-minor-mode '(gdbmi gdb jdb))) ([print] menu-item "Print Expression" gud-print :enable (not gud-running)) ([watch] menu-item "Watch Expression" gud-watch :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba))) + :visible (eq gud-minor-mode 'gdbmi)) ([finish] menu-item "Finish Function" gud-finish :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb xdb jdb pdb))) + '(gdbmi gdb xdb jdb pdb))) ([stepi] menu-item "Step Instruction" gud-stepi :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))) ([nexti] menu-item "Next Instruction" gud-nexti :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))) ([step] menu-item "Step Line" gud-step :enable (not gud-running)) ([next] menu-item "Next Line" gud-next :enable (not gud-running)) ([cont] menu-item "Continue" gud-cont :enable (not gud-running) - :visible (not (eq gud-minor-mode 'gdba)))) + :visible (not (eq gud-minor-mode 'gdbmi)))) "Menu for `gud-mode'." :name "Gud") @@ -238,21 +244,22 @@ Used to grey out relevant toolbar icons.") . (,(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))) + :visible (memq gud-minor-mode '(gdbmi gdb perldb))) ([menu-bar cont] menu-item ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont - :visible (not (eq gud-minor-mode 'gdba))) + :visible (not (eq gud-minor-mode 'gdbmi))) ([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))) + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))) ([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)))) + :visible (or (and (eq gud-minor-mode 'gdbmi) + (gdb-show-stop-p)) + (not (eq gud-minor-mode 'gdbmi)))) ([menu-bar print] . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) ([menu-bar tools] . undefined) @@ -272,30 +279,29 @@ Used to grey out relevant toolbar icons.") "`gud-mode' keymap.") (defvar gud-tool-bar-map - (if (display-graphic-p) - (let ((map (make-sparse-keymap))) - (dolist (x '((gud-break . "gud/break") - (gud-remove . "gud/remove") - (gud-print . "gud/print") - (gud-pstar . "gud/pstar") - (gud-pp . "gud/pp") - (gud-watch . "gud/watch") - (gud-run . "gud/run") - (gud-go . "gud/go") - (gud-stop-subjob . "gud/stop") - (gud-cont . "gud/cont") - (gud-until . "gud/until") - (gud-next . "gud/next") - (gud-step . "gud/step") - (gud-finish . "gud/finish") - (gud-nexti . "gud/nexti") - (gud-stepi . "gud/stepi") - (gud-up . "gud/up") - (gud-down . "gud/down") - (gud-goto-info . "info")) - map) - (tool-bar-local-item-from-menu - (car x) (cdr x) map gud-minor-mode-map))))) + (let ((map (make-sparse-keymap))) + (dolist (x '((gud-break . "gud/break") + (gud-remove . "gud/remove") + (gud-print . "gud/print") + (gud-pstar . "gud/pstar") + (gud-pp . "gud/pp") + (gud-watch . "gud/watch") + (gud-run . "gud/run") + (gud-go . "gud/go") + (gud-stop-subjob . "gud/stop") + (gud-cont . "gud/cont") + (gud-until . "gud/until") + (gud-next . "gud/next") + (gud-step . "gud/step") + (gud-finish . "gud/finish") + (gud-nexti . "gud/nexti") + (gud-stepi . "gud/stepi") + (gud-up . "gud/up") + (gud-down . "gud/down") + (gud-goto-info . "info")) + map) + (tool-bar-local-item-from-menu + (car x) (cdr x) map gud-minor-mode-map)))) (defun gud-file-name (f) "Transform a relative file name to an absolute file name. @@ -316,7 +322,7 @@ Uses `gud--directories' to find the source files." (setq directories (cdr directories))) result))) -(declare-function gdb-create-define-alist "gdb-ui" ()) +(declare-function gdb-create-define-alist "gdb-mi" ()) (defun gud-find-file (file) ;; Don't get confused by double slashes in the name that comes from GDB. @@ -332,7 +338,7 @@ Uses `gud--directories' to find the source files." (set (make-local-variable 'gud-minor-mode) minor-mode) (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) (when (and gud-tooltip-mode - (memq gud-minor-mode '(gdbmi gdba))) + (eq gud-minor-mode 'gdbmi)) (make-local-variable 'gdb-define-alist) (unless gdb-define-alist (gdb-create-define-alist)) (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) @@ -433,8 +439,8 @@ The value t means that there is no stack, and we are in display-file 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)) + (if (nth 7 var) + (speedbar-message "%s: %s" (nth 7 var) (nth 3 var)) (speedbar-message "%s" (nth 3 var))))) (defun gud-install-speedbar-variables () @@ -461,21 +467,21 @@ The value t means that there is no stack, and we are in display-file mode.") (defvar gud-speedbar-menu-items '(["Jump to stack frame" speedbar-edit-line - :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba)))] + :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi))] ["Edit value" speedbar-edit-line - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ["Delete expression" gdb-var-delete - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ["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))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ("Output Format" - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba)) + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi) ["Binary" (gdb-var-set-format "binary") t] ["Natural" (gdb-var-set-format "natural") t] ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) @@ -504,7 +510,7 @@ required by the caller." (start (window-start window)) (p (window-point window))) (cond - ((memq minor-mode '(gdbmi gdba)) + ((eq minor-mode 'gdbmi) (erase-buffer) (insert "Watch Expressions:\n") (let ((var-list gdb-var-list) parent) @@ -512,7 +518,8 @@ required by the caller." (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))) + (value (nth 4 var)) (status (nth 5 var)) + (has-more (nth 6 var))) (put-text-property 0 (length expr) 'face font-lock-variable-name-face expr) (put-text-property @@ -521,9 +528,10 @@ required by the caller." (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))) + (if (and (or (not has-more) (string-equal has-more "0")) + (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) @@ -592,7 +600,7 @@ required by the caller." (car frame) 'speedbar-file-face 'speedbar-highlight-face - (cond ((memq minor-mode '(gdbmi gdba gdb)) + (cond ((memq minor-mode '(gdbmi gdb)) 'gud-gdb-goto-stackframe) (t (error "Should never be here"))) frame t)))) @@ -649,8 +657,6 @@ The option \"--fullname\" must be included in this value." ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0)))) - ;; Check for annotations and change gud-minor-mode to 'gdba if - ;; they are found. (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) (let ((match (match-string 1 gud-marker-acc))) @@ -714,10 +720,10 @@ 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'.") -;; If in gdba mode, gdb-ui is loaded. -(declare-function gdb-restore-windows "gdb-ui" ()) +;; If in gdb mode, gdb-mi is loaded. +(declare-function gdb-restore-windows "gdb-mi" ()) -;; The old gdb command (text command mode). The new one is in gdb-ui.el. +;; The old gdb command (text command mode). The new one is in gdb-mi.el. ;;;###autoload (defun gud-gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. @@ -728,10 +734,10 @@ directory and source-file directory for your debugger." (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")) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))) + (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) @@ -2271,7 +2277,7 @@ gud, see `gud-mode'." ;; Set gud-jdb-classpath from the CLASSPATH environment variable, ;; if CLASSPATH is set. - (setq gud-jdb-classpath-string (getenv "CLASSPATH")) + (setq gud-jdb-classpath-string (or (getenv "CLASSPATH") ".")) (if gud-jdb-classpath-string (setq gud-jdb-classpath (gud-jdb-parse-classpath-string gud-jdb-classpath-string))) @@ -2300,7 +2306,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.") + (gud-def gud-print "print %e" "\C-p" "Print value of expression at point.") + (gud-def gud-pstar "dump %e" nil "Print all object information at point.") (setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") (setq paragraph-start comint-prompt-regexp) @@ -2440,7 +2447,7 @@ comint mode, which see." ;; Cause our buffers to be displayed, by default, ;; in the selected window. -;;;###autoload (add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)") +;;;###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." @@ -2506,7 +2513,7 @@ comint mode, which see." (setq w (cdr w))) (if w (setcar w - (if (file-remote-p default-directory) + (if (file-remote-p file) ;; Tramp has already been loaded if we are here. (setq file (tramp-file-name-localname (tramp-dissect-file-name file))) @@ -2526,7 +2533,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 @@ -2601,7 +2608,7 @@ It is saved for when this flag is not set.") (defvar gud-overlay-arrow-position nil) (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) -(declare-function gdb-reset "gdb-ui" ()) +(declare-function gdb-reset "gdb-mi" ()) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) @@ -2613,14 +2620,14 @@ It is saved for when this flag is not set.") (string-equal speedbar-initial-expansion-list-name "GUD")) (speedbar-change-initial-expansion-list speedbar-previously-used-expansion-list-name)) - (if (memq gud-minor-mode-type '(gdbmi gdba)) + (if (eq gud-minor-mode-type 'gdbmi) (gdb-reset) (gud-reset))) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) - (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdba gdbmi)) + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi) (gdb-reset) (gud-reset)) (let* ((obuf (current-buffer))) @@ -2651,7 +2658,9 @@ It is saved for when this flag is not set.") (defun gud-kill-buffer-hook () (setq gud-minor-mode-type gud-minor-mode) (condition-case nil - (kill-process (get-buffer-process (current-buffer))) + (progn + (kill-process (get-buffer-process (current-buffer))) + (delete-process (get-process "gdb-inferior"))) (error nil))) (defun gud-reset () @@ -2674,8 +2683,8 @@ Obeying it means displaying in another window the specified file and line." (declare-function global-hl-line-highlight "hl-line" ()) (declare-function hl-line-highlight "hl-line" ()) -(declare-function gdb-display-source-buffer "gdb-ui" (buffer)) -(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size)) +(declare-function gdb-display-source-buffer "gdb-mi" (buffer)) +(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size)) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. @@ -2691,7 +2700,7 @@ 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)) + (if (eq gud-minor-mode 'gdbmi) (or (if (get-buffer-window buffer 'visible) (display-buffer buffer nil 'visible)) (unless (gdb-display-source-buffer buffer) @@ -2709,7 +2718,8 @@ Obeying it means displaying in another window the specified file and line." (setq gud-keep-buffer t))) (save-restriction (widen) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (setq pos (point)) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) @@ -2727,7 +2737,7 @@ Obeying it means displaying in another window the specified file and line." (goto-char pos)))) (when window (set-window-point window gud-overlay-arrow-position) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (setq gdb-source-window window))))))) ;; The gud-call function must do the right thing whether its invoking @@ -2822,20 +2832,20 @@ Obeying it means displaying in another window the specified file and line." (let ((proc (get-buffer-process gud-comint-buffer))) (or proc (error "Current buffer has no process")) ;; Arrange for the current prompt to get deleted. - (save-excursion - (set-buffer gud-comint-buffer) - (save-restriction - (widen) - (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)) - (apply comint-input-sender (list proc command)) - (process-send-string proc (concat command "\n"))))))) + (with-current-buffer gud-comint-buffer + (save-excursion + (save-restriction + (widen) + (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 (eq gud-minor-mode 'gdbmi) + (apply comint-input-sender (list proc command)) + (process-send-string proc (concat command "\n")))))))) (defun gud-refresh (&optional arg) "Fix up a possibly garbled display, and redraw the arrow." @@ -3053,8 +3063,7 @@ class of the file (using s to separate nested class ids)." ;; symbols until 'topmost-intro is reached to find out if ;; point is within a nested class (if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode")) - (save-excursion - (set-buffer fbuffer) + (with-current-buffer fbuffer (let ((nclass) (syntax)) ;; While the c-syntactic information does not start ;; with the 'topmost-intro symbol, there may be @@ -3114,10 +3123,12 @@ 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 + (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 @@ -3129,10 +3140,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 @@ -3208,13 +3218,6 @@ 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 '("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)) - ;;;###autoload (define-derived-mode gdb-script-mode nil "GDB-Script" "Major mode for editing GDB scripts." @@ -3230,16 +3233,20 @@ 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 ;;; Customizable settings +;;;###autoload (define-minor-mode gud-tooltip-mode "Toggle the display of GUD tooltips." :global t @@ -3250,23 +3257,23 @@ Treats actions as defuns." (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) + (add-hook 'tooltip-functions '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) + (remove-hook 'tooltip-functions '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))) + (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)) (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)) + (when (and (eq gud-minor-mode 'gdbmi) (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) (make-local-variable 'gdb-define-alist) @@ -3317,8 +3324,7 @@ only tooltips in the buffer containing the overlay arrow." (remove-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled) (dolist (buffer (buffer-list)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (if (and gud-tooltip-mode (memq major-mode gud-tooltip-modes)) (gud-tooltip-activate-mouse-motions t) @@ -3338,10 +3344,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)))) @@ -3392,8 +3396,8 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference." ; Larger arrays (say 400 elements) are displayed in ; 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 annotations as in -; gdb-ui.el gets round this problem. +; it may be difficult to do better. Using GDB/MI as in +; gdb-mi.el gets round 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) @@ -3403,12 +3407,12 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference." (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (case gud-minor-mode - (gdba (concat "server print " expr)) - ((dbx gdbmi) (concat "print " expr)) + (gdbmi (concat "-data-evaluate-expression " expr)) + (dbx (concat "print " expr)) ((xdb pdb) (concat "p " expr)) (sdb (concat expr "/")))) -(declare-function gdb-enqueue-input "gdb-ui" (item)) +(declare-function gdb-input "gdb-mi" (item)) (declare-function tooltip-expr-to-print "tooltip" (event)) (declare-function tooltip-event-buffer "tooltip" (event)) @@ -3428,12 +3432,12 @@ This function must return nil if it doesn't handle EVENT." (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)) + (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) (progn (setq gud-tooltip-event event) (eval (cons 'and gud-tooltip-display))))) (let ((expr (tooltip-expr-to-print event))) (when expr - (if (and (eq gud-minor-mode 'gdba) + (if (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) (progn (with-current-buffer (tooltip-event-buffer event) @@ -3451,13 +3455,13 @@ This function must return nil if it doesn't handle EVENT." (message-box "Using GUD tooltips in this mode is unsafe\n\ so they have been disabled.")) (unless (null cmd) ; CMD can be nil if unknown debugger - (if (memq gud-minor-mode '(gdba gdbmi)) + (if (eq gud-minor-mode 'gdbmi) (if gdb-macro-info - (gdb-enqueue-input + (gdb-input (list (concat - gdb-server-prefix "macro expand " expr "\n") + "server macro expand " expr "\n") `(lambda () (gdb-tooltip-print-1 ,expr)))) - (gdb-enqueue-input + (gdb-input (list (concat cmd "\n") `(lambda () (gdb-tooltip-print ,expr))))) (setq gud-tooltip-original-filter (process-filter process)) @@ -3467,5 +3471,4 @@ so they have been disabled.")) (provide 'gud) -;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4 ;;; gud.el ends here