1;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -*- lexical-binding:t -*- 2 3;; Copyright (C) 1992-1996, 1998, 2000-2021 Free Software Foundation, 4;; Inc. 5 6;; Author: Eric S. Raymond <esr@snark.thyrsus.com> 7;; Maintainer: emacs-devel@gnu.org 8;; Keywords: unix, tools 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software: you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation, either version 3 of the License, or 15;; (at your option) any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25;;; Commentary: 26 27;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>. 28;; It was later rewritten by rms. Some ideas were due to Masanobu. Grand 29;; Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com> Barry 30;; Warsaw <bwarsaw@cen.com> hacked the mode to use comint.el. Shane Hartman 31;; <shane@spr.com> added support for xdb (HPUX debugger). Rick Sladkey 32;; <jrs@world.std.com> wrote the GDB command completion code. Dave Love 33;; <d.love@dl.ac.uk> added the IRIX kluge, re-implemented the Mips-ish variant 34;; and added a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX 35;; kluge with the gud-xdb-directories hack producing gud-dbx-directories. 36;; Derek L. Davies <ddavies@world.std.com> added support for jdb (Java 37;; debugger.) Jan Nieuwenhuizen added support for the Guile REPL (Guile 38;; debugger). 39 40;;; Code: 41 42(require 'comint) 43 44(defvar gdb-active-process) 45(defvar gdb-define-alist) 46(defvar gdb-macro-info) 47(defvar gdb-show-changed-values) 48(defvar gdb-source-window) 49(defvar gdb-var-list) 50(defvar hl-line-mode) 51(defvar hl-line-sticky-flag) 52 53 54;; ====================================================================== 55;; GUD commands must be visible in C buffers visited by GUD 56 57(defgroup gud nil 58 "The \"Grand Unified Debugger\" interface. 59Supported debuggers include gdb, sdb, dbx, xdb, perldb, 60pdb (Python), and jdb." 61 :group 'processes 62 :group 'tools) 63 64 65(defcustom gud-key-prefix "\C-x\C-a" 66 "Prefix of all GUD commands valid in C buffers." 67 :type 'key-sequence 68 :group 'gud) 69 70(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh) 71;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack 72 73(defvar gud-marker-filter nil) 74(put 'gud-marker-filter 'permanent-local t) 75(defvar gud-find-file nil) 76(put 'gud-find-file 'permanent-local t) 77 78(defun gud-marker-filter (&rest args) 79 (apply gud-marker-filter args)) 80 81(defvar gud-minor-mode nil) 82(put 'gud-minor-mode 'permanent-local t) 83 84(defvar gud-comint-buffer nil) 85 86(defvar gud-keep-buffer nil) 87 88(defun gud-symbol (sym &optional soft minor-mode) 89 "Return the symbol used for SYM in MINOR-MODE. 90MINOR-MODE defaults to `gud-minor-mode'. 91The symbol returned is `gud-<MINOR-MODE>-<SYM>'. 92If SOFT is non-nil, returns nil if the symbol doesn't already exist." 93 (unless (or minor-mode gud-minor-mode) (error "Gud internal error")) 94 (funcall (if soft 'intern-soft 'intern) 95 (format "gud-%s-%s" (or minor-mode gud-minor-mode) sym))) 96 97(defun gud-val (sym &optional minor-mode) 98 "Return the value of `gud-symbol' SYM. Default to nil." 99 (let ((sym (gud-symbol sym t minor-mode))) 100 (if (boundp sym) (symbol-value sym)))) 101 102(defvar gud-running nil 103 "Non-nil if debugged program is running. 104Used to gray out relevant toolbar icons.") 105 106(defvar gud-target-name "--unknown--" 107 "The apparent name of the program being debugged in a gud buffer.") 108 109;; Use existing Info buffer, if possible. 110(defun gud-goto-info () 111 "Go to relevant Emacs info node." 112 (interactive) 113 (if (eq gud-minor-mode 'gdbmi) 114 (info-other-window "(emacs)GDB Graphical Interface") 115 (info-other-window "(emacs)Debuggers"))) 116 117(defun gud-tool-bar-item-visible-no-fringe () 118 (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) 119 (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode) 120 (and (eq gud-minor-mode 'gdbmi) 121 (> (car (window-fringes)) 0))))) 122 123(declare-function gdb-gud-context-command "gdb-mi.el") 124 125(defun gud-stop-subjob () 126 (interactive) 127 (with-current-buffer gud-comint-buffer 128 (cond ((string-equal gud-target-name "emacs") 129 (comint-stop-subjob)) 130 ((eq gud-minor-mode 'jdb) 131 (gud-call "suspend")) 132 ((eq gud-minor-mode 'gdbmi) 133 (gud-call (gdb-gud-context-command "-exec-interrupt"))) 134 (t 135 (comint-interrupt-subjob))))) 136 137(easy-mmode-defmap gud-menu-map 138 '(([help] "Info (debugger)" . gud-goto-info) 139 ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode 140 :enable (and (not emacs-basic-display) 141 (display-graphic-p) 142 (fboundp 'x-show-tip)) 143 :visible (memq gud-minor-mode 144 '(gdbmi guiler dbx sdb xdb pdb)) 145 :button (:toggle . gud-tooltip-mode)) 146 ([refresh] "Refresh" . gud-refresh) 147 ([run] menu-item "Run" gud-run 148 :enable (not gud-running) 149 :visible (or (memq gud-minor-mode '(gdb dbx jdb)) 150 (and (eq gud-minor-mode 'gdbmi) 151 (or (not (gdb-show-run-p)) 152 (bound-and-true-p 153 gdb-active-process))))) 154 ([go] menu-item (if (bound-and-true-p gdb-active-process) 155 "Continue" "Run") gud-go 156 :visible (and (eq gud-minor-mode 'gdbmi) 157 (gdb-show-run-p))) 158 ([stop] menu-item "Stop" gud-stop-subjob 159 :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) 160 (and (eq gud-minor-mode 'gdbmi) 161 (gdb-show-stop-p)))) 162 ([until] menu-item "Continue to selection" gud-until 163 :enable (not gud-running) 164 :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) 165 (gud-tool-bar-item-visible-no-fringe))) 166 ([remove] menu-item "Remove Breakpoint" gud-remove 167 :enable (not gud-running) 168 :visible (gud-tool-bar-item-visible-no-fringe)) 169 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak 170 :enable (not gud-running) 171 :visible (memq gud-minor-mode 172 '(gdbmi gdb sdb xdb))) 173 ([break] menu-item "Set Breakpoint" gud-break 174 :enable (not gud-running) 175 :visible (gud-tool-bar-item-visible-no-fringe)) 176 ([up] menu-item "Up Stack" gud-up 177 :enable (not gud-running) 178 :visible (memq gud-minor-mode 179 '(gdbmi gdb guiler dbx xdb jdb pdb))) 180 ([down] menu-item "Down Stack" gud-down 181 :enable (not gud-running) 182 :visible (memq gud-minor-mode 183 '(gdbmi gdb guiler dbx xdb jdb pdb))) 184 ([pp] menu-item "Print S-expression" gud-pp 185 :enable (and (not gud-running) 186 (bound-and-true-p gdb-active-process)) 187 :visible (and (string-equal 188 (buffer-local-value 189 'gud-target-name gud-comint-buffer) "emacs") 190 (eq gud-minor-mode 'gdbmi))) 191 ([print*] menu-item (if (eq gud-minor-mode 'jdb) 192 "Dump object" 193 "Print Dereference") gud-pstar 194 :enable (not gud-running) 195 :visible (memq gud-minor-mode '(gdbmi gdb jdb))) 196 ([print] menu-item "Print Expression" gud-print 197 :enable (not gud-running)) 198 ([watch] menu-item "Watch Expression" gud-watch 199 :enable (not gud-running) 200 :visible (eq gud-minor-mode 'gdbmi)) 201 ([finish] menu-item "Finish Function" gud-finish 202 :enable (not gud-running) 203 :visible (memq gud-minor-mode 204 '(gdbmi gdb guiler xdb jdb pdb))) 205 ([stepi] menu-item "Step Instruction" gud-stepi 206 :enable (not gud-running) 207 :visible (memq gud-minor-mode '(gdbmi gdb dbx))) 208 ([nexti] menu-item "Next Instruction" gud-nexti 209 :enable (not gud-running) 210 :visible (memq gud-minor-mode '(gdbmi gdb dbx))) 211 ([step] menu-item "Step Line" gud-step 212 :enable (not gud-running)) 213 ([next] menu-item "Next Line" gud-next 214 :enable (not gud-running)) 215 ([cont] menu-item "Continue" gud-cont 216 :enable (not gud-running) 217 :visible (not (eq gud-minor-mode 'gdbmi)))) 218 "Menu for `gud-mode'." 219 :name "Gud") 220 221(easy-mmode-defmap gud-minor-mode-map 222 (append 223 `(([menu-bar debug] . ("Gud" . ,gud-menu-map))) 224 ;; Get tool bar like functionality from the menu bar on a text only 225 ;; terminal. 226 (unless window-system 227 `(([menu-bar down] 228 . (,(propertize "down" 'face 'font-lock-doc-face) . gud-down)) 229 ([menu-bar up] 230 . (,(propertize "up" 'face 'font-lock-doc-face) . gud-up)) 231 ([menu-bar finish] 232 . (,(propertize "finish" 'face 'font-lock-doc-face) . gud-finish)) 233 ([menu-bar step] 234 . (,(propertize "step" 'face 'font-lock-doc-face) . gud-step)) 235 ([menu-bar next] 236 . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) 237 ([menu-bar until] menu-item 238 ,(propertize "until" 'face 'font-lock-doc-face) gud-until 239 :visible (memq gud-minor-mode '(gdbmi gdb perldb))) 240 ([menu-bar cont] menu-item 241 ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont 242 :visible (not (eq gud-minor-mode 'gdbmi))) 243 ([menu-bar run] menu-item 244 ,(propertize "run" 'face 'font-lock-doc-face) gud-run 245 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 246 ([menu-bar go] menu-item 247 ,(propertize " go " 'face 'font-lock-doc-face) gud-go 248 :visible (and (eq gud-minor-mode 'gdbmi) 249 (gdb-show-run-p))) 250 ([menu-bar stop] menu-item 251 ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob 252 :visible (or (and (eq gud-minor-mode 'gdbmi) 253 (gdb-show-stop-p)) 254 (not (eq gud-minor-mode 'gdbmi)))) 255 ([menu-bar print] 256 . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) 257 ([menu-bar tools] . undefined) 258 ([menu-bar buffer] . undefined) 259 ([menu-bar options] . undefined) 260 ([menu-bar edit] . undefined) 261 ([menu-bar file] . undefined)))) 262 "Map used in visited files.") 263 264(setf (alist-get 'gud-minor-mode minor-mode-map-alist) 265 gud-minor-mode-map) 266 267(defvar gud-mode-map 268 ;; Will inherit from comint-mode via define-derived-mode. 269 (make-sparse-keymap) 270 "`gud-mode' keymap.") 271 272(defvar gud-tool-bar-map 273 (let ((map (make-sparse-keymap))) 274 (dolist (x '((gud-break . "gud/break") 275 (gud-remove . "gud/remove") 276 (gud-print . "gud/print") 277 (gud-pstar . "gud/pstar") 278 (gud-pp . "gud/pp") 279 (gud-watch . "gud/watch") 280 (gud-run . "gud/run") 281 (gud-go . "gud/go") 282 (gud-stop-subjob . "gud/stop") 283 (gud-cont . "gud/cont") 284 (gud-until . "gud/until") 285 (gud-next . "gud/next") 286 (gud-step . "gud/step") 287 (gud-finish . "gud/finish") 288 (gud-nexti . "gud/nexti") 289 (gud-stepi . "gud/stepi") 290 (gud-up . "gud/up") 291 (gud-down . "gud/down") 292 (gud-goto-info . "info")) 293 map) 294 (tool-bar-local-item-from-menu 295 (car x) (cdr x) map gud-minor-mode-map)))) 296 297(defun gud-file-name (f) 298 "Transform a relative file name to an absolute file name. 299Uses `gud-<MINOR-MODE>-directories' to find the source files." 300 ;; When `default-directory' is a remote file name, prepend its 301 ;; remote part to f, which is the local file name. Fortunately, 302 ;; `file-remote-p' returns exactly this remote file name part (or 303 ;; nil otherwise). 304 (setq f (concat (or (file-remote-p default-directory) "") f)) 305 (if (file-exists-p f) (expand-file-name f) 306 (let ((directories (gud-val 'directories)) 307 (result nil)) 308 (while directories 309 (let ((path (expand-file-name f (car directories)))) 310 (if (file-exists-p path) 311 (setq result path 312 directories nil))) 313 (setq directories (cdr directories))) 314 result))) 315 316(declare-function gdb-create-define-alist "gdb-mi" ()) 317 318(defun gud-find-file (file) 319 ;; Don't get confused by double slashes in the name that comes from GDB. 320 (while (string-match "//+" file) 321 (setq file (replace-match "/" t t file))) 322 (let ((minor-mode gud-minor-mode) 323 (buf (funcall (or gud-find-file 'gud-file-name) file))) 324 (when (stringp buf) 325 (setq buf (and (file-readable-p buf) (find-file-noselect buf 'nowarn)))) 326 (when buf 327 ;; Copy `gud-minor-mode' to the found buffer to turn on the menu. 328 (with-current-buffer buf 329 (setq-local gud-minor-mode minor-mode) 330 (if (boundp 'tool-bar-map) ; not --without-x 331 (setq-local tool-bar-map gud-tool-bar-map)) 332 (when (and gud-tooltip-mode 333 (eq gud-minor-mode 'gdbmi)) 334 (make-local-variable 'gdb-define-alist) 335 (unless gdb-define-alist (gdb-create-define-alist)) 336 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) 337 (make-local-variable 'gud-keep-buffer)) 338 buf))) 339 340;; ====================================================================== 341;; command definition 342 343;; This macro is used below to define some basic debugger interface commands. 344;; Of course you may use `gud-def' with any other debugger command, including 345;; user defined ones. 346 347;; A macro call like (gud-def FUNC CMD KEY DOC) expands to a form 348;; which defines FUNC to send the command CMD to the debugger, gives 349;; it the docstring DOC, and binds that function to KEY in the GUD 350;; major mode. The function is also bound in the global keymap with the 351;; GUD prefix. 352 353(defmacro gud-def (func cmd key &optional doc) 354 "Define FUNC to be a command sending CMD and bound to KEY, with 355optional doc string DOC. Certain %-escapes in the string arguments 356are interpreted specially if present. These are: 357 358 %f -- Name (without directory) of current source file. 359 %F -- Name (without directory or extension) of current source file. 360 %d -- Directory of current source file. 361 %l -- Number of current source line. 362 %e -- Text of the C lvalue or function-call expression surrounding point. 363 %a -- Text of the hexadecimal address surrounding point. 364 %p -- Prefix argument to the command (if any) as a number. 365 %c -- Fully qualified class name derived from the expression 366 surrounding point (jdb only). 367 368 The `current' source file is the file of the current buffer (if 369we're in a C file) or the source file current at the last break or 370step (if we're in the GUD buffer). 371 The `current' line is that of the current buffer (if we're in a 372source file) or the source line number at the last break or step (if 373we're in the GUD buffer)." 374 `(progn 375 (defalias ',func (lambda (arg) 376 ,@(if doc (list doc)) 377 (interactive "p") 378 (if (not gud-running) 379 ,(if (stringp cmd) 380 `(gud-call ,cmd arg) 381 ;; Unused lexical warning if cmd does not use "arg". 382 cmd)))) 383 ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) 384 ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) 385 386;; Where gud-display-frame should put the debugging arrow; a cons of 387;; (filename . line-number). This is set by the marker-filter, which scans 388;; the debugger's output for indications of the current program counter. 389(defvar gud-last-frame nil) 390 391;; Used by gud-refresh, which should cause gud-display-frame to redisplay 392;; the last frame, even if it's been called before and gud-last-frame has 393;; been set to nil. 394(defvar gud-last-last-frame nil) 395 396;; All debugger-specific information is collected here. 397;; Here's how it works, in case you ever need to add a debugger to the mode. 398;; 399;; Each entry must define the following at startup: 400;; 401;;<name> 402;; comint-prompt-regexp 403;; gud-<name>-massage-args 404;; gud-<name>-marker-filter 405;; gud-<name>-find-file 406;; 407;; The job of the massage-args method is to modify the given list of 408;; debugger arguments before running the debugger. 409;; 410;; The job of the marker-filter method is to detect file/line markers in 411;; strings and set the global gud-last-frame to indicate what display 412;; action (if any) should be triggered by the marker. Note that only 413;; whatever the method *returns* is displayed in the buffer; thus, you 414;; can filter the debugger's output, interpreting some and passing on 415;; the rest. 416;; 417;; The job of the find-file method is to visit and return the buffer indicated 418;; by the car of gud-tag-frame. This may be a file name, a tag name, or 419;; something else. 420 421;; ====================================================================== 422;; speedbar support functions and variables. 423(eval-when-compile (require 'dframe)) ; for dframe-with-attached-buffer 424 425(defvar gud-last-speedbar-stackframe nil 426 "Description of the currently displayed GUD stack. 427The value t means that there is no stack, and we are in display-file mode.") 428 429(defvar gud-speedbar-key-map nil 430 "Keymap used when in the buffers display mode.") 431 432;; At runtime, will be pulled in as a require of speedbar. 433(declare-function dframe-message "dframe" (fmt &rest args)) 434 435(defun gud-speedbar-item-info () 436 "Display the data type of the watch expression element." 437 (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) 438 (if (nth 7 var) 439 (dframe-message "%s: %s" (nth 7 var) (nth 3 var)) 440 (dframe-message "%s" (nth 3 var))))) 441 442(declare-function speedbar-make-specialized-keymap "speedbar" ()) 443(declare-function speedbar-add-expansion-list "speedbar" (new-list)) 444(defvar speedbar-mode-functions-list) 445 446(defun gud-install-speedbar-variables () 447 "Install those variables used by speedbar to enhance gud/gdb." 448 (unless gud-speedbar-key-map 449 (setq gud-speedbar-key-map (speedbar-make-specialized-keymap)) 450 (define-key gud-speedbar-key-map "j" 'speedbar-edit-line) 451 (define-key gud-speedbar-key-map "e" 'speedbar-edit-line) 452 (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line) 453 (define-key gud-speedbar-key-map " " 'speedbar-toggle-line-expansion) 454 (define-key gud-speedbar-key-map "D" 'gdb-var-delete) 455 (define-key gud-speedbar-key-map "p" 'gud-pp)) 456 457 (speedbar-add-expansion-list '("GUD" gud-speedbar-menu-items 458 gud-speedbar-key-map 459 gud-expansion-speedbar-buttons)) 460 461 (add-to-list 462 'speedbar-mode-functions-list 463 '("GUD" (speedbar-item-info . gud-speedbar-item-info) 464 (speedbar-line-directory . ignore)))) 465 466(defvar gud-speedbar-menu-items 467 '(["Jump to stack frame" speedbar-edit-line 468 :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 469 'gdbmi))] 470 ["Edit value" speedbar-edit-line 471 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 472 'gdbmi)] 473 ["Delete expression" gdb-var-delete 474 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 475 'gdbmi)] 476 ["Auto raise frame" gdb-speedbar-auto-raise 477 :style toggle :selected gdb-speedbar-auto-raise 478 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 479 'gdbmi)] 480 ("Output Format" 481 :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 482 'gdbmi) 483 ["Binary" (gdb-var-set-format "binary") t] 484 ["Natural" (gdb-var-set-format "natural") t] 485 ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) 486 "Additional menu items to add to the speedbar frame.") 487 488;; Make sure our special speedbar mode is loaded 489(if (featurep 'speedbar) 490 (gud-install-speedbar-variables) 491 (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) 492 493(defun gud-expansion-speedbar-buttons (_directory _zero) 494 "Wrapper for call to `speedbar-add-expansion-list'. 495DIRECTORY and ZERO are not used, but are required by the caller." 496 (gud-speedbar-buttons gud-comint-buffer)) 497 498(declare-function speedbar-make-tag-line "speedbar" 499 (type char func data tag tfunc tdata tface depth)) 500(declare-function speedbar-remove-localized-speedbar-support "speedbar" 501 (buffer)) 502(declare-function speedbar-insert-button "speedbar" 503 (text face mouse function &optional token prevline)) 504 505(defun gud-speedbar-buttons (buffer) 506 "Create a speedbar display based on the current state of GUD. 507If the GUD BUFFER is not running a supported debugger, then turn 508off the specialized speedbar mode. BUFFER is not used, but is 509required by the caller." 510 (when (and gud-comint-buffer 511 ;; gud-comint-buffer might be killed 512 (buffer-name gud-comint-buffer)) 513 (let* ((minor-mode (with-current-buffer buffer gud-minor-mode)) 514 (window (get-buffer-window (current-buffer) 0)) 515 (start (window-start window)) 516 (p (window-point window))) 517 (cond 518 ((eq minor-mode 'gdbmi) 519 (erase-buffer) 520 (insert "Watch Expressions:\n") 521 (let ((var-list gdb-var-list) parent) 522 (while var-list 523 (let* (char (depth 0) (start 0) (var (car var-list)) 524 (varnum (car var)) (expr (nth 1 var)) 525 (type (if (nth 3 var) (nth 3 var) " ")) 526 (value (nth 4 var)) (status (nth 5 var)) 527 (has-more (nth 6 var))) 528 (put-text-property 529 0 (length expr) 'face font-lock-variable-name-face expr) 530 (put-text-property 531 0 (length type) 'face font-lock-type-face type) 532 (while (string-match "\\." varnum start) 533 (setq depth (1+ depth) 534 start (1+ (match-beginning 0)))) 535 (if (eq depth 0) (setq parent nil)) 536 (if (and (or (not has-more) (string-equal has-more "0")) 537 (or (equal (nth 2 var) "0") 538 (and (equal (nth 2 var) "1") 539 (string-match "char \\*$" type)) )) 540 (speedbar-make-tag-line 541 'bracket ?? nil nil 542 (concat expr "\t" value) 543 (if (or parent (eq status 'out-of-scope)) 544 nil 'gdb-edit-value) 545 nil 546 (if gdb-show-changed-values 547 (or parent (pcase status 548 ('changed 'font-lock-warning-face) 549 ('out-of-scope 'shadow) 550 (_ t))) 551 t) 552 depth) 553 (if (eq status 'out-of-scope) (setq parent 'shadow)) 554 (if (and (nth 1 var-list) 555 (string-match (concat varnum "\\.") 556 (car (nth 1 var-list)))) 557 (setq char ?-) 558 (setq char ?+)) 559 (if (string-match "\\*$\\|\\*&$" type) 560 (speedbar-make-tag-line 561 'bracket char 562 'gdb-speedbar-expand-node varnum 563 (concat expr "\t" type "\t" value) 564 (if (or parent (eq status 'out-of-scope)) 565 nil 'gdb-edit-value) 566 nil 567 (if gdb-show-changed-values 568 (or parent (pcase status 569 ('changed 'font-lock-warning-face) 570 ('out-of-scope 'shadow) 571 (_ t))) 572 t) 573 depth) 574 (speedbar-make-tag-line 575 'bracket char 576 'gdb-speedbar-expand-node varnum 577 (concat expr "\t" type) 578 nil nil 579 (if (and (or parent status) gdb-show-changed-values) 580 'shadow t) 581 depth)))) 582 (setq var-list (cdr var-list))))) 583 (t (unless (and (save-excursion 584 (goto-char (point-min)) 585 (looking-at "Current Stack:")) 586 (equal gud-last-last-frame gud-last-speedbar-stackframe)) 587 (let ((gud-frame-list 588 (cond ((eq minor-mode 'gdb) 589 (gud-gdb-get-stackframe buffer)) 590 ;; Add more debuggers here! 591 (t (speedbar-remove-localized-speedbar-support buffer) 592 nil)))) 593 (erase-buffer) 594 (if (not gud-frame-list) 595 (insert "No Stack frames\n") 596 (insert "Current Stack:\n")) 597 (dolist (frame gud-frame-list) 598 (insert (nth 1 frame) ":\n") 599 (if (= (length frame) 2) 600 (progn 601 (speedbar-insert-button (car frame) 602 'speedbar-directory-face 603 nil nil nil t)) 604 (speedbar-insert-button 605 (car frame) 606 'speedbar-file-face 607 'speedbar-highlight-face 608 (cond ((memq minor-mode '(gdbmi gdb)) 609 'gud-gdb-goto-stackframe) 610 (t (error "Should never be here"))) 611 frame t)))) 612 (setq gud-last-speedbar-stackframe gud-last-last-frame)))) 613 (set-window-start window start) 614 (set-window-point window p)))) 615 616 617;; ====================================================================== 618;; gdb functions 619 620;; History of argument lists passed to gdb. 621(defvar gud-gdb-history nil) 622 623(defcustom gud-gud-gdb-command-name "gdb --fullname" 624 "Default command to run an executable under GDB in text command mode. 625The option \"--fullname\" must be included in this value." 626 :type 'string 627 :group 'gud) 628 629(defvar gud-gdb-marker-regexp 630 ;; This used to use path-separator instead of ":"; 631 ;; however, we found that on both Windows 32 and MSDOS 632 ;; a colon is correct here. 633 (concat "\032\032\\(.:?[^" ":" "\n]*\\)" ":" 634 "\\([0-9]*\\)" ":" ".*\n")) 635 636;; There's no guarantee that Emacs will hand the filter the entire 637;; marker at once; it could be broken up across several strings. We 638;; might even receive a big chunk with several markers in it. If we 639;; receive a chunk of text which looks like it might contain the 640;; beginning of a marker, we save it here between calls to the 641;; filter. 642(defvar gud-marker-acc "") 643(make-variable-buffer-local 'gud-marker-acc) 644 645(defun gud-gdb-marker-filter (string) 646 (setq gud-marker-acc (concat gud-marker-acc string)) 647 (let ((output "")) 648 649 ;; Process all the complete markers in this chunk. 650 (while (string-match gud-gdb-marker-regexp gud-marker-acc) 651 (setq 652 653 ;; Extract the frame position from the marker. 654 gud-last-frame (cons (match-string 1 gud-marker-acc) 655 (string-to-number (match-string 2 gud-marker-acc))) 656 657 ;; Append any text before the marker to the output we're going 658 ;; to return - we don't include the marker in this text. 659 output (concat output 660 (substring gud-marker-acc 0 (match-beginning 0))) 661 662 ;; Set the accumulator to the remaining text. 663 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 664 665 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) 666 (setq 667 ;; Append any text before the marker to the output we're going 668 ;; to return - we don't include the marker in this text. 669 output (concat output 670 (substring gud-marker-acc 0 (match-beginning 0))) 671 672 ;; Set the accumulator to the remaining text. 673 674 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 675 676 ;; Does the remaining text look like it might end with the 677 ;; beginning of another marker? If it does, then keep it in 678 ;; gud-marker-acc until we receive the rest of it. Since we 679 ;; know the full marker regexp above failed, it's pretty simple to 680 ;; test for marker starts. 681 (if (string-match "\\(\n\\)?\\(\032.*\\)?\\'" gud-marker-acc) 682 (progn 683 ;; Everything before the potential marker start can be output. 684 (setq output (concat output (substring gud-marker-acc 685 0 (match-beginning 0)))) 686 687 ;; Everything after, we save, to combine with later input. 688 (setq gud-marker-acc 689 (substring gud-marker-acc (match-beginning 0)))) 690 691 (setq output (concat output gud-marker-acc) 692 gud-marker-acc "")) 693 694 output)) 695 696(easy-mmode-defmap gud-minibuffer-local-map 697 '(("\C-i" . comint-dynamic-complete-filename)) 698 "Keymap for minibuffer prompting of gud startup command." 699 :inherit minibuffer-local-map) 700 701(defun gud-query-cmdline (minor-mode &optional init) 702 (let* ((hist-sym (gud-symbol 'history nil minor-mode)) 703 (cmd-name (gud-val 'command-name minor-mode))) 704 (unless (boundp hist-sym) (set hist-sym nil)) 705 (read-from-minibuffer 706 (format "Run %s (like this): " minor-mode) 707 (or (car-safe (symbol-value hist-sym)) 708 (concat (or cmd-name (symbol-name minor-mode)) 709 " " 710 (or init 711 (let ((file nil)) 712 (dolist (f (directory-files default-directory) file) 713 (if (and (file-executable-p f) 714 (not (file-directory-p f)) 715 (or (not file) 716 (file-newer-than-file-p f file))) 717 (setq file f))))))) 718 gud-minibuffer-local-map nil 719 hist-sym))) 720 721(defvar gdb-first-prompt t) 722 723(defvar gud-filter-pending-text nil 724 "Non-nil means this is text that has been saved for later in `gud-filter'.") 725 726;; One of the nice features of GDB is its impressive support for 727;; context-sensitive command completion. We preserve that feature 728;; in the GUD buffer by using a GDB command designed just for Emacs. 729 730(defvar gud-gdb-completion-function nil 731 "Completion function for GDB commands. 732It receives two arguments: COMMAND, the prefix for which we seek 733completion; and CONTEXT, the text before COMMAND on the line. 734It should return a list of completion strings.") 735 736;; If in gdb mode, gdb-mi is loaded. 737(declare-function gdb-restore-windows "gdb-mi" ()) 738 739;; The old gdb command (text command mode). The new one is in gdb-mi.el. 740;;;###autoload 741(defun gud-gdb (command-line) 742 "Run gdb passing it COMMAND-LINE as arguments. 743If COMMAND-LINE names a program FILE to debug, gdb will run in 744a buffer named *gud-FILE*, and the directory containing FILE 745becomes the initial working directory and source-file directory 746for your debugger. 747If COMMAND-LINE requests that gdb attaches to a process PID, gdb 748will run in *gud-PID*, otherwise it will run in *gud*; in these 749cases the initial working directory is the default-directory of 750the buffer in which this command was invoked." 751 (interactive (list (gud-query-cmdline 'gud-gdb))) 752 753 (when (and gud-comint-buffer 754 (buffer-name gud-comint-buffer) 755 (get-buffer-process gud-comint-buffer) 756 (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))) 757 (gdb-restore-windows) 758 (error 759 "Multiple debugging requires restarting in text command mode")) 760 761 (gud-common-init command-line nil 'gud-gdb-marker-filter) 762 (set (make-local-variable 'gud-minor-mode) 'gdb) 763 764 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") 765 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" 766 "Set temporary breakpoint at current line.") 767 (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") 768 (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") 769 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") 770 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") 771 (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") 772 (gud-def gud-cont "cont" "\C-r" "Continue with display.") 773 (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") 774 (gud-def gud-jump 775 (progn (gud-call "tbreak %f:%l" arg) (gud-call "jump %f:%l")) 776 "\C-j" "Set execution address to current line.") 777 778 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") 779 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") 780 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") 781 (gud-def gud-pstar "print* %e" nil 782 "Evaluate C dereferenced pointer expression at point.") 783 784 ;; For debugging Emacs only. 785 (gud-def gud-pv "pv %e" "\C-v" "Print the value of the lisp variable.") 786 787 (gud-def gud-until "until %l" "\C-u" "Continue to current line.") 788 (gud-def gud-run "run" nil "Run the program.") 789 790 (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point 791 nil 'local) 792 (set (make-local-variable 'gud-gdb-completion-function) 'gud-gdb-completions) 793 794 (local-set-key "\C-i" 'completion-at-point) 795 (setq comint-prompt-regexp "^(.*gdb[+]?) *") 796 (setq paragraph-start comint-prompt-regexp) 797 (setq gdb-first-prompt t) 798 (setq gud-running nil) 799 (setq gud-filter-pending-text nil) 800 (run-hooks 'gud-gdb-mode-hook)) 801 802;; The completion process filter indicates when it is finished. 803(defvar gud-gdb-fetch-lines-in-progress) 804 805;; Since output may arrive in fragments we accumulate partials strings here. 806(defvar gud-gdb-fetch-lines-string) 807 808;; We need to know how much of the completion to chop off. 809(defvar gud-gdb-fetch-lines-break) 810 811;; The completion list is constructed by the process filter. 812(defvar gud-gdb-fetched-lines) 813 814(defun gud-gdb-completions (context command) 815 "Completion table for GDB commands. 816COMMAND is the prefix for which we seek completion. 817CONTEXT is the text before COMMAND on the line." 818 (let* ((complete-list 819 (gud-gdb-run-command-fetch-lines (concat "complete " context command) 820 (current-buffer) 821 ;; From string-match above. 822 (length context)))) 823 ;; Protect against old versions of GDB. 824 (and complete-list 825 (string-match "^Undefined command: \"complete\"" (car complete-list)) 826 (error "This version of GDB doesn't support the `complete' command")) 827 (gud-gdb-completions-1 complete-list))) 828 829;; This function is also used by `gud-gdbmi-completions'. 830(defun gud-gdb-completions-1 (complete-list) 831 ;; Sort the list like readline. 832 (setq complete-list (sort complete-list (function string-lessp))) 833 ;; Remove duplicates. 834 (let ((first complete-list) 835 (second (cdr complete-list))) 836 (while second 837 (if (string-equal (car first) (car second)) 838 (setcdr first (setq second (cdr second))) 839 (setq first second 840 second (cdr second))))) 841 ;; Add a trailing single quote if there is a unique completion 842 ;; and it contains an odd number of unquoted single quotes. 843 (and (= (length complete-list) 1) 844 (let ((str (car complete-list)) 845 (pos 0) 846 (count 0)) 847 (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) 848 (setq count (1+ count) 849 pos (match-end 0))) 850 (and (= (mod count 2) 1) 851 (setq complete-list (list (concat str "'")))))) 852 complete-list) 853 854(defun gud-gdb-completion-at-point () 855 "Return the data to complete the GDB command before point." 856 (let ((end (point)) 857 (start 858 (save-excursion 859 (skip-chars-backward "^ " (comint-line-beginning-position)) 860 (point)))) 861 ;; FIXME: `gud-gdb-run-command-fetch-lines' has some nasty side-effects on 862 ;; the buffer (via `gud-delete-prompt-marker'): it removes the prompt and 863 ;; then re-adds it later, thus messing up markers and overlays along the 864 ;; way (bug#18282). 865 ;; We use an "insert-before" marker for `start', since it's typically right 866 ;; after the prompt, which works around the problem, but is a hack (and 867 ;; comes with other downsides, e.g. if completion adds text at `start'). 868 (list (copy-marker start t) end 869 (completion-table-dynamic 870 (apply-partially gud-gdb-completion-function 871 (buffer-substring (comint-line-beginning-position) 872 start)))))) 873 874;; (defun gud-gdb-complete-command () 875;; "Perform completion on the GDB command preceding point. 876;; This is implemented using the GDB `complete' command which isn't 877;; available with older versions of GDB." 878;; (interactive) 879;; (apply #'completion-in-region (gud-gdb-completion-at-point))) 880 881;; The completion process filter is installed temporarily to slurp the 882;; output of GDB up to the next prompt and build the completion list. 883(defun gud-gdb-fetch-lines-filter (string) 884 "Filter used to read the list of lines output by a command. 885STRING is the output to filter. 886It is passed through `gud-gdb-marker-filter' before we look at it." 887 (setq string (gud-gdb-marker-filter string)) 888 (setq string (concat gud-gdb-fetch-lines-string string)) 889 (while (string-match "\n" string) 890 (push (substring string gud-gdb-fetch-lines-break (match-beginning 0)) 891 gud-gdb-fetched-lines) 892 (setq string (substring string (match-end 0)))) 893 (if (string-match comint-prompt-regexp string) 894 (progn 895 (setq gud-gdb-fetch-lines-in-progress nil) 896 string) 897 (progn 898 (setq gud-gdb-fetch-lines-string string) 899 ""))) 900 901;; gdb speedbar functions 902 903;; Part of the macro expansion of dframe-with-attached-buffer. 904;; At runtime, will be pulled in as a require of speedbar. 905(declare-function dframe-select-attached-frame "dframe" (&optional frame)) 906(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) 907 908(defun gud-gdb-goto-stackframe (_text token _indent) 909 "Goto the stackframe described by TEXT, TOKEN, and INDENT." 910 (dframe-with-attached-buffer 911 (gud-basic-call (concat "server frame " (nth 1 token))) 912 (sit-for 1))) 913 914(defvar gud-gdb-fetched-stack-frame nil 915 "Stack frames we are fetching from GDB.") 916 917(defun gud-gdb-get-stackframe (buffer) 918 "Extract the current stack frame out of the GUD GDB BUFFER." 919 (let ((newlst nil) 920 (fetched-stack-frame-list 921 (gud-gdb-run-command-fetch-lines "server backtrace" buffer))) 922 (if (and (car fetched-stack-frame-list) 923 (string-match "No stack" (car fetched-stack-frame-list))) 924 ;; Go into some other mode??? 925 nil 926 (dolist (e fetched-stack-frame-list) 927 (let ((name nil) (num nil)) 928 (if (not (or 929 (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e) 930 (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e))) 931 (if (not (string-match 932 "at \\([-0-9a-zA-Z_/.]+\\):\\([0-9]+\\)$" e)) 933 nil 934 (setcar newlst 935 (list (nth 0 (car newlst)) 936 (nth 1 (car newlst)) 937 (match-string 1 e) 938 (match-string 2 e)))) 939 (setq num (match-string 1 e) 940 name (match-string 2 e)) 941 (setq newlst 942 (cons 943 (if (string-match 944 "at \\([-0-9a-zA-Z_/.]+\\):\\([0-9]+\\)$" e) 945 (list name num (match-string 1 e) 946 (match-string 2 e)) 947 (list name num)) 948 newlst))))) 949 (nreverse newlst)))) 950 951;(defun gud-gdb-selected-frame-info (buffer) 952; "Learn GDB information for the currently selected stack frame in BUFFER." 953; ) 954 955(defun gud-gdb-run-command-fetch-lines (command buffer &optional skip) 956 "Run COMMAND, and return the list of lines it outputs. 957BUFFER is the current buffer which may be the GUD buffer in which to run. 958SKIP is the number of chars to skip on each line, it defaults to 0." 959 (with-current-buffer gud-comint-buffer 960 (unless (and (eq gud-comint-buffer buffer) 961 (save-excursion 962 (goto-char (point-max)) 963 (forward-line 0) 964 (not (looking-at comint-prompt-regexp)))) 965 (let ((gud-gdb-fetch-lines-in-progress t) 966 (gud-gdb-fetched-lines nil) 967 (gud-gdb-fetch-lines-string nil) 968 (gud-gdb-fetch-lines-break (or skip 0)) 969 (gud-marker-filter #'gud-gdb-fetch-lines-filter)) 970 ;; Issue the command to GDB. 971 (gud-basic-call command) 972 ;; Slurp the output. 973 (while gud-gdb-fetch-lines-in-progress 974 (accept-process-output (get-buffer-process gud-comint-buffer))) 975 (nreverse gud-gdb-fetched-lines))))) 976 977 978;; ====================================================================== 979;; sdb functions 980 981;; History of argument lists passed to sdb. 982(defvar gud-sdb-history nil) 983 984(defvar gud-sdb-needs-tags (not (file-exists-p "/var")) 985 "If nil, we're on a System V Release 4 and don't need the tags hack.") 986 987(defvar gud-sdb-lastfile nil) 988 989(defun gud-sdb-marker-filter (string) 990 (setq gud-marker-acc 991 (if gud-marker-acc (concat gud-marker-acc string) string)) 992 (let (start) 993 ;; Process all complete markers in this chunk 994 (while 995 (cond 996 ;; System V Release 3.2 uses this format 997 ((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n" 998 gud-marker-acc start) 999 (setq gud-last-frame 1000 (cons (match-string 3 gud-marker-acc) 1001 (string-to-number (match-string 4 gud-marker-acc))))) 1002 ;; System V Release 4.0 quite often clumps two lines together 1003 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" 1004 gud-marker-acc start) 1005 (setq gud-sdb-lastfile (match-string 2 gud-marker-acc)) 1006 (setq gud-last-frame 1007 (cons gud-sdb-lastfile 1008 (string-to-number (match-string 3 gud-marker-acc))))) 1009 ;; System V Release 4.0 1010 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" 1011 gud-marker-acc start) 1012 (setq gud-sdb-lastfile (match-string 2 gud-marker-acc))) 1013 ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" 1014 gud-marker-acc start)) 1015 (setq gud-last-frame 1016 (cons gud-sdb-lastfile 1017 (string-to-number (match-string 1 gud-marker-acc))))) 1018 (t 1019 (setq gud-sdb-lastfile nil))) 1020 (setq start (match-end 0))) 1021 1022 ;; Search for the last incomplete line in this chunk 1023 (while (string-match "\n" gud-marker-acc start) 1024 (setq start (match-end 0))) 1025 1026 ;; If we have an incomplete line, store it in gud-marker-acc. 1027 (setq gud-marker-acc (substring gud-marker-acc (or start 0)))) 1028 string) 1029 1030(defun gud-sdb-find-file (f) 1031 (if gud-sdb-needs-tags (find-tag-noselect f) (find-file-noselect f))) 1032 1033;;;###autoload 1034(defun sdb (command-line) 1035 "Run sdb on program FILE in buffer *gud-FILE*. 1036The directory containing FILE becomes the initial working directory 1037and source-file directory for your debugger." 1038 (interactive (list (gud-query-cmdline 'sdb))) 1039 1040 (if gud-sdb-needs-tags (require 'etags)) 1041 (if (and gud-sdb-needs-tags 1042 (not (and (boundp 'tags-file-name) 1043 (stringp tags-file-name) 1044 (file-exists-p tags-file-name)))) 1045 (error "The sdb support requires a valid tags table to work")) 1046 1047 (gud-common-init command-line nil 'gud-sdb-marker-filter 'gud-sdb-find-file) 1048 (set (make-local-variable 'gud-minor-mode) 'sdb) 1049 1050 (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") 1051 (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") 1052 (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line") 1053 (gud-def gud-step "s %p" "\C-s" "Step one source line with display.") 1054 (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.") 1055 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") 1056 (gud-def gud-cont "c" "\C-r" "Continue with display.") 1057 (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.") 1058 1059 (setq comint-prompt-regexp "\\(^\\|\n\\)\\*") 1060 (setq paragraph-start comint-prompt-regexp) 1061 (run-hooks 'sdb-mode-hook) 1062 ) 1063 1064;; ====================================================================== 1065;; dbx functions 1066 1067;; History of argument lists passed to dbx. 1068(defvar gud-dbx-history nil) 1069 1070(defcustom gud-dbx-directories nil 1071 "A list of directories that dbx should search for source code. 1072If nil, only source files in the program directory 1073will be known to dbx. 1074 1075The file names should be absolute, or relative to the directory 1076containing the executable being debugged." 1077 :type '(choice (const :tag "Current Directory" nil) 1078 (repeat :value ("") 1079 directory)) 1080 :group 'gud) 1081 1082(defun gud-dbx-massage-args (_file args) 1083 (nconc (let ((directories gud-dbx-directories) 1084 (result nil)) 1085 (while directories 1086 (setq result (cons (car directories) (cons "-I" result))) 1087 (setq directories (cdr directories))) 1088 (nreverse result)) 1089 args)) 1090 1091(defun gud-dbx-marker-filter (string) 1092 (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) 1093 1094 (let (start) 1095 ;; Process all complete markers in this chunk. 1096 (while (or (string-match 1097 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" 1098 gud-marker-acc start) 1099 (string-match 1100 "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" 1101 gud-marker-acc start)) 1102 (setq gud-last-frame 1103 (cons (match-string 2 gud-marker-acc) 1104 (string-to-number (match-string 1 gud-marker-acc))) 1105 start (match-end 0))) 1106 1107 ;; Search for the last incomplete line in this chunk 1108 (while (string-match "\n" gud-marker-acc start) 1109 (setq start (match-end 0))) 1110 1111 ;; If the incomplete line APPEARS to begin with another marker, keep it 1112 ;; in the accumulator. Otherwise, clear the accumulator to avoid an 1113 ;; unnecessary concat during the next call. 1114 (setq gud-marker-acc 1115 (if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start) 1116 (substring gud-marker-acc (match-beginning 0)) 1117 nil))) 1118 string) 1119 1120;; Functions for Mips-style dbx. Given the option `-emacs', documented in 1121;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's. 1122(defvar gud-mips-p 1123 (or (string-match "^mips-[^-]*-ultrix" system-configuration) 1124 ;; We haven't tested gud on this system: 1125 (string-match "^mips-[^-]*-riscos" system-configuration) 1126 ;; It's documented on OSF/1.3 1127 (string-match "^mips-[^-]*-osf1" system-configuration) 1128 (string-match "^alpha[^-]*-[^-]*-osf" system-configuration)) 1129 "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") 1130 1131(defvar gud-dbx-command-name 1132 (concat "dbx" (if gud-mips-p " -emacs"))) 1133 1134;; This is just like the gdb one except for the regexps since we need to cope 1135;; with an optional breakpoint number in [] before the ^Z^Z 1136(defun gud-mipsdbx-marker-filter (string) 1137 (setq gud-marker-acc (concat gud-marker-acc string)) 1138 (let ((output "")) 1139 1140 ;; Process all the complete markers in this chunk. 1141 (while (string-match 1142 ;; This is like th gdb marker but with an optional 1143 ;; leading break point number like `[1] ' 1144 "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" 1145 gud-marker-acc) 1146 (setq 1147 1148 ;; Extract the frame position from the marker. 1149 gud-last-frame 1150 (cons (match-string 1 gud-marker-acc) 1151 (string-to-number (match-string 2 gud-marker-acc))) 1152 1153 ;; Append any text before the marker to the output we're going 1154 ;; to return - we don't include the marker in this text. 1155 output (concat output 1156 (substring gud-marker-acc 0 (match-beginning 0))) 1157 1158 ;; Set the accumulator to the remaining text. 1159 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 1160 1161 ;; Does the remaining text look like it might end with the 1162 ;; beginning of another marker? If it does, then keep it in 1163 ;; gud-marker-acc until we receive the rest of it. Since we 1164 ;; know the full marker regexp above failed, it's pretty simple to 1165 ;; test for marker starts. 1166 (if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc) 1167 (progn 1168 ;; Everything before the potential marker start can be output. 1169 (setq output (concat output (substring gud-marker-acc 1170 0 (match-beginning 0)))) 1171 1172 ;; Everything after, we save, to combine with later input. 1173 (setq gud-marker-acc 1174 (substring gud-marker-acc (match-beginning 0)))) 1175 1176 (setq output (concat output gud-marker-acc) 1177 gud-marker-acc "")) 1178 1179 output)) 1180 1181;; The dbx in IRIX is a pain. It doesn't print the file name when 1182;; stopping at a breakpoint (but you do get it from the `up' and 1183;; `down' commands...). The only way to extract the information seems 1184;; to be with a `file' command, although the current line number is 1185;; available in $curline. Thus we have to look for output which 1186;; appears to indicate a breakpoint. Then we prod the dbx sub-process 1187;; to output the information we want with a combination of the 1188;; `printf' and `file' commands as a pseudo marker which we can 1189;; recognize next time through the marker-filter. This would be like 1190;; the gdb marker but you can't get the file name without a newline... 1191;; Note that gud-remove won't work since Irix dbx expects a breakpoint 1192;; number rather than a line number etc. Maybe this could be made to 1193;; work by listing all the breakpoints and picking the one(s) with the 1194;; correct line number, but life's too short. 1195;; d.love@dl.ac.uk (Dave Love) can be blamed for this 1196 1197(defvar gud-irix-p nil 1198 "Non-nil to assume the interface appropriate for IRIX dbx. 1199This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides 1200a better solution in 6.1 upwards.") 1201(defvar gud-dbx-use-stopformat-p nil 1202 "Non-nil to use the dbx feature present at least from Irix 6.1 1203whereby $stopformat=1 produces an output format compatible with 1204`gud-dbx-marker-filter'.") 1205;; [Irix dbx seemed to be a moving target. The dbx output changed 1206;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, 1207;; the output from `up' is no longer spotted by gud (and it's probably 1208;; not distinctive enough to try to match it -- use C-<, C-> 1209;; exclusively) . For 5.3 and 6.0, the $curline variable changed to 1210;; `long long'(why?!), so the printf stuff needed changing. The line 1211;; number was cast to `long' as a compromise between the new `long 1212;; long' and the original `int'. This was reported not to work in 6.2, 1213;; so it's changed back to int -- don't make your sources too long. 1214;; From Irix6.1 (but not 6.0?) dbx supported an undocumented feature 1215;; whereby `set $stopformat=1' reportedly produces output compatible 1216;; with `gud-dbx-marker-filter', which we prefer. 1217 1218;; The process filter is also somewhat 1219;; unreliable, sometimes not spotting the markers; I don't know 1220;; whether there's anything that can be done about that.] 1221 1222;; this filter is influenced by the xdb one rather than the gdb one 1223(defun gud-irixdbx-marker-filter (string) 1224 (let (result (case-fold-search nil)) 1225 (if (or (string-match comint-prompt-regexp string) 1226 (string-match ".*\012" string)) 1227 (setq result (concat gud-marker-acc string) 1228 gud-marker-acc "") 1229 (setq gud-marker-acc (concat gud-marker-acc string))) 1230 (if result 1231 (cond 1232 ;; look for breakpoint or signal indication e.g.: 1233 ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0] 1234 ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8] 1235 ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188] 1236 ((string-match 1237 "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" 1238 result) 1239 ;; prod dbx into printing out the line number and file 1240 ;; name in a form we can grok as below 1241 (process-send-string (get-buffer-process gud-comint-buffer) 1242 "printf \"\032\032%1d:\",(int)$curline;file\n")) 1243 ;; look for result of, say, "up" e.g.: 1244 ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] 1245 ;; (this will also catch one of the lines printed by "where") 1246 ((string-match 1247 "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" 1248 result) 1249 (let ((file (match-string 1 result))) 1250 (if (file-exists-p file) 1251 (setq gud-last-frame 1252 (cons (match-string 1 result) 1253 (string-to-number (match-string 2 result)))))) 1254 result) 1255 ((string-match ; kluged-up marker as above 1256 "\032\032\\([0-9]*\\):\\(.*\\)\n" result) 1257 (let ((file (gud-file-name (match-string 2 result)))) 1258 (if (and file (file-exists-p file)) 1259 (setq gud-last-frame 1260 (cons file 1261 (string-to-number (match-string 1 result)))))) 1262 (setq result (substring result 0 (match-beginning 0)))))) 1263 (or result ""))) 1264 1265;; There are a couple of differences between DG's dbx output and normal 1266;; dbx output which make it nontrivial to integrate this into the 1267;; standard dbx-marker-filter (mainly, there are a different number of 1268;; backreferences). The markers look like: 1269;; 1270;; (0) Stopped at line 10, routine main(argc=1, argv=0xeffff0e0), file t.c 1271;; 1272;; from breakpoints (the `(0)' there isn't constant, it's the breakpoint 1273;; number), and 1274;; 1275;; Stopped at line 13, routine main(argc=1, argv=0xeffff0e0), file t.c 1276;; 1277;; from signals and 1278;; 1279;; Frame 21, line 974, routine command_loop(), file keyboard.c 1280;; 1281;; from up/down/where. 1282 1283(defun gud-dguxdbx-marker-filter (string) 1284 (setq gud-marker-acc (if gud-marker-acc 1285 (concat gud-marker-acc string) 1286 string)) 1287 (let ((re (concat "^\\(\\(([0-9]+) \\)?Stopped at\\|Frame [0-9]+,\\)" 1288 " line \\([0-9]+\\), routine .*, file \\([^ \t\n]+\\)")) 1289 start) 1290 ;; Process all complete markers in this chunk. 1291 (while (string-match re gud-marker-acc start) 1292 (setq gud-last-frame 1293 (cons (match-string 4 gud-marker-acc) 1294 (string-to-number (match-string 3 gud-marker-acc))) 1295 start (match-end 0))) 1296 1297 ;; Search for the last incomplete line in this chunk 1298 (while (string-match "\n" gud-marker-acc start) 1299 (setq start (match-end 0))) 1300 1301 ;; If the incomplete line APPEARS to begin with another marker, keep it 1302 ;; in the accumulator. Otherwise, clear the accumulator to avoid an 1303 ;; unnecessary concat during the next call. 1304 (setq gud-marker-acc 1305 (if (string-match "Stopped\\|Frame" gud-marker-acc start) 1306 (substring gud-marker-acc (match-beginning 0)) 1307 nil))) 1308 string) 1309 1310;;;###autoload 1311(defun dbx (command-line) 1312 "Run dbx on program FILE in buffer *gud-FILE*. 1313The directory containing FILE becomes the initial working directory 1314and source-file directory for your debugger." 1315 (interactive (list (gud-query-cmdline 'dbx))) 1316 1317 (cond 1318 (gud-mips-p 1319 (gud-common-init command-line nil 'gud-mipsdbx-marker-filter)) 1320 (gud-irix-p 1321 (gud-common-init command-line 'gud-dbx-massage-args 1322 'gud-irixdbx-marker-filter)) 1323 (t 1324 (gud-common-init command-line 'gud-dbx-massage-args 1325 'gud-dbx-marker-filter))) 1326 1327 (set (make-local-variable 'gud-minor-mode) 'dbx) 1328 1329 (cond 1330 (gud-mips-p 1331 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") 1332 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") 1333 (gud-def gud-break "stop at \"%f\":%l" 1334 "\C-b" "Set breakpoint at current line.") 1335 (gud-def gud-finish "return" "\C-f" "Finish executing current function.")) 1336 (gud-irix-p 1337 (gud-def gud-break "stop at \"%d%f\":%l" 1338 "\C-b" "Set breakpoint at current line.") 1339 (gud-def gud-finish "return" "\C-f" "Finish executing current function.") 1340 (gud-def gud-up "up %p; printf \"\032\032%1d:\",(int)$curline;file\n" 1341 "<" "Up (numeric arg) stack frames.") 1342 (gud-def gud-down "down %p; printf \"\032\032%1d:\",(int)$curline;file\n" 1343 ">" "Down (numeric arg) stack frames.") 1344 ;; Make dbx give out the source location info that we need. 1345 (process-send-string (get-buffer-process gud-comint-buffer) 1346 "printf \"\032\032%1d:\",(int)$curline;file\n")) 1347 (t 1348 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") 1349 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") 1350 (gud-def gud-break "file \"%d%f\"\nstop at %l" 1351 "\C-b" "Set breakpoint at current line.") 1352 (if gud-dbx-use-stopformat-p 1353 (process-send-string (get-buffer-process gud-comint-buffer) 1354 "set $stopformat=1\n")))) 1355 1356 (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") 1357 (gud-def gud-step "step %p" "\C-s" "Step one line with display.") 1358 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") 1359 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") 1360 (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") 1361 (gud-def gud-cont "cont" "\C-r" "Continue with display.") 1362 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") 1363 (gud-def gud-run "run" nil "Run the program.") 1364 1365 (setq comint-prompt-regexp "^[^)\n]*dbx) *") 1366 (setq paragraph-start comint-prompt-regexp) 1367 (run-hooks 'dbx-mode-hook) 1368 ) 1369 1370;; ====================================================================== 1371;; xdb (HP PA-RISC debugger) functions 1372 1373;; History of argument lists passed to xdb. 1374(defvar gud-xdb-history nil) 1375 1376(defcustom gud-xdb-directories nil 1377 "A list of directories that xdb should search for source code. 1378If nil, only source files in the program directory 1379will be known to xdb. 1380 1381The file names should be absolute, or relative to the directory 1382containing the executable being debugged." 1383 :type '(choice (const :tag "Current Directory" nil) 1384 (repeat :value ("") 1385 directory)) 1386 :group 'gud) 1387 1388(defun gud-xdb-massage-args (_file args) 1389 (nconc (let ((directories gud-xdb-directories) 1390 (result nil)) 1391 (while directories 1392 (setq result (cons (car directories) (cons "-d" result))) 1393 (setq directories (cdr directories))) 1394 (nreverse result)) 1395 args)) 1396 1397;; xdb does not print the lines all at once, so we have to accumulate them 1398(defun gud-xdb-marker-filter (string) 1399 (let (result) 1400 (if (or (string-match comint-prompt-regexp string) 1401 (string-match ".*\012" string)) 1402 (setq result (concat gud-marker-acc string) 1403 gud-marker-acc "") 1404 (setq gud-marker-acc (concat gud-marker-acc string))) 1405 (if result 1406 (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]" 1407 result) 1408 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" 1409 result)) 1410 (let ((line (string-to-number (match-string 2 result))) 1411 (file (gud-file-name (match-string 1 result)))) 1412 (if file 1413 (setq gud-last-frame (cons file line)))))) 1414 (or result ""))) 1415 1416;;;###autoload 1417(defun xdb (command-line) 1418 "Run xdb on program FILE in buffer *gud-FILE*. 1419The directory containing FILE becomes the initial working directory 1420and source-file directory for your debugger. 1421 1422You can set the variable `gud-xdb-directories' to a list of program source 1423directories if your program contains sources from more than one directory." 1424 (interactive (list (gud-query-cmdline 'xdb))) 1425 1426 (gud-common-init command-line 'gud-xdb-massage-args 1427 'gud-xdb-marker-filter) 1428 (set (make-local-variable 'gud-minor-mode) 'xdb) 1429 1430 (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") 1431 (gud-def gud-tbreak "b %f:%l\\t" "\C-t" 1432 "Set temporary breakpoint at current line.") 1433 (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line") 1434 (gud-def gud-step "s %p" "\C-s" "Step one line with display.") 1435 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") 1436 (gud-def gud-cont "c" "\C-r" "Continue with display.") 1437 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") 1438 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") 1439 (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.") 1440 (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.") 1441 1442 (setq comint-prompt-regexp "^>") 1443 (setq paragraph-start comint-prompt-regexp) 1444 (run-hooks 'xdb-mode-hook)) 1445 1446;; ====================================================================== 1447;; perldb functions 1448 1449;; History of argument lists passed to perldb. 1450(defvar gud-perldb-history nil) 1451 1452(defun gud-perldb-massage-args (_file args) 1453 "Convert a command line as would be typed normally to run perldb 1454into one that invokes an Emacs-enabled debugging session. 1455\"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." 1456 ;; FIXME: what if the command is `make perldb' and doesn't accept those extra 1457 ;; arguments ? 1458 (let* ((new-args nil) 1459 (seen-e nil) 1460 (shift (lambda () (push (pop args) new-args)))) 1461 1462 ;; Pass all switches and -e scripts through. 1463 (while (and args 1464 (string-match "^-" (car args)) 1465 (not (equal "-" (car args))) 1466 (not (equal "--" (car args)))) 1467 (when (equal "-e" (car args)) 1468 ;; -e goes with the next arg, so shift one extra. 1469 (or (funcall shift) 1470 ;; -e as the last arg is an error in Perl. 1471 (error "No code specified for -e")) 1472 (setq seen-e t)) 1473 (funcall shift)) 1474 1475 (unless seen-e 1476 (if (or (not args) 1477 (string-match "^-" (car args))) 1478 (error "Can't use stdin as the script to debug")) 1479 ;; This is the program name. 1480 (funcall shift)) 1481 1482 ;; If -e specified, make sure there is a -- so -emacs is not taken 1483 ;; as -e macs. 1484 (if (and args (equal "--" (car args))) 1485 (funcall shift) 1486 (and seen-e (push "--" new-args))) 1487 1488 (push "-emacs" new-args) 1489 (while args 1490 (funcall shift)) 1491 1492 (nreverse new-args))) 1493 1494;; There's no guarantee that Emacs will hand the filter the entire 1495;; marker at once; it could be broken up across several strings. We 1496;; might even receive a big chunk with several markers in it. If we 1497;; receive a chunk of text which looks like it might contain the 1498;; beginning of a marker, we save it here between calls to the 1499;; filter. 1500(defun gud-perldb-marker-filter (string) 1501 (setq gud-marker-acc (concat gud-marker-acc string)) 1502 (let ((output "")) 1503 1504 ;; Process all the complete markers in this chunk. 1505 ;; 1506 ;; Here I match the string coming out of perldb. 1507 ;; The strings can look like any of 1508 ;; 1509 ;; "\032\032/tmp/tst.pl:6:0\n" 1510 ;; "\032\032(eval 5)[/tmp/tst.pl:6]:3:0\n" 1511 ;; "\032\032(eval 17)[Basic/Core/Core.pm.PL (i.e. PDL::Core.pm):2931]:1:0\n" 1512 ;; 1513 ;; From those I want the filename and the line number. First I look for 1514 ;; the eval case. If that doesn't match, I look for the "normal" case. 1515 (while 1516 (string-match 1517 (eval-when-compile 1518 (let ((file-re "\\(?:[a-zA-Z]:\\)?[^:\n]*")) 1519 (concat "\032\032\\(?:" 1520 (concat 1521 "(eval [0-9]+)\\[" 1522 "\\(" file-re "\\)" ; Filename. 1523 "\\(?: (i\\.e\\. [^)]*)\\)?" 1524 ":\\([0-9]*\\)\\]") ; Line number. 1525 "\\|" 1526 (concat 1527 "\\(?1:" file-re "\\)" ; Filename. 1528 ":\\(?2:[0-9]*\\)") ; Line number. 1529 "\\):.*\n"))) 1530 gud-marker-acc) 1531 (setq 1532 1533 ;; Extract the frame position from the marker. 1534 gud-last-frame 1535 (cons (match-string 1 gud-marker-acc) 1536 (string-to-number (match-string 2 gud-marker-acc))) 1537 1538 ;; Append any text before the marker to the output we're going 1539 ;; to return - we don't include the marker in this text. 1540 output (concat output 1541 (substring gud-marker-acc 0 (match-beginning 0))) 1542 1543 ;; Set the accumulator to the remaining text. 1544 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 1545 1546 ;; Does the remaining text look like it might end with the 1547 ;; beginning of another marker? If it does, then keep it in 1548 ;; gud-marker-acc until we receive the rest of it. Since we 1549 ;; know the full marker regexp above failed, it's pretty simple to 1550 ;; test for marker starts. 1551 (if (string-match "\032.*\\'" gud-marker-acc) 1552 (progn 1553 ;; Everything before the potential marker start can be output. 1554 (setq output (concat output (substring gud-marker-acc 1555 0 (match-beginning 0)))) 1556 1557 ;; Everything after, we save, to combine with later input. 1558 (setq gud-marker-acc 1559 (substring gud-marker-acc (match-beginning 0)))) 1560 1561 (setq output (concat output gud-marker-acc) 1562 gud-marker-acc "")) 1563 1564 output)) 1565 1566(defcustom gud-perldb-command-name "perl -d" 1567 "Default command to execute a Perl script under debugger." 1568 :type 'string 1569 :group 'gud) 1570 1571;;;###autoload 1572(defun perldb (command-line) 1573 "Run perldb on program FILE in buffer *gud-FILE*. 1574The directory containing FILE becomes the initial working directory 1575and source-file directory for your debugger." 1576 (interactive 1577 (list (gud-query-cmdline 'perldb 1578 (concat (or (buffer-file-name) "-e 0") " ")))) 1579 1580 (gud-common-init command-line 'gud-perldb-massage-args 1581 'gud-perldb-marker-filter) 1582 (set (make-local-variable 'gud-minor-mode) 'perldb) 1583 1584 (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") 1585 (gud-def gud-remove "B %l" "\C-d" "Remove breakpoint at current line") 1586 (gud-def gud-step "s" "\C-s" "Step one source line with display.") 1587 (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") 1588 (gud-def gud-cont "c" "\C-r" "Continue with display.") 1589; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") 1590; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") 1591; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") 1592 (gud-def gud-print "p %e" "\C-p" "Evaluate perl expression at point.") 1593 (gud-def gud-until "c %l" "\C-u" "Continue to current line.") 1594 1595 1596 (setq comint-prompt-regexp "^ DB<+[0-9]+>+ ") 1597 (setq paragraph-start comint-prompt-regexp) 1598 (run-hooks 'perldb-mode-hook)) 1599 1600;; ====================================================================== 1601;; pdb (Python debugger) functions 1602 1603;; History of argument lists passed to pdb. 1604(defvar gud-pdb-history nil) 1605 1606;; Last group is for return value, e.g. "> test.py(2)foo()->None" 1607;; Either file or function name may be omitted: "> <string>(0)?()" 1608;; 1609;; We use [:graph:] to be very allowing with regards to which 1610;; characters we match in the file name shown in the prompt. 1611;; (Of course, this matches the "<string>" case too.) 1612(defvar gud-pdb-marker-regexp 1613 (concat "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|" 1614 "<\\(?:module\\|listcomp\\|dictcomp\\|setcomp\\|genexpr\\|lambda\\|\\)>" 1615 "\\)()\\(->[^\n\r]*\\)?[\n\r]")) 1616 1617(defvar gud-pdb-marker-regexp-file-group 1) 1618(defvar gud-pdb-marker-regexp-line-group 2) 1619(defvar gud-pdb-marker-regexp-fnname-group 3) 1620 1621(defvar gud-pdb-marker-regexp-start "^> ") 1622 1623;; There's no guarantee that Emacs will hand the filter the entire 1624;; marker at once; it could be broken up across several strings. We 1625;; might even receive a big chunk with several markers in it. If we 1626;; receive a chunk of text which looks like it might contain the 1627;; beginning of a marker, we save it here between calls to the 1628;; filter. 1629(defun gud-pdb-marker-filter (string) 1630 (setq gud-marker-acc (concat gud-marker-acc string)) 1631 (let ((output "")) 1632 1633 ;; Process all the complete markers in this chunk. 1634 (while (string-match gud-pdb-marker-regexp gud-marker-acc) 1635 (setq 1636 1637 ;; Extract the frame position from the marker. 1638 gud-last-frame 1639 (let ((file (match-string gud-pdb-marker-regexp-file-group 1640 gud-marker-acc)) 1641 (line (string-to-number 1642 (match-string gud-pdb-marker-regexp-line-group 1643 gud-marker-acc)))) 1644 (if (string-equal file "<string>") 1645 gud-last-frame 1646 (cons file line))) 1647 1648 ;; Output everything instead of the below 1649 output (concat output (substring gud-marker-acc 0 (match-end 0))) 1650;; ;; Append any text before the marker to the output we're going 1651;; ;; to return - we don't include the marker in this text. 1652;; output (concat output 1653;; (substring gud-marker-acc 0 (match-beginning 0))) 1654 1655 ;; Set the accumulator to the remaining text. 1656 gud-marker-acc (substring gud-marker-acc (match-end 0)))) 1657 1658 ;; Does the remaining text look like it might end with the 1659 ;; beginning of another marker? If it does, then keep it in 1660 ;; gud-marker-acc until we receive the rest of it. Since we 1661 ;; know the full marker regexp above failed, it's pretty simple to 1662 ;; test for marker starts. 1663 (if (string-match gud-pdb-marker-regexp-start gud-marker-acc) 1664 (progn 1665 ;; Everything before the potential marker start can be output. 1666 (setq output (concat output (substring gud-marker-acc 1667 0 (match-beginning 0)))) 1668 1669 ;; Everything after, we save, to combine with later input. 1670 (setq gud-marker-acc 1671 (substring gud-marker-acc (match-beginning 0)))) 1672 1673 (setq output (concat output gud-marker-acc) 1674 gud-marker-acc "")) 1675 1676 output)) 1677 1678(defcustom gud-pdb-command-name 1679 (if (executable-find "pdb") "pdb" "python -m pdb") 1680 "Command that executes the Python debugger." 1681 :version "27.1" 1682 :type 'string 1683 :group 'gud) 1684 1685;;;###autoload 1686(defun pdb (command-line) 1687 "Run COMMAND-LINE in the `*gud-FILE*' buffer. 1688 1689COMMAND-LINE should include the pdb executable 1690name (`gud-pdb-command-name') and the file to be debugged. 1691 1692If called interactively, the command line will be prompted for. 1693 1694The directory containing this file becomes the initial working 1695directory and source-file directory for your debugger." 1696 (interactive 1697 (list (gud-query-cmdline 'pdb))) 1698 1699 (gud-common-init command-line nil 'gud-pdb-marker-filter) 1700 (set (make-local-variable 'gud-minor-mode) 'pdb) 1701 1702 (gud-def gud-break "break %d%f:%l" "\C-b" "Set breakpoint at current line.") 1703 (gud-def gud-remove "clear %d%f:%l" "\C-d" "Remove breakpoint at current line") 1704 (gud-def gud-step "step" "\C-s" "Step one source line with display.") 1705 (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") 1706 (gud-def gud-cont "continue" "\C-r" "Continue with display.") 1707 (gud-def gud-finish "return" "\C-f" "Finish executing current function.") 1708 (gud-def gud-up "up" "<" "Up one stack frame.") 1709 (gud-def gud-down "down" ">" "Down one stack frame.") 1710 (gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at point.") 1711 (gud-def gud-statement "!%e" "\C-e" "Execute Python statement at point.") 1712 1713 ;; (setq comint-prompt-regexp "^(.*pdb[+]?) *") 1714 (setq comint-prompt-regexp "^(Pdb) *") 1715 (setq paragraph-start comint-prompt-regexp) 1716 (run-hooks 'pdb-mode-hook)) 1717 1718;; ====================================================================== 1719;; Guile REPL (guiler) functions 1720 1721;; History of argument lists passed to guiler. 1722(defvar gud-guiler-history nil) 1723 1724(defvar gud-guiler-lastfile nil) 1725 1726(defun gud-guiler-marker-filter (string) 1727 (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) 1728 1729 (let ((start 0)) 1730 (while 1731 (cond 1732 ((string-match "^In \\(.*\\):" gud-marker-acc start) 1733 (setq gud-guiler-lastfile (match-string 1 gud-marker-acc))) 1734 ((string-match "^\\([^:\n]+\\):\\([0-9]+\\):\\([0-9]+\\):[^\n]*" 1735 gud-marker-acc start) 1736 (setq gud-guiler-lastfile (match-string 1 gud-marker-acc)) 1737 (setq gud-last-frame 1738 (cons gud-guiler-lastfile 1739 (string-to-number (match-string 2 gud-marker-acc))))) 1740 ((string-match "^[ ]*\\([0-9]+\\):\\([0-9]+\\) [^\n]*" 1741 gud-marker-acc start) 1742 (if gud-guiler-lastfile 1743 (setq gud-last-frame 1744 (cons gud-guiler-lastfile 1745 (string-to-number (match-string 1 gud-marker-acc)))))) 1746 ((string-match comint-prompt-regexp gud-marker-acc start) t) 1747 ((string= (substring gud-marker-acc start) "") nil) 1748 (t nil)) 1749 (setq start (match-end 0))) 1750 1751 ;; Search for the last incomplete line in this chunk 1752 (while (string-match "\n" gud-marker-acc start) 1753 (setq start (match-end 0))) 1754 1755 ;; If we have an incomplete line, store it in gud-marker-acc. 1756 (setq gud-marker-acc (substring gud-marker-acc (or start 0)))) 1757 string) 1758 1759 1760(defcustom gud-guiler-command-name "guile" 1761 "File name for executing the Guile debugger. 1762This should be an executable on your path, or an absolute file name." 1763 :version "25.1" 1764 :type 'string 1765 :group 'gud) 1766 1767;;;###autoload 1768(defun guiler (command-line) 1769 "Run guiler on program FILE in buffer `*gud-FILE*'. 1770The directory containing FILE becomes the initial working directory 1771and source-file directory for your debugger." 1772 (interactive 1773 (list (gud-query-cmdline 'guiler))) 1774 1775 (gud-common-init command-line nil 'gud-guiler-marker-filter) 1776 (setq-local gud-minor-mode 'guiler) 1777 1778;; FIXME: absolute file-names are not grokked yet by Guile's ,break-at-source 1779;; and relative file names only when relative to %load-path. 1780;; (gud-def gud-break ",break-at-source %d%f %l" "\C-b" "Set breakpoint at current line.") 1781 (gud-def gud-break ",break-at-source %f %l" "\C-b" "Set breakpoint at current line.") 1782;; FIXME: remove breakpoint with file-line not yet supported by Guile 1783;; (gud-def gud-remove ",delete ---> %d%f:%l" "\C-d" "Remove breakpoint at current line") 1784 (gud-def gud-step ",step" "\C-s" "Step one source line with display.") 1785 (gud-def gud-next ",next" "\C-n" "Step one line (skip functions).") 1786;; (gud-def gud-cont "continue" "\C-r" "Continue with display.") 1787 (gud-def gud-finish ",finish" "\C-f" "Finish executing current function.") 1788 (gud-def gud-up ",up" "<" "Up one stack frame.") 1789 (gud-def gud-down ",down" ">" "Down one stack frame.") 1790 (gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at point.") 1791 1792 (setq comint-prompt-regexp "^scheme@([^>]+> ") 1793 (setq paragraph-start comint-prompt-regexp) 1794 (run-hooks 'guiler-mode-hook)) 1795 1796;; ====================================================================== 1797;; 1798;; JDB support. 1799;; 1800;; AUTHOR: Derek Davies <ddavies@world.std.com> 1801;; Zoltan Kemenczy <zoltan@ieee.org;zkemenczy@rim.net> 1802;; 1803;; CREATED: Sun Feb 22 10:46:38 1998 Derek Davies. 1804;; UPDATED: Nov 11, 2001 Zoltan Kemenczy 1805;; Dec 10, 2002 Zoltan Kemenczy - added nested class support 1806;; 1807;; INVOCATION NOTES: 1808;; 1809;; You invoke jdb-mode with: 1810;; 1811;; M-x jdb <enter> 1812;; 1813;; It responds with: 1814;; 1815;; Run jdb (like this): jdb 1816;; 1817;; type any jdb switches followed by the name of the class you'd like to debug. 1818;; Supply a fully qualified classname (these don't have the ".class" extension) 1819;; for the name of the class to debug (e.g. "COM.the-kind.ddavies.CoolClass"). 1820;; See the known problems section below for restrictions when specifying jdb 1821;; command line switches (search forward for '-classpath'). 1822;; 1823;; You should see something like the following: 1824;; 1825;; Current directory is ~/src/java/hello/ 1826;; Initializing jdb... 1827;; 0xed2f6628:class(hello) 1828;; > 1829;; 1830;; To set an initial breakpoint try: 1831;; 1832;; > stop in hello.main 1833;; Breakpoint set in hello.main 1834;; > 1835;; 1836;; To execute the program type: 1837;; 1838;; > run 1839;; run hello 1840;; 1841;; Breakpoint hit: running ... 1842;; hello.main (hello:12) 1843;; 1844;; Type M-n to step over the current line and M-s to step into it. That, 1845;; along with the JDB 'help' command should get you started. The 'quit' 1846;; JDB command will get out of the debugger. There is some truly 1847;; pathetic JDB documentation available at: 1848;; 1849;; http://java.sun.com/products/jdk/1.1/debugging/ 1850;; 1851;; KNOWN PROBLEMS AND FIXME's: 1852;; 1853;; Not sure what happens with inner classes ... haven't tried them. 1854;; 1855;; Does not grok UNICODE id's. Only ASCII id's are supported. 1856;; 1857;; You must not put whitespace between "-classpath" and the path to 1858;; search for java classes even though it is required when invoking jdb 1859;; from the command line. See gud-jdb-massage-args for details. 1860;; The same applies for "-sourcepath". 1861;; 1862;; Note: The following applies only if `gud-jdb-use-classpath' is nil; 1863;; refer to the documentation of `gud-jdb-use-classpath' and 1864;; `gud-jdb-classpath',`gud-jdb-sourcepath' variables for information 1865;; on using the classpath for locating java source files. 1866;; 1867;; If any of the source files in the directories listed in 1868;; gud-jdb-directories won't parse you'll have problems. Make sure 1869;; every file ending in ".java" in these directories parses without error. 1870;; 1871;; All the .java files in the directories in gud-jdb-directories are 1872;; syntactically analyzed each time gud jdb is invoked. It would be 1873;; nice to keep as much information as possible between runs. It would 1874;; be really nice to analyze the files only as necessary (when the 1875;; source needs to be displayed.) I'm not sure to what extent the former 1876;; can be accomplished and I'm not sure the latter can be done at all 1877;; since I don't know of any general way to tell which .class files are 1878;; defined by which .java file without analyzing all the .java files. 1879;; If anyone knows why JavaSoft didn't put the source file names in 1880;; debuggable .class files please clue me in so I find something else 1881;; to be spiteful and bitter about. 1882;; 1883;; ====================================================================== 1884;; gud jdb variables and functions 1885 1886(defcustom gud-jdb-command-name "jdb" 1887 "Command that executes the Java debugger." 1888 :type 'string 1889 :group 'gud) 1890 1891(defcustom gud-jdb-use-classpath t 1892 "If non-nil, search for Java source files in classpath directories. 1893The list of directories to search is the value of `gud-jdb-classpath'. 1894The file pathname is obtained by converting the fully qualified 1895class information output by jdb to a relative pathname and appending 1896it to `gud-jdb-classpath' element by element until a match is found. 1897 1898This method has a significant jdb startup time reduction advantage 1899since it does not require the scanning of all `gud-jdb-directories' 1900and parsing all Java files for class information. 1901 1902Set to nil to use `gud-jdb-directories' to scan java sources for 1903class information on jdb startup (original method)." 1904 :type 'boolean 1905 :group 'gud) 1906 1907(defvar gud-jdb-classpath nil 1908 "Java/jdb classpath directories list. 1909If `gud-jdb-use-classpath' is non-nil, gud-jdb derives the `gud-jdb-classpath' 1910list automatically using the following methods in sequence 1911\(with subsequent successful steps overriding the results of previous 1912steps): 1913 19141) Read the CLASSPATH environment variable, 19152) Read any \"-classpath\" argument used to run jdb, 1916 or detected in jdb output (e.g. if jdb is run by a script 1917 that echoes the actual jdb command before starting jdb), 19183) Send a \"classpath\" command to jdb and scan jdb output for 1919 classpath information if jdb is invoked with an \"-attach\" (to 1920 an already running VM) argument (This case typically does not 1921 have a \"-classpath\" command line argument - that is provided 1922 to the VM when it is started). 1923 1924Note that method 3 cannot be used with oldjdb (or Java 1 jdb) since 1925those debuggers do not support the classpath command. Use 1) or 2).") 1926 1927(defvar gud-jdb-sourcepath nil 1928 "Directory list provided by an (optional) \"-sourcepath\" option to jdb. 1929This list is prepended to `gud-jdb-classpath' to form the complete 1930list of directories searched for source files.") 1931 1932(defvar gud-marker-acc-max-length 4000 1933 "Maximum number of debugger output characters to keep. 1934This variable limits the size of `gud-marker-acc' which holds 1935the most recent debugger output history while searching for 1936source file information.") 1937 1938(defvar gud-jdb-history nil 1939 "History of argument lists passed to jdb.") 1940 1941 1942;; List of Java source file directories. 1943(defvar gud-jdb-directories (list ".") 1944 "A list of directories that gud jdb should search for source code. 1945The file names should be absolute, or relative to the current 1946directory. 1947 1948The set of .java files residing in the directories listed are 1949syntactically analyzed to determine the classes they define and the 1950packages in which these classes belong. In this way gud jdb maps the 1951package-qualified class names output by the jdb debugger to the source 1952file from which the class originated. This allows gud mode to keep 1953the source code display in sync with the debugging session.") 1954 1955(defvar gud-jdb-source-files nil 1956 "List of the java source files for this debugging session.") 1957 1958;; Association list of fully qualified class names (package + class name) 1959;; and their source files. 1960(defvar gud-jdb-class-source-alist nil 1961 "Association list of fully qualified class names and source files.") 1962 1963;; This is used to hold a source file during analysis. 1964(defvar gud-jdb-analysis-buffer nil) 1965 1966(defvar gud-jdb-classpath-string nil 1967 "Holds temporary classpath values.") 1968 1969(defun gud-jdb-build-source-files-list (path extn) 1970 "Return a list of java source files (absolute paths). 1971PATH gives the directories in which to search for files with 1972extension EXTN. Normally EXTN is given as the regular expression 1973 \"\\.java$\" ." 1974 (mapcan (lambda (d) 1975 (when (file-directory-p d) 1976 (directory-files d t extn nil))) 1977 path)) 1978 1979;; Move point past whitespace. 1980(defun gud-jdb-skip-whitespace () 1981 (skip-chars-forward " \n\r\t\014")) 1982 1983;; Move point past a "// <eol>" type of comment. 1984(defun gud-jdb-skip-single-line-comment () 1985 (end-of-line)) 1986 1987;; Move point past a "/* */" or "/** */" type of comment. 1988(defun gud-jdb-skip-traditional-or-documentation-comment () 1989 (forward-char 2) 1990 (catch 'break 1991 (while (not (eobp)) 1992 (if (eq (following-char) ?*) 1993 (progn 1994 (forward-char) 1995 (if (not (eobp)) 1996 (if (eq (following-char) ?/) 1997 (progn 1998 (forward-char) 1999 (throw 'break nil))))) 2000 (forward-char))))) 2001 2002;; Move point past any number of consecutive whitespace chars and/or comments. 2003(defun gud-jdb-skip-whitespace-and-comments () 2004 (gud-jdb-skip-whitespace) 2005 (catch 'done 2006 (while t 2007 (cond 2008 ((looking-at "//") 2009 (gud-jdb-skip-single-line-comment) 2010 (gud-jdb-skip-whitespace)) 2011 ((looking-at "/\\*") 2012 (gud-jdb-skip-traditional-or-documentation-comment) 2013 (gud-jdb-skip-whitespace)) 2014 (t (throw 'done nil)))))) 2015 2016;; Move point past things that are id-like. The intent is to skip regular 2017;; id's, such as class or interface names as well as package and interface 2018;; names. 2019(defun gud-jdb-skip-id-ish-thing () 2020 (skip-chars-forward "^ /\n\r\t\014,;{")) 2021 2022;; Move point past a string literal. 2023(defun gud-jdb-skip-string-literal () 2024 (forward-char) 2025 (while (not (cond 2026 ((eq (following-char) ?\\) 2027 (forward-char)) 2028 ((eq (following-char) ?\042)))) 2029 (forward-char)) 2030 (forward-char)) 2031 2032;; Move point past a character literal. 2033(defun gud-jdb-skip-character-literal () 2034 (forward-char) 2035 (while 2036 (progn 2037 (if (eq (following-char) ?\\) 2038 (forward-char 2)) 2039 (not (eq (following-char) ?\'))) 2040 (forward-char)) 2041 (forward-char)) 2042 2043;; Move point past the following block. There may be (legal) cruft before 2044;; the block's opening brace. There must be a block or it's the end of life 2045;; in petticoat junction. 2046(defun gud-jdb-skip-block () 2047 2048 ;; Find the beginning of the block. 2049 (while 2050 (not (eq (following-char) ?{)) 2051 2052 ;; Skip any constructs that can harbor literal block delimiter 2053 ;; characters and/or the delimiters for the constructs themselves. 2054 (cond 2055 ((looking-at "//") 2056 (gud-jdb-skip-single-line-comment)) 2057 ((looking-at "/\\*") 2058 (gud-jdb-skip-traditional-or-documentation-comment)) 2059 ((eq (following-char) ?\042) 2060 (gud-jdb-skip-string-literal)) 2061 ((eq (following-char) ?\') 2062 (gud-jdb-skip-character-literal)) 2063 (t (forward-char)))) 2064 2065 ;; Now at the beginning of the block. 2066 (forward-char) 2067 2068 ;; Skip over the body of the block as well as the final brace. 2069 (let ((open-level 1)) 2070 (while (not (eq open-level 0)) 2071 (cond 2072 ((looking-at "//") 2073 (gud-jdb-skip-single-line-comment)) 2074 ((looking-at "/\\*") 2075 (gud-jdb-skip-traditional-or-documentation-comment)) 2076 ((eq (following-char) ?\042) 2077 (gud-jdb-skip-string-literal)) 2078 ((eq (following-char) ?\') 2079 (gud-jdb-skip-character-literal)) 2080 ((eq (following-char) ?{) 2081 (setq open-level (+ open-level 1)) 2082 (forward-char)) 2083 ((eq (following-char) ?}) 2084 (setq open-level (- open-level 1)) 2085 (forward-char)) 2086 (t (forward-char)))))) 2087 2088;; Find the package and class definitions in Java source file FILE. Assumes 2089;; that FILE contains a legal Java program. BUF is a scratch buffer used 2090;; to hold the source during analysis. 2091(defun gud-jdb-analyze-source (buf file) 2092 (let ((l nil)) 2093 (set-buffer buf) 2094 (insert-file-contents file nil nil nil t) 2095 (goto-char 0) 2096 (catch 'abort 2097 (let ((p "")) 2098 (while (progn 2099 (gud-jdb-skip-whitespace) 2100 (not (eobp))) 2101 (cond 2102 2103 ;; Any number of semi's following a block is legal. Move point 2104 ;; past them. Note that comments and whitespace may be 2105 ;; interspersed as well. 2106 ((eq (following-char) ?\073) 2107 (forward-char)) 2108 2109 ;; Move point past a single line comment. 2110 ((looking-at "//") 2111 (gud-jdb-skip-single-line-comment)) 2112 2113 ;; Move point past a traditional or documentation comment. 2114 ((looking-at "/\\*") 2115 (gud-jdb-skip-traditional-or-documentation-comment)) 2116 2117 ;; Move point past a package statement, but save the PackageName. 2118 ((looking-at "package") 2119 (forward-char 7) 2120 (gud-jdb-skip-whitespace-and-comments) 2121 (let ((s (point))) 2122 (gud-jdb-skip-id-ish-thing) 2123 (setq p (concat (buffer-substring s (point)) ".")) 2124 (gud-jdb-skip-whitespace-and-comments) 2125 (if (eq (following-char) ?\073) 2126 (forward-char)))) 2127 2128 ;; Move point past an import statement. 2129 ((looking-at "import") 2130 (forward-char 6) 2131 (gud-jdb-skip-whitespace-and-comments) 2132 (gud-jdb-skip-id-ish-thing) 2133 (gud-jdb-skip-whitespace-and-comments) 2134 (if (eq (following-char) ?\073) 2135 (forward-char))) 2136 2137 ;; Move point past the various kinds of ClassModifiers. 2138 ((looking-at "public") 2139 (forward-char 6)) 2140 ((looking-at "abstract") 2141 (forward-char 8)) 2142 ((looking-at "final") 2143 (forward-char 5)) 2144 2145 ;; Move point past a ClassDeclaration, but save the class 2146 ;; Identifier. 2147 ((looking-at "class") 2148 (forward-char 5) 2149 (gud-jdb-skip-whitespace-and-comments) 2150 (let ((s (point))) 2151 (gud-jdb-skip-id-ish-thing) 2152 (setq 2153 l (nconc l (list (concat p (buffer-substring s (point))))))) 2154 (gud-jdb-skip-block)) 2155 2156 ;; Move point past an interface statement. 2157 ((looking-at "interface") 2158 (forward-char 9) 2159 (gud-jdb-skip-block)) 2160 2161 ;; Anything else means the input is invalid. 2162 (t 2163 (message "Error parsing file %s." file) 2164 (throw 'abort nil)))))) 2165 l)) 2166 2167(defun gud-jdb-build-class-source-alist-for-file (file) 2168 (mapcar 2169 (lambda (c) 2170 (cons c file)) 2171 (gud-jdb-analyze-source gud-jdb-analysis-buffer file))) 2172 2173;; Return an alist of fully qualified classes and the source files 2174;; holding their definitions. SOURCES holds a list of all the source 2175;; files to examine. 2176(defun gud-jdb-build-class-source-alist (sources) 2177 (setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*")) 2178 (prog1 2179 (apply 2180 'nconc 2181 (mapcar 2182 'gud-jdb-build-class-source-alist-for-file 2183 sources)) 2184 (kill-buffer gud-jdb-analysis-buffer) 2185 (setq gud-jdb-analysis-buffer nil))) 2186 2187;; Change what was given in the minibuffer to something that can be used to 2188;; invoke the debugger. 2189(defun gud-jdb-massage-args (_file args) 2190 ;; The jdb executable must have whitespace between "-classpath" and 2191 ;; its value while gud-common-init expects all switch values to 2192 ;; follow the switch keyword without intervening whitespace. We 2193 ;; require that when the user enters the "-classpath" switch in the 2194 ;; EMACS minibuffer that they do so without the intervening 2195 ;; whitespace. This function adds it back (it's called after 2196 ;; gud-common-init). There are more switches like this (for 2197 ;; instance "-host" and "-password") but I don't care about them 2198 ;; yet. 2199 (if args 2200 (let (massaged-args user-error) 2201 2202 (while (and args (not user-error)) 2203 (cond 2204 ((setq user-error (string-match "-classpath$" (car args)))) 2205 ((setq user-error (string-match "-sourcepath$" (car args)))) 2206 ((string-match "-classpath\\(.+\\)" (car args)) 2207 (setq massaged-args 2208 (append massaged-args 2209 (list "-classpath" 2210 (setq gud-jdb-classpath-string 2211 (match-string 1 (car args))))))) 2212 ((string-match "-sourcepath\\(.+\\)" (car args)) 2213 (setq massaged-args 2214 (append massaged-args 2215 (list "-sourcepath" 2216 (setq gud-jdb-sourcepath 2217 (match-string 1 (car args))))))) 2218 (t (setq massaged-args (append massaged-args (list (car args)))))) 2219 (setq args (cdr args))) 2220 2221 ;; By this point the current directory is all screwed up. Maybe we 2222 ;; could fix things and re-invoke gud-common-init, but for now I think 2223 ;; issuing the error is good enough. 2224 (if user-error 2225 (progn 2226 (kill-buffer (current-buffer)) 2227 (error "Error: Omit whitespace between '-classpath or -sourcepath' and its value"))) 2228 massaged-args))) 2229 2230;; Search for an association with P, a fully qualified class name, in 2231;; gud-jdb-class-source-alist. The association gives the fully 2232;; qualified file name of the source file which produced the class. 2233(defun gud-jdb-find-source-file (p) 2234 (cdr (assoc p gud-jdb-class-source-alist))) 2235 2236;; Note: Reset to this value every time a prompt is seen 2237(defvar gud-jdb-lowest-stack-level 999) 2238 2239(defun gud-jdb-find-source-using-classpath (p) 2240 "Find source file corresponding to fully qualified class P. 2241Convert P from jdb's output, converted to a pathname 2242relative to a classpath directory." 2243 (save-match-data 2244 (let 2245 (;; Replace dots with slashes and append ".java" to generate file 2246 ;; name relative to classpath 2247 (filename 2248 (concat 2249 (mapconcat 'identity 2250 (split-string 2251 ;; Eliminate any subclass references in the class 2252 ;; name string. These start with a "$" 2253 (if (string-match "\\$.*" p) 2254 (replace-match "" t t p) p) 2255 "\\.") "/") 2256 ".java")) 2257 (cplist (append gud-jdb-sourcepath gud-jdb-classpath)) 2258 found-file) 2259 (while (and cplist 2260 (not (setq found-file 2261 (file-readable-p 2262 (concat (car cplist) "/" filename))))) 2263 (setq cplist (cdr cplist))) 2264 (if found-file (concat (car cplist) "/" filename))))) 2265 2266(defun gud-jdb-find-source (_string) 2267 "Alias for function used to locate source files. 2268Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file' 2269during jdb initialization depending on the value of 2270`gud-jdb-use-classpath'." 2271 nil) 2272 2273(defun gud-jdb-parse-classpath-string (string) 2274 "Parse the classpath list and convert each item to an absolute pathname." 2275 (mapcar (lambda (s) (if (string-match "[/\\]$" s) 2276 (replace-match "" nil nil s) s)) 2277 (mapcar 'file-truename 2278 (split-string 2279 string 2280 (concat "[ \t\n\r,\"" path-separator "]+"))))) 2281 2282;; See commentary for other debugger's marker filters - there you will find 2283;; important notes about STRING. 2284(defun gud-jdb-marker-filter (string) 2285 2286 ;; Build up the accumulator. 2287 (setq gud-marker-acc 2288 (if gud-marker-acc 2289 (concat gud-marker-acc string) 2290 string)) 2291 2292 ;; Look for classpath information until gud-jdb-classpath-string is found 2293 ;; (interactive, multiple settings of classpath from jdb 2294 ;; not supported/followed) 2295 (if (and gud-jdb-use-classpath 2296 (not gud-jdb-classpath-string) 2297 (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc) 2298 (string-match "-classpath[ \t\"]+\\([^ \"]+\\)" gud-marker-acc))) 2299 (setq gud-jdb-classpath 2300 (gud-jdb-parse-classpath-string 2301 (setq gud-jdb-classpath-string 2302 (match-string 1 gud-marker-acc))))) 2303 2304 ;; We process STRING from left to right. Each time through the 2305 ;; following loop we process at most one marker. After we've found a 2306 ;; marker, delete gud-marker-acc up to and including the match 2307 (let (file-found) 2308 ;; Process each complete marker in the input. 2309 (while 2310 2311 ;; Do we see a marker? 2312 (string-match 2313 ;; jdb puts out a string of the following form when it 2314 ;; hits a breakpoint: 2315 ;; 2316 ;; <fully-qualified-class><method> (<class>:<line-number>) 2317 ;; 2318 ;; <fully-qualified-class>'s are composed of Java ID's 2319 ;; separated by periods. <method> and <class> are 2320 ;; also Java ID's. <method> begins with a period and 2321 ;; may contain less-than and greater-than (constructors, 2322 ;; for instance, are called <init> in the symbol table.) 2323 ;; Java ID's begin with a letter followed by letters 2324 ;; and/or digits. The set of letters includes underscore 2325 ;; and dollar sign. 2326 ;; 2327 ;; The first group matches <fully-qualified-class>, 2328 ;; the second group matches <class> and the third group 2329 ;; matches <line-number>. We don't care about using 2330 ;; <method> so we don't "group" it. 2331 ;; 2332 ;; FIXME: Java ID's are UNICODE strings, this matches ASCII 2333 ;; ID's only. 2334 ;; 2335 ;; The ".," in the last square-bracket are necessary because 2336 ;; of Sun's total disrespect for backwards compatibility in 2337 ;; reported line numbers from jdb - starting in 1.4.0 they 2338 ;; print line numbers using LOCALE, inserting a comma or a 2339 ;; period at the thousands positions (how ingenious!). 2340 2341 "\\(\\[[0-9]+] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \ 2342\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9.,]+\\)" 2343 gud-marker-acc) 2344 2345 ;; A good marker is one that: 2346 ;; 1) does not have a "[n] " prefix (not part of a stack backtrace) 2347 ;; 2) does have an "[n] " prefix and n is the lowest prefix seen 2348 ;; since the last prompt 2349 ;; Figure out the line on which to position the debugging arrow. 2350 ;; Return the info as a cons of the form: 2351 ;; 2352 ;; (<file-name> . <line-number>) . 2353 (if (if (match-beginning 1) 2354 (let (n) 2355 (setq n (string-to-number (substring 2356 gud-marker-acc 2357 (1+ (match-beginning 1)) 2358 (- (match-end 1) 2)))) 2359 (if (< n gud-jdb-lowest-stack-level) 2360 (progn (setq gud-jdb-lowest-stack-level n) t))) 2361 t) 2362 (if (setq file-found 2363 (gud-jdb-find-source (match-string 2 gud-marker-acc))) 2364 (setq gud-last-frame 2365 (cons file-found 2366 (string-to-number 2367 (let 2368 ((numstr (match-string 4 gud-marker-acc))) 2369 (if (string-match "[.,]" numstr) 2370 (replace-match "" nil nil numstr) 2371 numstr))))) 2372 (message "Could not find source file."))) 2373 2374 ;; Set the accumulator to the remaining text. 2375 (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))) 2376 2377 (if (string-match comint-prompt-regexp gud-marker-acc) 2378 (setq gud-jdb-lowest-stack-level 999))) 2379 2380 ;; Do not allow gud-marker-acc to grow without bound. If the source 2381 ;; file information is not within the last 3/4 2382 ;; gud-marker-acc-max-length characters, well,... 2383 (if (> (length gud-marker-acc) gud-marker-acc-max-length) 2384 (setq gud-marker-acc 2385 (substring gud-marker-acc 2386 (- (/ (* gud-marker-acc-max-length 3) 4))))) 2387 2388 ;; We don't filter any debugger output so just return what we were given. 2389 string) 2390 2391(defvar gud-jdb-command-name "jdb" "Command that executes the Java debugger.") 2392 2393;;;###autoload 2394(defun jdb (command-line) 2395 "Run jdb with command line COMMAND-LINE in a buffer. 2396The buffer is named \"*gud*\" if no initial class is given or 2397\"*gud-<initial-class-basename>*\" if there is. If the \"-classpath\" 2398switch is given, omit all whitespace between it and its value. 2399 2400See `gud-jdb-use-classpath' and `gud-jdb-classpath' documentation for 2401information on how jdb accesses source files. Alternatively (if 2402`gud-jdb-use-classpath' is nil), see `gud-jdb-directories' for the 2403original source file access method. 2404 2405For general information about commands available to control jdb from 2406gud, see `gud-mode'." 2407 (interactive 2408 (list (gud-query-cmdline 'jdb))) 2409 (setq gud-jdb-classpath nil) 2410 (setq gud-jdb-sourcepath nil) 2411 2412 ;; Set gud-jdb-classpath from the CLASSPATH environment variable, 2413 ;; if CLASSPATH is set. 2414 (setq gud-jdb-classpath-string (or (getenv "CLASSPATH") ".")) 2415 (if gud-jdb-classpath-string 2416 (setq gud-jdb-classpath 2417 (gud-jdb-parse-classpath-string gud-jdb-classpath-string))) 2418 (setq gud-jdb-classpath-string nil) ; prepare for next 2419 2420 (gud-common-init command-line 'gud-jdb-massage-args 2421 'gud-jdb-marker-filter) 2422 (set (make-local-variable 'gud-minor-mode) 'jdb) 2423 2424 ;; If a -classpath option was provided, set gud-jdb-classpath 2425 (if gud-jdb-classpath-string 2426 (setq gud-jdb-classpath 2427 (gud-jdb-parse-classpath-string gud-jdb-classpath-string))) 2428 (setq gud-jdb-classpath-string nil) ; prepare for next 2429 ;; If a -sourcepath option was provided, parse it 2430 (if gud-jdb-sourcepath 2431 (setq gud-jdb-sourcepath 2432 (gud-jdb-parse-classpath-string gud-jdb-sourcepath))) 2433 2434 (gud-def gud-break "stop at %c:%l" "\C-b" "Set breakpoint at current line.") 2435 (gud-def gud-remove "clear %c:%l" "\C-d" "Remove breakpoint at current line") 2436 (gud-def gud-step "step" "\C-s" "Step one source line with display.") 2437 (gud-def gud-next "next" "\C-n" "Step one line (skip functions).") 2438 (gud-def gud-cont "cont" "\C-r" "Continue with display.") 2439 (gud-def gud-finish "step up" "\C-f" "Continue until current method returns.") 2440 (gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.") 2441 (gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.") 2442 (gud-def gud-run "run" nil "Run the program.") ;if VM start using jdb 2443 (gud-def gud-print "print %e" "\C-p" "Print value of expression at point.") 2444 (gud-def gud-pstar "dump %e" nil "Print all object information at point.") 2445 2446 (setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ") 2447 (setq paragraph-start comint-prompt-regexp) 2448 (run-hooks 'jdb-mode-hook) 2449 2450 (if gud-jdb-use-classpath 2451 ;; Get the classpath information from the debugger 2452 (progn 2453 (if (string-match "-attach" command-line) 2454 (gud-call "classpath")) 2455 (fset 'gud-jdb-find-source 2456 'gud-jdb-find-source-using-classpath)) 2457 2458 ;; Else create and bind the class/source association list as well 2459 ;; as the source file list. 2460 (setq gud-jdb-class-source-alist 2461 (gud-jdb-build-class-source-alist 2462 (setq gud-jdb-source-files 2463 (gud-jdb-build-source-files-list gud-jdb-directories 2464 "\\.java$")))) 2465 (fset 'gud-jdb-find-source 'gud-jdb-find-source-file))) 2466 2467;; 2468;; End of debugger-specific information 2469;; 2470 2471 2472;; When we send a command to the debugger via gud-call, it's annoying 2473;; to see the command and the new prompt inserted into the debugger's 2474;; buffer; we have other ways of knowing the command has completed. 2475;; 2476;; If the buffer looks like this: 2477;; -------------------- 2478;; (gdb) set args foo bar 2479;; (gdb) -!- 2480;; -------------------- 2481;; (the -!- marks the location of point), and we type `C-x SPC' in a 2482;; source file to set a breakpoint, we want the buffer to end up like 2483;; this: 2484;; -------------------- 2485;; (gdb) set args foo bar 2486;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. 2487;; (gdb) -!- 2488;; -------------------- 2489;; Essentially, the old prompt is deleted, and the command's output 2490;; and the new prompt take its place. 2491;; 2492;; Not echoing the command is easy enough; you send it directly using 2493;; process-send-string, and it never enters the buffer. However, 2494;; getting rid of the old prompt is trickier; you don't want to do it 2495;; when you send the command, since that will result in an annoying 2496;; flicker as the prompt is deleted, redisplay occurs while Emacs 2497;; waits for a response from the debugger, and the new prompt is 2498;; inserted. Instead, we'll wait until we actually get some output 2499;; from the subprocess before we delete the prompt. If the command 2500;; produced no output other than a new prompt, that prompt will most 2501;; likely be in the first chunk of output received, so we will delete 2502;; the prompt and then replace it with an identical one. If the 2503;; command produces output, the prompt is moving anyway, so the 2504;; flicker won't be annoying. 2505;; 2506;; So - when we want to delete the prompt upon receipt of the next 2507;; chunk of debugger output, we position gud-delete-prompt-marker at 2508;; the start of the prompt; the process filter will notice this, and 2509;; delete all text between it and the process output marker. If 2510;; gud-delete-prompt-marker points nowhere, we leave the current 2511;; prompt alone. 2512(defvar gud-delete-prompt-marker nil) 2513 2514 2515(put 'gud-mode 'mode-class 'special) 2516 2517(define-derived-mode gud-mode comint-mode "Debugger" 2518 "Major mode for interacting with an inferior debugger process. 2519 2520 You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, 2521M-x perldb, M-x xdb, or M-x jdb. Each entry point finishes by executing a 2522hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook', 2523`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' respectively. 2524 2525After startup, the following commands are available in both the GUD 2526interaction buffer and any source buffer GUD visits due to a breakpoint stop 2527or step operation: 2528 2529\\[gud-break] sets a breakpoint at the current file and line. In the 2530GUD buffer, the current file and line are those of the last breakpoint or 2531step. In a source buffer, they are the buffer's file and current line. 2532 2533\\[gud-remove] removes breakpoints on the current file and line. 2534 2535\\[gud-refresh] displays in the source window the last line referred to 2536in the gud buffer. 2537 2538\\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line, 2539step-one-line (not entering function calls), and step-one-instruction 2540and then update the source window with the current file and position. 2541\\[gud-cont] continues execution. 2542 2543\\[gud-print] tries to find the largest C lvalue or function-call expression 2544around point, and sends it to the debugger for value display. 2545 2546The above commands are common to all supported debuggers except xdb which 2547does not support stepping instructions. 2548 2549Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break], 2550except that the breakpoint is temporary; that is, it is removed when 2551execution stops on it. 2552 2553Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack 2554frame. \\[gud-down] drops back down through one. 2555 2556If you are using gdb or xdb, \\[gud-finish] runs execution to the return from 2557the current function and stops. 2558 2559All the keystrokes above are accessible in the GUD buffer 2560with the prefix C-c, and in all buffers through the prefix C-x C-a. 2561 2562All pre-defined functions for which the concept make sense repeat 2563themselves the appropriate number of times if you give a prefix 2564argument. 2565 2566You may use the `gud-def' macro in the initialization hook to define other 2567commands. 2568 2569Other commands for interacting with the debugger process are inherited from 2570comint mode, which see." 2571 (setq mode-line-process '(":%s")) 2572 (define-key (current-local-map) "\C-c\C-l" 'gud-refresh) 2573 (set (make-local-variable 'gud-last-frame) nil) 2574 (if (boundp 'tool-bar-map) ; not --without-x 2575 (setq-local tool-bar-map gud-tool-bar-map)) 2576 (make-local-variable 'comint-prompt-regexp) 2577 ;; Don't put repeated commands in command history many times. 2578 (set (make-local-variable 'comint-input-ignoredups) t) 2579 (make-local-variable 'paragraph-start) 2580 (set (make-local-variable 'gud-delete-prompt-marker) (make-marker)) 2581 (add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t)) 2582 2583(defcustom gud-chdir-before-run t 2584 "Non-nil if GUD should `cd' to the debugged executable." 2585 :group 'gud 2586 :type 'boolean) 2587 2588;; Perform initializations common to all debuggers. 2589;; The first arg is the specified command line, 2590;; which starts with the program to debug. 2591;; The other three args specify the values to use 2592;; for local variables in the debugger buffer. 2593(defun gud-common-init (command-line massage-args marker-filter 2594 &optional find-file) 2595 (let* ((words (split-string-and-unquote command-line)) 2596 (program (car words)) 2597 (dir default-directory) 2598 ;; Extract the file name from WORDS 2599 ;; and put t in its place. 2600 ;; Later on we will put the modified file name arg back there. 2601 (file-word (let ((w (cdr words))) 2602 (while (and w (= ?- (aref (car w) 0))) 2603 (setq w (cdr w))) 2604 (and w 2605 (prog1 (car w) 2606 (setcar w t))))) 2607 (file-subst 2608 (and file-word (substitute-in-file-name file-word))) 2609 (args (cdr words)) 2610 ;; If a directory was specified, expand the file name. 2611 ;; Otherwise, don't expand it, so GDB can use the PATH. 2612 ;; A file name without directory is literally valid 2613 ;; only if the file exists in ., and in that case, 2614 ;; omitting the expansion here has no visible effect. 2615 (file (and file-word 2616 (if (file-name-directory file-subst) 2617 (expand-file-name file-subst) 2618 file-subst))) 2619 (filepart (and file-word (concat "-" (file-name-nondirectory file)))) 2620 (existing-buffer (get-buffer (concat "*gud" filepart "*")))) 2621 (select-window 2622 (display-buffer 2623 (get-buffer-create (concat "*gud" filepart "*")) 2624 '((display-buffer-reuse-window 2625 display-buffer-in-previous-window 2626 display-buffer-same-window display-buffer-pop-up-window)))) 2627 (when (and existing-buffer (get-buffer-process existing-buffer)) 2628 (error "This program is already being debugged")) 2629 ;; Set the dir, in case the buffer already existed with a different dir. 2630 (setq default-directory dir) 2631 ;; Set default-directory to the file's directory. 2632 (and file-word 2633 gud-chdir-before-run 2634 ;; Don't set default-directory if no directory was specified. 2635 ;; In that case, either the file is found in the current directory, 2636 ;; in which case this setq is a no-op, 2637 ;; or it is found by searching PATH, 2638 ;; in which case we don't know what directory it was found in. 2639 (file-name-directory file) 2640 (setq default-directory (file-name-directory file))) 2641 (or (bolp) (newline)) 2642 (insert "Current directory is " default-directory "\n") 2643 ;; Put the substituted and expanded file name back in its place. 2644 (let ((w args)) 2645 (while (and w (not (eq (car w) t))) 2646 (setq w (cdr w))) 2647 ;; Tramp has already been loaded if we are here. 2648 (if w (setcar w (setq file (file-local-name file))))) 2649 (apply 'make-comint (concat "gud" filepart) program nil 2650 (if massage-args (funcall massage-args file args) args)) 2651 ;; Since comint clobbered the mode, we don't set it until now. 2652 (gud-mode) 2653 (set (make-local-variable 'gud-target-name) 2654 (and file-word (file-name-nondirectory file)))) 2655 (set (make-local-variable 'gud-marker-filter) marker-filter) 2656 (if find-file (set (make-local-variable 'gud-find-file) find-file)) 2657 (setq gud-last-last-frame nil) 2658 2659 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) 2660 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) 2661 (gud-set-buffer)) 2662 2663(defun gud-set-buffer () 2664 (when (derived-mode-p 'gud-mode) 2665 (setq gud-comint-buffer (current-buffer)))) 2666 2667(defvar gud-filter-defer-flag nil 2668 "Non-nil means don't process anything from the debugger right now. 2669It is saved for when this flag is not set.") 2670 2671;; These functions are responsible for inserting output from your debugger 2672;; into the buffer. The hard work is done by the method that is 2673;; the value of gud-marker-filter. 2674 2675(defun gud-filter (proc string) 2676 ;; Here's where the actual buffer insertion is done 2677 (let (output process-window) 2678 (if (buffer-name (process-buffer proc)) 2679 (if gud-filter-defer-flag 2680 ;; If we can't process any text now, 2681 ;; save it for later. 2682 (setq gud-filter-pending-text 2683 (concat (or gud-filter-pending-text "") string)) 2684 2685 ;; If we have to ask a question during the processing, 2686 ;; defer any additional text that comes from the debugger 2687 ;; during that time. 2688 (let ((gud-filter-defer-flag t)) 2689 ;; Process now any text we previously saved up. 2690 (if gud-filter-pending-text 2691 (setq string (concat gud-filter-pending-text string) 2692 gud-filter-pending-text nil)) 2693 2694 (with-current-buffer (process-buffer proc) 2695 ;; If we have been so requested, delete the debugger prompt. 2696 (save-restriction 2697 (widen) 2698 (if (marker-buffer gud-delete-prompt-marker) 2699 (let ((inhibit-read-only t)) 2700 (delete-region (process-mark proc) 2701 gud-delete-prompt-marker) 2702 (comint-update-fence) 2703 (set-marker gud-delete-prompt-marker nil))) 2704 ;; Save the process output, checking for source file markers. 2705 (setq output (gud-marker-filter string)) 2706 ;; Check for a filename-and-line number. 2707 ;; Don't display the specified file 2708 ;; unless (1) point is at or after the position where output appears 2709 ;; and (2) this buffer is on the screen. 2710 (setq process-window 2711 (and gud-last-frame 2712 (>= (point) (process-mark proc)) 2713 (get-buffer-window (current-buffer))))) 2714 2715 ;; Let the comint filter do the actual insertion. 2716 ;; That lets us inherit various comint features. 2717 (comint-output-filter proc output)) 2718 2719 ;; Put the arrow on the source line. 2720 ;; This must be outside of the save-excursion 2721 ;; in case the source file is our current buffer. 2722 (if process-window 2723 (with-selected-window process-window 2724 (gud-display-frame)) 2725 ;; We have to be in the proper buffer, (process-buffer proc), 2726 ;; but not in a save-excursion, because that would restore point. 2727 (with-current-buffer (process-buffer proc) 2728 (gud-display-frame)))) 2729 2730 ;; If we deferred text that arrived during this processing, 2731 ;; handle it now. 2732 (if gud-filter-pending-text 2733 (gud-filter proc "")))))) 2734 2735(defvar gud-minor-mode-type nil) 2736(defvar gud-overlay-arrow-position nil) 2737(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) 2738 2739(declare-function gdb-reset "gdb-mi" ()) 2740(declare-function speedbar-change-initial-expansion-list "speedbar" (new)) 2741(defvar speedbar-previously-used-expansion-list-name) 2742 2743(defun gud-sentinel (proc msg) 2744 (cond ((null (buffer-name (process-buffer proc))) 2745 ;; buffer killed 2746 ;; Stop displaying an arrow in a source file. 2747 (setq gud-overlay-arrow-position nil) 2748 (set-process-buffer proc nil) 2749 (if (and (boundp 'speedbar-initial-expansion-list-name) 2750 (string-equal speedbar-initial-expansion-list-name "GUD")) 2751 (speedbar-change-initial-expansion-list 2752 speedbar-previously-used-expansion-list-name)) 2753 (if (eq gud-minor-mode-type 'gdbmi) 2754 (gdb-reset) 2755 (gud-reset))) 2756 ((memq (process-status proc) '(signal exit)) 2757 ;; Stop displaying an arrow in a source file. 2758 (setq gud-overlay-arrow-position nil) 2759 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 2760 'gdbmi) 2761 (gdb-reset) 2762 (gud-reset)) 2763 (let* ((obuf (current-buffer))) 2764 ;; save-excursion isn't the right thing if 2765 ;; process-buffer is current-buffer 2766 (unwind-protect 2767 (progn 2768 ;; Write something in the GUD buffer and hack its mode line, 2769 (set-buffer (process-buffer proc)) 2770 ;; Fix the mode line. 2771 (setq mode-line-process 2772 (concat ":" 2773 (symbol-name (process-status proc)))) 2774 (force-mode-line-update) 2775 (if (eobp) 2776 (insert ?\n mode-name " " msg) 2777 (save-excursion 2778 (goto-char (point-max)) 2779 (insert ?\n mode-name " " msg))) 2780 ;; If buffer and mode line will show that the process 2781 ;; is dead, we can delete it now. Otherwise it 2782 ;; will stay around until M-x list-processes. 2783 (delete-process proc)) 2784 ;; Restore old buffer, but don't restore old point 2785 ;; if obuf is the gud buffer. 2786 (set-buffer obuf)))))) 2787 2788(defun gud-kill-buffer-hook () 2789 (setq gud-minor-mode-type gud-minor-mode) 2790 (condition-case nil 2791 (progn 2792 (kill-process (get-buffer-process (current-buffer))) 2793 (delete-process (get-process "gdb-inferior"))) 2794 (error nil))) 2795 2796(defun gud-reset () 2797 (dolist (buffer (buffer-list)) 2798 (unless (eq buffer gud-comint-buffer) 2799 (with-current-buffer buffer 2800 (when gud-minor-mode 2801 (setq gud-minor-mode nil) 2802 (kill-local-variable 'tool-bar-map)))))) 2803 2804(defun gud-display-frame () 2805 "Find and obey the last filename-and-line marker from the debugger. 2806Obeying it means displaying in another window the specified file and line." 2807 (interactive) 2808 (when gud-last-frame 2809 (gud-set-buffer) 2810 (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) 2811 (setq gud-last-last-frame gud-last-frame 2812 gud-last-frame nil))) 2813 2814(declare-function global-hl-line-highlight "hl-line" ()) 2815(declare-function hl-line-highlight "hl-line" ()) 2816(declare-function gdb-display-source-buffer "gdb-mi" (buffer)) 2817 2818;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen 2819;; and that its line LINE is visible. 2820;; Put the overlay-arrow on the line LINE in that buffer. 2821;; Most of the trickiness in here comes from wanting to preserve the current 2822;; region-restriction if that's possible. We use an explicit display-buffer 2823;; to get around the fact that this is called inside a save-excursion. 2824 2825(defun gud-display-line (true-file line) 2826 (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. 2827 (buffer 2828 (with-current-buffer gud-comint-buffer 2829 (gud-find-file true-file))) 2830 (window (and buffer 2831 (or (get-buffer-window buffer) 2832 (display-buffer buffer '(nil (inhibit-same-window . t)))))) 2833 (pos)) 2834 (when buffer 2835 (with-current-buffer buffer 2836 (unless (or (verify-visited-file-modtime buffer) gud-keep-buffer) 2837 (if (yes-or-no-p 2838 (format "File %s changed on disk. Reread from disk? " 2839 (buffer-name))) 2840 (revert-buffer t t) 2841 (setq gud-keep-buffer t))) 2842 (save-restriction 2843 (widen) 2844 (goto-char (point-min)) 2845 (forward-line (1- line)) 2846 (setq pos (point)) 2847 (or gud-overlay-arrow-position 2848 (setq gud-overlay-arrow-position (make-marker))) 2849 (set-marker gud-overlay-arrow-position (point) (current-buffer)) 2850 ;; If they turned on hl-line, move the hl-line highlight to 2851 ;; the arrow's line. 2852 (when (featurep 'hl-line) 2853 (cond 2854 (global-hl-line-mode 2855 (global-hl-line-highlight)) 2856 ((and hl-line-mode hl-line-sticky-flag) 2857 (hl-line-highlight))))) 2858 (cond ((or (< pos (point-min)) (> pos (point-max))) 2859 (widen) 2860 (goto-char pos)))) 2861 (when window 2862 (set-window-point window gud-overlay-arrow-position) 2863 (if (eq gud-minor-mode 'gdbmi) 2864 (setq gdb-source-window window)))))) 2865 2866;; The gud-call function must do the right thing whether its invoking 2867;; keystroke is from the GUD buffer itself (via major-mode binding) 2868;; or a C buffer. In the former case, we want to supply data from 2869;; gud-last-frame. Here's how we do it: 2870 2871(defun gud-format-command (str arg) 2872 (let ((insource (not (eq (current-buffer) gud-comint-buffer))) 2873 (frame (or gud-last-frame gud-last-last-frame)) 2874 (buffer-file-name-localized 2875 (and (buffer-file-name) 2876 (file-local-name (buffer-file-name)))) 2877 result) 2878 (while (and str 2879 (let ((case-fold-search nil)) 2880 (string-match "\\([^%]*\\)%\\([adefFlpc]\\)" str))) 2881 (let ((key (string-to-char (match-string 2 str))) 2882 subst) 2883 (cond 2884 ((eq key ?f) 2885 (setq subst (file-name-nondirectory (if insource 2886 buffer-file-name-localized 2887 (car frame))))) 2888 ((eq key ?F) 2889 (setq subst (file-name-base (if insource 2890 buffer-file-name-localized 2891 (car frame))))) 2892 ((eq key ?d) 2893 (setq subst (file-name-directory (if insource 2894 buffer-file-name-localized 2895 (car frame))))) 2896 ((eq key ?l) 2897 (setq subst (int-to-string 2898 (if insource 2899 (save-restriction 2900 (widen) 2901 (+ (count-lines (point-min) (point)) 2902 (if (bolp) 1 0))) 2903 (cdr frame))))) 2904 ((eq key ?e) 2905 (setq subst (gud-find-expr))) 2906 ((eq key ?a) 2907 (setq subst (gud-read-address))) 2908 ((eq key ?c) 2909 (setq subst 2910 (gud-find-class 2911 (if insource 2912 (buffer-file-name) 2913 (car frame)) 2914 (if insource 2915 (save-restriction 2916 (widen) 2917 (+ (count-lines (point-min) (point)) 2918 (if (bolp) 1 0))) 2919 (cdr frame))))) 2920 ((eq key ?p) 2921 (setq subst (if arg (int-to-string arg))))) 2922 (setq result (concat result (match-string 1 str) subst))) 2923 (setq str (substring str (match-end 2)))) 2924 ;; There might be text left in STR when the loop ends. 2925 (concat result str))) 2926 2927(defun gud-read-address () 2928 "Return a string containing the core-address found in the buffer at point." 2929 (save-match-data 2930 (save-excursion 2931 (let ((pt (point)) found begin) 2932 (setq found (if (search-backward "0x" (- pt 7) t) (point))) 2933 (cond 2934 (found (forward-char 2) 2935 (buffer-substring found 2936 (progn (re-search-forward "[^0-9a-f]") 2937 (forward-char -1) 2938 (point)))) 2939 (t (setq begin (progn (re-search-backward "[^0-9]") 2940 (forward-char 1) 2941 (point))) 2942 (forward-char 1) 2943 (re-search-forward "[^0-9]") 2944 (forward-char -1) 2945 (buffer-substring begin (point)))))))) 2946 2947(defun gud-call (fmt &optional arg) 2948 (let ((msg (gud-format-command fmt arg))) 2949 (message "Command: %s" msg) 2950 (sit-for 0) 2951 (gud-basic-call msg))) 2952 2953(defun gud-basic-call (command) 2954 "Invoke the debugger COMMAND displaying source in other window." 2955 (interactive) 2956 (gud-set-buffer) 2957 (let ((proc (get-buffer-process gud-comint-buffer))) 2958 (or proc (error "Current buffer has no process")) 2959 ;; Arrange for the current prompt to get deleted. 2960 (with-current-buffer gud-comint-buffer 2961 (save-excursion 2962 (save-restriction 2963 (widen) 2964 (if (marker-position gud-delete-prompt-marker) 2965 ;; We get here when printing an expression. 2966 (goto-char gud-delete-prompt-marker) 2967 (goto-char (process-mark proc)) 2968 (forward-line 0)) 2969 (if (looking-at comint-prompt-regexp) 2970 (set-marker gud-delete-prompt-marker (point))) 2971 (if (eq gud-minor-mode 'gdbmi) 2972 (apply comint-input-sender (list proc command)) 2973 (process-send-string proc (concat command "\n")))))))) 2974 2975(defun gud-refresh (&optional arg) 2976 "Fix up a possibly garbled display, and redraw the arrow." 2977 (interactive "P") 2978 (or gud-last-frame (setq gud-last-frame gud-last-last-frame)) 2979 (gud-display-frame) 2980 (recenter arg)) 2981 2982;; Code for parsing expressions out of C or Fortran code. The single entry 2983;; point is gud-find-expr, which tries to return an lvalue expression from 2984;; around point. 2985 2986(defvar gud-find-expr-function 'gud-find-c-expr) 2987 2988(defun gud-find-expr (&rest args) 2989 (let ((expr (if (and transient-mark-mode mark-active) 2990 (buffer-substring (region-beginning) (region-end)) 2991 (apply gud-find-expr-function args)))) 2992 (save-match-data 2993 (if (string-match "\n" expr) 2994 (error "Expression must not include a newline")) 2995 (with-current-buffer gud-comint-buffer 2996 (save-excursion 2997 (goto-char (process-mark (get-buffer-process gud-comint-buffer))) 2998 (forward-line 0) 2999 (when (looking-at comint-prompt-regexp) 3000 (set-marker gud-delete-prompt-marker (point)) 3001 (set-marker-insertion-type gud-delete-prompt-marker t)) 3002 (unless (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 3003 'jdb) 3004 (insert (concat expr " = ")))))) 3005 expr)) 3006 3007;; The next eight functions are hacked from gdbsrc.el by 3008;; Debby Ayers <ayers@asc.slb.com>, 3009;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. 3010 3011(defun gud-find-c-expr () 3012 "Return the expr that surrounds point." 3013 (interactive) 3014 (save-excursion 3015 (let ((p (point)) 3016 (expr (gud-innermost-expr)) 3017 (test-expr (gud-prev-expr))) 3018 (while (and test-expr (gud-expr-compound test-expr expr)) 3019 (let ((prev-expr expr)) 3020 (setq expr (cons (car test-expr) (cdr expr))) 3021 (goto-char (car expr)) 3022 (setq test-expr (gud-prev-expr)) 3023 ;; If we just pasted on the condition of an if or while, 3024 ;; throw it away again. 3025 (if (member (buffer-substring (car test-expr) (cdr test-expr)) 3026 '("if" "while" "for")) 3027 (setq test-expr nil 3028 expr prev-expr)))) 3029 (goto-char p) 3030 (setq test-expr (gud-next-expr)) 3031 (while (gud-expr-compound expr test-expr) 3032 (setq expr (cons (car expr) (cdr test-expr))) 3033 (setq test-expr (gud-next-expr))) 3034 (buffer-substring (car expr) (cdr expr))))) 3035 3036(defun gud-innermost-expr () 3037 "Return the smallest expr that point is in; move point to beginning of it. 3038The expr is represented as a cons cell, where the car specifies the point in 3039the current buffer that marks the beginning of the expr and the cdr specifies 3040the character after the end of the expr." 3041 (let ((p (point)) begin end) 3042 (gud-backward-sexp) 3043 (setq begin (point)) 3044 (gud-forward-sexp) 3045 (setq end (point)) 3046 (if (>= p end) 3047 (progn 3048 (setq begin p) 3049 (goto-char p) 3050 (gud-forward-sexp) 3051 (setq end (point))) 3052 ) 3053 (goto-char begin) 3054 (cons begin end))) 3055 3056(defun gud-backward-sexp () 3057 "Version of `backward-sexp' that catches errors." 3058 (condition-case nil 3059 (backward-sexp) 3060 (error t))) 3061 3062(defun gud-forward-sexp () 3063 "Version of `forward-sexp' that catches errors." 3064 (condition-case nil 3065 (forward-sexp) 3066 (error t))) 3067 3068(defun gud-prev-expr () 3069 "Return the previous expr, point is set to beginning of that expr. 3070The expr is represented as a cons cell, where the car specifies the point in 3071the current buffer that marks the beginning of the expr and the cdr specifies 3072the character after the end of the expr." 3073 (let ((begin) (end)) 3074 (gud-backward-sexp) 3075 (setq begin (point)) 3076 (gud-forward-sexp) 3077 (setq end (point)) 3078 (goto-char begin) 3079 (cons begin end))) 3080 3081(defun gud-next-expr () 3082 "Return the following expr, point is set to beginning of that expr. 3083The expr is represented as a cons cell, where the car specifies the point in 3084the current buffer that marks the beginning of the expr and the cdr specifies 3085the character after the end of the expr." 3086 (let ((begin) (end)) 3087 (gud-forward-sexp) 3088 (gud-forward-sexp) 3089 (setq end (point)) 3090 (gud-backward-sexp) 3091 (setq begin (point)) 3092 (cons begin end))) 3093 3094(defun gud-expr-compound-sep (span-start span-end) 3095 "Scan from SPAN-START to SPAN-END for punctuation characters. 3096If `->' is found, return `?.'. If `.' is found, return `?.'. 3097If any other punctuation is found, return `??'. 3098If no punctuation is found, return `?\\s'." 3099 (let ((result ?\s) 3100 (syntax)) 3101 (while (< span-start span-end) 3102 (setq syntax (char-syntax (char-after span-start))) 3103 (cond 3104 ((= syntax ?\s) t) 3105 ((= syntax ?.) (setq syntax (char-after span-start)) 3106 (cond 3107 ((= syntax ?.) (setq result ?.)) 3108 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) 3109 (setq result ?.) 3110 (setq span-start (+ span-start 1))) 3111 (t (setq span-start span-end) 3112 (setq result ??))))) 3113 (setq span-start (+ span-start 1))) 3114 result)) 3115 3116(defun gud-expr-compound (first second) 3117 "Non-nil if concatenating FIRST and SECOND makes a single C expression. 3118The two exprs are represented as a cons cells, where the car 3119specifies the point in the current buffer that marks the beginning of the 3120expr and the cdr specifies the character after the end of the expr. 3121Link exprs of the form: 3122 Expr -> Expr 3123 Expr . Expr 3124 Expr (Expr) 3125 Expr [Expr] 3126 (Expr) Expr 3127 [Expr] Expr" 3128 (let ((span-start (cdr first)) 3129 (span-end (car second)) 3130 (syntax)) 3131 (setq syntax (gud-expr-compound-sep span-start span-end)) 3132 (cond 3133 ((= (car first) (car second)) nil) 3134 ((= (cdr first) (cdr second)) nil) 3135 ((= syntax ?.) t) 3136 ((= syntax ?\s) 3137 (setq span-start (char-after (- span-start 1))) 3138 (setq span-end (char-after span-end)) 3139 (cond 3140 ((= span-start ?\)) t) 3141 ((= span-start ?\]) t) 3142 ((= span-end ?\() t) 3143 ((= span-end ?\[) t) 3144 (t nil))) 3145 (t nil)))) 3146 3147 3148(declare-function c-langelem-sym "cc-defs" (langelem)) 3149(declare-function c-langelem-pos "cc-defs" (langelem)) 3150 3151(defun gud-find-class (f _line) 3152 "Find fully qualified class in file F at line LINE. 3153This function uses the `gud-jdb-classpath' (and optional 3154`gud-jdb-sourcepath') list(s) to derive a file 3155pathname relative to its classpath directory. The values in 3156`gud-jdb-classpath' are assumed to have been converted to absolute 3157pathname standards using file-truename. 3158If F is visited by a buffer and its mode is CC-mode(Java), 3159syntactic information of LINE is used to find the enclosing (nested) 3160class string which is appended to the top level 3161class of the file (using s to separate nested class ids)." 3162 ;; Convert f to a standard representation and remove suffix 3163 (if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath)) 3164 (save-match-data 3165 (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) 3166 (fbuffer (get-file-buffer f)) 3167 class-found 3168 ;; Syntax-symbol returns the symbol of the *first* element 3169 ;; in the syntactical analysis result list, syntax-point 3170 ;; returns the buffer position of same 3171 (syntax-symbol (lambda (x) (c-langelem-sym (car x)))) 3172 (syntax-point (lambda (x) (c-langelem-pos (car x))))) 3173 (setq f (file-name-sans-extension (file-truename f))) 3174 ;; Search through classpath list for an entry that is 3175 ;; contained in f 3176 (while (and cplist (not class-found)) 3177 (if (string-match (car cplist) f) 3178 (setq class-found 3179 (mapconcat 'identity 3180 (split-string 3181 (substring f (+ (match-end 0) 1)) 3182 "/") "."))) 3183 (setq cplist (cdr cplist))) 3184 ;; if f is visited by a java(cc-mode) buffer, walk up the 3185 ;; syntactic information chain and collect any 'inclass 3186 ;; symbols until 'topmost-intro is reached to find out if 3187 ;; point is within a nested class 3188 ;; FIXME: Yuck!!! cc-mode should provide a function instead. 3189 (if (and fbuffer (equal (symbol-file 'java-mode) "cc-mode")) 3190 (with-current-buffer fbuffer 3191 (let ((nclass) (syntax)) 3192 ;; While the c-syntactic information does not start 3193 ;; with the 'topmost-intro symbol, there may be 3194 ;; nested classes... 3195 (while (not (eq 'topmost-intro 3196 (funcall syntax-symbol (c-guess-basic-syntax)))) 3197 ;; Check if the current position c-syntactic 3198 ;; analysis has 'inclass 3199 (setq syntax (c-guess-basic-syntax)) 3200 (while 3201 (and (not (eq 'inclass (funcall syntax-symbol syntax))) 3202 (cdr syntax)) 3203 (setq syntax (cdr syntax))) 3204 (if (eq 'inclass (funcall syntax-symbol syntax)) 3205 (progn 3206 (goto-char (funcall syntax-point syntax)) 3207 ;; Now we're at the beginning of a class 3208 ;; definition. Find class name 3209 (looking-at 3210 "[A-Za-z0-9 \t\n]*?class[ \t\n]+\\([^ \t\n]+\\)") 3211 (setq nclass 3212 (append (list (match-string-no-properties 1)) 3213 nclass))) 3214 (setq syntax (c-guess-basic-syntax)) 3215 (while (and (not (funcall syntax-point syntax)) (cdr syntax)) 3216 (setq syntax (cdr syntax))) 3217 (goto-char (funcall syntax-point syntax)) 3218 )) 3219 (string-match (concat (car nclass) "$") class-found) 3220 (setq class-found 3221 (replace-match (mapconcat 'identity nclass "$") 3222 t t class-found))))) 3223 (if (not class-found) 3224 (message "gud-find-class: class for file %s not found!" f)) 3225 class-found)) 3226 ;; Not using classpath - try class/source association list 3227 (let ((class-found (rassoc f gud-jdb-class-source-alist))) 3228 (if class-found 3229 (car class-found) 3230 (message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f) 3231 nil)))) 3232 3233 3234;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3235;;; GDB script mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3236;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3237 3238(defvar gdb-script-mode-syntax-table 3239 (let ((st (make-syntax-table))) 3240 (modify-syntax-entry ?' "\"" st) 3241 (modify-syntax-entry ?# "<" st) 3242 (modify-syntax-entry ?\n ">" st) 3243 st)) 3244 3245(defvar gdb-script-font-lock-keywords 3246 '(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face)) 3247 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) 3248 ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) 3249 3250(defconst gdb-script-syntax-propertize-function 3251 (syntax-propertize-rules 3252 ("^document\\s-.*\\(\n\\)" (1 "< b")) 3253 ("^end\\(\\>\\)" 3254 (1 (ignore 3255 (when (and (> (match-beginning 0) (point-min)) 3256 (eq 1 (nth 7 (save-excursion 3257 (syntax-ppss (1- (match-beginning 0))))))) 3258 ;; We change the \n in front, which is more difficult, but results 3259 ;; in better highlighting. If the doc is empty, the single \n is 3260 ;; both the beginning and the end of the docstring, which can't be 3261 ;; expressed in syntax-tables. Instead, we place the "> b" after 3262 ;; placing the "< b", so the start marker is overwritten by the 3263 ;; termination marker and in the end Emacs simply considers that 3264 ;; there's no docstring at all, which is fine. 3265 (put-text-property (1- (match-beginning 0)) (match-beginning 0) 3266 'syntax-table (eval-when-compile 3267 (string-to-syntax "> b"))) 3268 ;; Make sure that rehighlighting the previous line won't erase our 3269 ;; syntax-table property and that modifying `end' will. 3270 (put-text-property (1- (match-beginning 0)) (match-end 0) 3271 'syntax-multiline t))))))) 3272 3273(defun gdb-script-font-lock-syntactic-face (state) 3274 (cond 3275 ((nth 3 state) font-lock-string-face) 3276 ((nth 7 state) font-lock-doc-face) 3277 (t font-lock-comment-face))) 3278 3279(defvar gdb-script-basic-indent 2) 3280 3281(defun gdb-script-skip-to-head () 3282 "We're just in front of an `end' and we need to go to its head." 3283 (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\|commands\\)\\>" nil 'move) 3284 (match-end 2)) 3285 (gdb-script-skip-to-head))) 3286 3287(defun gdb-script-calculate-indentation () 3288 (cond 3289 ((looking-at "end\\>") 3290 (gdb-script-skip-to-head) 3291 (current-indentation)) 3292 ((looking-at "else\\>") 3293 (while (and (re-search-backward "^\\s-*\\(if\\|\\(end\\)\\)\\>" nil 'move) 3294 (match-end 2)) 3295 (gdb-script-skip-to-head)) 3296 (current-indentation)) 3297 (t 3298 (forward-comment (- (point-max))) 3299 (forward-line 0) 3300 (skip-chars-forward " \t") 3301 (+ (current-indentation) 3302 (if (looking-at "\\(if\\|while\\|define\\|else\\|commands\\)\\>") 3303 gdb-script-basic-indent 0))))) 3304 3305(defun gdb-script-indent-line () 3306 "Indent current line of GDB script." 3307 (interactive) 3308 (if (and (eq (get-text-property (point) 'face) font-lock-doc-face) 3309 (save-excursion 3310 (forward-line 0) 3311 (skip-chars-forward " \t") 3312 (not (looking-at "end\\>")))) 3313 'noindent 3314 (let* ((savep (point)) 3315 (indent (condition-case nil 3316 (save-excursion 3317 (forward-line 0) 3318 (skip-chars-forward " \t") 3319 (if (>= (point) savep) (setq savep nil)) 3320 (max (gdb-script-calculate-indentation) 0)) 3321 (error 0)))) 3322 (if savep 3323 (save-excursion (indent-line-to indent)) 3324 (indent-line-to indent))))) 3325 3326;; Derived from cfengine.el. 3327(defun gdb-script-beginning-of-defun () 3328 "`beginning-of-defun' function for Gdb script mode. 3329Treats actions as defuns." 3330 (unless (<= (current-column) (current-indentation)) 3331 (end-of-line)) 3332 (if (re-search-backward "^define \\|^document " nil t) 3333 (beginning-of-line) 3334 (goto-char (point-min))) 3335 t) 3336 3337;; Derived from cfengine.el. 3338(defun gdb-script-end-of-defun () 3339 "`end-of-defun' function for Gdb script mode. 3340Treats actions as defuns." 3341 (end-of-line) 3342 (if (re-search-forward "^end" nil t) 3343 (beginning-of-line) 3344 (goto-char (point-max))) 3345 t) 3346 3347;;;###autoload 3348(define-derived-mode gdb-script-mode prog-mode "GDB-Script" 3349 "Major mode for editing GDB scripts." 3350 (set (make-local-variable 'comment-start) "#") 3351 (set (make-local-variable 'comment-start-skip) "#+\\s-*") 3352 (set (make-local-variable 'outline-regexp) "[ \t]") 3353 (set (make-local-variable 'imenu-generic-expression) 3354 '((nil "^define[ \t]+\\(\\w+\\)" 1))) 3355 (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line) 3356 (set (make-local-variable 'beginning-of-defun-function) 3357 #'gdb-script-beginning-of-defun) 3358 (set (make-local-variable 'end-of-defun-function) 3359 #'gdb-script-end-of-defun) 3360 (set (make-local-variable 'font-lock-defaults) 3361 '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil 3362 (font-lock-syntactic-face-function 3363 . gdb-script-font-lock-syntactic-face))) 3364 ;; Recognize docstrings. 3365 (set (make-local-variable 'syntax-propertize-function) 3366 gdb-script-syntax-propertize-function) 3367 (add-hook 'syntax-propertize-extend-region-functions 3368 #'syntax-propertize-multiline 'append 'local)) 3369 3370 3371;;; tooltips for GUD 3372 3373;;; Customizable settings 3374 3375(defvar tooltip-mode) 3376 3377;;;###autoload 3378(define-minor-mode gud-tooltip-mode 3379 "Toggle the display of GUD tooltips." 3380 :global t 3381 :group 'gud 3382 :group 'tooltip 3383 (require 'tooltip) 3384 (if gud-tooltip-mode 3385 (progn 3386 (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode) 3387 (add-hook 'pre-command-hook 'tooltip-hide) 3388 (add-hook 'tooltip-functions 'gud-tooltip-tips) 3389 (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion)) 3390 (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide) 3391 (remove-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode) 3392 (remove-hook 'tooltip-functions 'gud-tooltip-tips) 3393 (define-key global-map [mouse-movement] 'ignore))) 3394 (gud-tooltip-activate-mouse-motions-if-enabled) 3395 (if (and gud-comint-buffer 3396 (buffer-name gud-comint-buffer); gud-comint-buffer might be killed 3397 (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 3398 'gdbmi)) 3399 (if gud-tooltip-mode 3400 (progn 3401 (dolist (buffer (buffer-list)) 3402 (unless (eq buffer gud-comint-buffer) 3403 (with-current-buffer buffer 3404 (when (and (eq gud-minor-mode 'gdbmi) 3405 (not (string-match "\\`\\*.+\\*\\'" 3406 (buffer-name)))) 3407 (make-local-variable 'gdb-define-alist) 3408 (gdb-create-define-alist) 3409 (add-hook 'after-save-hook 3410 'gdb-create-define-alist nil t)))))) 3411 (kill-local-variable 'gdb-define-alist) 3412 (remove-hook 'after-save-hook 'gdb-create-define-alist t)))) 3413 3414(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode 3415 python-mode) 3416 "List of modes for which to enable GUD tooltips." 3417 :type '(repeat (symbol :tag "Major mode")) 3418 :group 'gud 3419 :group 'tooltip) 3420 3421(defcustom gud-tooltip-display 3422 '((eq (tooltip-event-buffer gud-tooltip-event) 3423 (marker-buffer gud-overlay-arrow-position))) 3424 "List of forms determining where GUD tooltips are displayed. 3425 3426Forms in the list are combined with AND. The default is to display 3427only tooltips in the buffer containing the overlay arrow." 3428 :type 'sexp 3429 :risky t 3430 :group 'gud 3431 :group 'tooltip) 3432 3433(defcustom gud-tooltip-echo-area nil 3434 "Use the echo area instead of frames for GUD tooltips." 3435 :type 'boolean 3436 :group 'gud 3437 :group 'tooltip) 3438 3439(make-obsolete-variable 'gud-tooltip-echo-area 3440 "disable Tooltip mode instead" "24.4" 'set) 3441 3442;;; Reacting on mouse movements 3443 3444(defun gud-tooltip-change-major-mode () 3445 "Function added to `change-major-mode-hook' when tooltip mode is on." 3446 (add-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled)) 3447 3448(defun gud-tooltip-activate-mouse-motions-if-enabled () 3449 "Reconsider for all buffers whether mouse motion events are desired." 3450 (remove-hook 'post-command-hook 3451 'gud-tooltip-activate-mouse-motions-if-enabled) 3452 (dolist (buffer (buffer-list)) 3453 (with-current-buffer buffer 3454 (if (and gud-tooltip-mode 3455 (memq major-mode gud-tooltip-modes)) 3456 (gud-tooltip-activate-mouse-motions t) 3457 (gud-tooltip-activate-mouse-motions nil))))) 3458 3459(defvar gud-tooltip-mouse-motions-active nil 3460 "Locally t in a buffer if tooltip processing of mouse motion is enabled.") 3461 3462;; We don't set track-mouse globally because this is a big redisplay 3463;; problem in buffers having a pre-command-hook or such installed, 3464;; which does a set-buffer, like the summary buffer of Gnus. Calling 3465;; set-buffer prevents redisplay optimizations, so every mouse motion 3466;; would be accompanied by a full redisplay. 3467 3468(defun gud-tooltip-activate-mouse-motions (activatep) 3469 "Activate/deactivate mouse motion events for the current buffer. 3470ACTIVATEP non-nil means activate mouse motion events." 3471 (if activatep 3472 (progn 3473 (set (make-local-variable 'gud-tooltip-mouse-motions-active) t) 3474 (set (make-local-variable 'track-mouse) t)) 3475 (when gud-tooltip-mouse-motions-active 3476 (kill-local-variable 'gud-tooltip-mouse-motions-active) 3477 (kill-local-variable 'track-mouse)))) 3478 3479(defvar tooltip-last-mouse-motion-event) 3480(declare-function tooltip-hide "tooltip" (&optional ignored-arg)) 3481(declare-function tooltip-start-delayed-tip "tooltip" ()) 3482 3483(defun gud-tooltip-mouse-motion (event) 3484 "Command handler for mouse movement events in `global-map'." 3485 (interactive "e") 3486 (tooltip-hide) 3487 (when (car (mouse-pixel-position)) 3488 (setq tooltip-last-mouse-motion-event (copy-sequence event)) 3489 (tooltip-start-delayed-tip))) 3490 3491;;; Tips for `gud' 3492 3493(defvar gud-tooltip-dereference nil 3494 "Non-nil means print expressions with a `*' in front of them. 3495For C this would dereference a pointer expression.") 3496 3497(defvar gud-tooltip-event nil 3498 "The mouse movement event that led to a tooltip display. 3499This event can be examined by forms in `gud-tooltip-display'.") 3500 3501(defun gud-tooltip-dereference (&optional arg) 3502 "Toggle whether tooltips should show `* expr' or `expr'. 3503With arg, dereference expr if ARG is positive, otherwise do not dereference." 3504 (interactive "P") 3505 (setq gud-tooltip-dereference 3506 (if (null arg) 3507 (not gud-tooltip-dereference) 3508 (> (prefix-numeric-value arg) 0))) 3509 (message "Dereferencing is now %s." 3510 (if gud-tooltip-dereference "on" "off"))) 3511 3512(defvar tooltip-use-echo-area) 3513(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) 3514(declare-function tooltip-strip-prompt "tooltip" (process output)) 3515 3516; This will only display data that comes in one chunk. 3517; Larger arrays (say 400 elements) are displayed in 3518; the tooltip incompletely and spill over into the gud buffer. 3519; Switching the process-filter creates timing problems and 3520; it may be difficult to do better. Using GDB/MI as in 3521; gdb-mi.el gets around this problem. 3522(defun gud-tooltip-process-output (process output) 3523 "Process debugger output and show it in a tooltip window." 3524 (remove-function (process-filter process) #'gud-tooltip-process-output) 3525 (tooltip-show (tooltip-strip-prompt process output) 3526 (or gud-tooltip-echo-area tooltip-use-echo-area 3527 (not tooltip-mode)))) 3528 3529(defun gud-tooltip-print-command (expr) 3530 "Return a suitable command to print the expression EXPR." 3531 (pcase gud-minor-mode 3532 ('gdbmi (concat "-data-evaluate-expression \"" expr "\"")) 3533 ('guiler expr) 3534 ('dbx (concat "print " expr)) 3535 ((or 'xdb 'pdb) (concat "p " expr)) 3536 ('sdb (concat expr "/")))) 3537 3538(declare-function gdb-input "gdb-mi" (command handler &optional trigger)) 3539(declare-function tooltip-expr-to-print "tooltip" (event)) 3540(declare-function tooltip-event-buffer "tooltip" (event)) 3541 3542(defun gud-tooltip-tips (event) 3543 "Show tip for identifier or selection under the mouse. 3544The mouse must either point at an identifier or inside a selected 3545region for the tip window to be shown. If `gud-tooltip-dereference' is t, 3546add a `*' in front of the printed expression. In the case of a C program 3547controlled by GDB, show the associated #define directives when program is 3548not executing. 3549 3550This function must return nil if it doesn't handle EVENT." 3551 (let (process) 3552 (when (and (eventp event) 3553 gud-tooltip-mode 3554 gud-comint-buffer 3555 (buffer-name gud-comint-buffer); might be killed 3556 (setq process (get-buffer-process gud-comint-buffer)) 3557 (posn-point (event-end event)) 3558 (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) 3559 (progn (setq gud-tooltip-event event) 3560 (eval (cons 'and gud-tooltip-display))))) 3561 (let ((expr (tooltip-expr-to-print event))) 3562 (when expr 3563 (if (and (eq gud-minor-mode 'gdbmi) 3564 (not gdb-active-process)) 3565 (progn 3566 (with-current-buffer (tooltip-event-buffer event) 3567 (let ((define-elt (assoc expr gdb-define-alist))) 3568 (unless (null define-elt) 3569 (tooltip-show 3570 (cdr define-elt) 3571 (or gud-tooltip-echo-area tooltip-use-echo-area 3572 (not tooltip-mode))) 3573 expr)))) 3574 (when gud-tooltip-dereference 3575 (setq expr (concat "*" expr))) 3576 (let ((cmd (gud-tooltip-print-command expr))) 3577 (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb)) 3578 (gud-tooltip-mode -1) 3579 ;; The blank before the newline is for MS-Windows, 3580 ;; whose emulation of message box removes newlines and 3581 ;; displays a single long line. 3582 (message-box "Using GUD tooltips in this mode is unsafe \n\ 3583so they have been disabled.")) 3584 (unless (null cmd) ; CMD can be nil if unknown debugger 3585 (if (eq gud-minor-mode 'gdbmi) 3586 (if gdb-macro-info 3587 (gdb-input 3588 (concat 3589 "server macro expand " expr "\n") 3590 `(lambda () (gdb-tooltip-print-1 ,expr))) 3591 (gdb-input 3592 (concat cmd "\n") 3593 `(lambda () (gdb-tooltip-print ,expr)))) 3594 (add-function :override (process-filter process) 3595 #'gud-tooltip-process-output) 3596 (gud-basic-call cmd)) 3597 expr)))))))) 3598 3599(provide 'gud) 3600 3601;;; gud.el ends here 3602