Mercurial > hg > xemacs-beta
comparison lisp/eterm/tgud.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | b82b59fe008d |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;; Things to look at: | |
| 2 ; (gud-call "") in gud-send-input | |
| 3 ; (defvar gud-last-last-frame nil) | |
| 4 ; term-prompt-regexp | |
| 5 | |
| 6 ;;; tgud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb | |
| 7 ;;; under Emacs | |
| 8 | |
| 9 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
| 10 ;; Maintainer: FSF | |
| 11 ;; Version: 1.3 | |
| 12 ;; Keywords: unix, tools | |
| 13 | |
| 14 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 15 | |
| 16 ;; This file is part of GNU Emacs. | |
| 17 | |
| 18 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 19 ;; it under the terms of the GNU General Public License as published by | |
| 20 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 21 ;; any later version. | |
| 22 | |
| 23 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 26 ;; GNU General Public License for more details. | |
| 27 | |
| 28 ;; You should have received a copy of the GNU General Public License | |
| 29 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
| 30 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 31 | |
| 32 ;;; Commentary: | |
| 33 | |
| 34 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu> | |
| 35 ;; It was later rewritten by rms. Some ideas were due to Masanobu. | |
| 36 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com> | |
| 37 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, | |
| 38 ;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com> | |
| 39 ;; added support for xdb (HPUX debugger). Rick Sladkey <jrs@world.std.com> | |
| 40 ;; wrote the GDB command completion code. Dave Love <d.love@dl.ac.uk> | |
| 41 ;; added the IRIX kluge and re-implemented the Mips-ish variant. | |
| 42 ;; Then hacked by Per Bothner <bothner@cygnus.com> to use term.el. | |
| 43 | |
| 44 ;;; Code: | |
| 45 | |
| 46 (require 'term) | |
| 47 (require 'etags) | |
| 48 | |
| 49 ;; ====================================================================== | |
| 50 ;; TGUD commands must be visible in C buffers visited by TGUD | |
| 51 | |
| 52 (defvar tgud-key-prefix "\C-x\C-a" | |
| 53 "Prefix of all TGUD commands valid in C buffers.") | |
| 54 | |
| 55 (global-set-key (concat tgud-key-prefix "\C-l") 'tgud-refresh) | |
| 56 (define-key ctl-x-map " " 'tgud-break) ;; backward compatibility hack | |
| 57 | |
| 58 ;; ====================================================================== | |
| 59 ;; the overloading mechanism | |
| 60 | |
| 61 (defun tgud-overload-functions (tgud-overload-alist) | |
| 62 "Overload functions defined in TGUD-OVERLOAD-ALIST. | |
| 63 This association list has elements of the form | |
| 64 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" | |
| 65 (mapcar | |
| 66 (function (lambda (p) (fset (car p) (symbol-function (cdr p))))) | |
| 67 tgud-overload-alist)) | |
| 68 | |
| 69 (defun tgud-massage-args (file args) | |
| 70 (error "TGUD not properly entered")) | |
| 71 | |
| 72 (defun tgud-marker-filter (str) | |
| 73 (error "TGUD not properly entered")) | |
| 74 | |
| 75 (defun tgud-find-file (f) | |
| 76 (error "TGUD not properly entered")) | |
| 77 | |
| 78 ;; ====================================================================== | |
| 79 ;; command definition | |
| 80 | |
| 81 ;; This macro is used below to define some basic debugger interface commands. | |
| 82 ;; Of course you may use `tgud-def' with any other debugger command, including | |
| 83 ;; user defined ones. | |
| 84 | |
| 85 ;; A macro call like (tgud-def FUNC NAME KEY DOC) expands to a form | |
| 86 ;; which defines FUNC to send the command NAME to the debugger, gives | |
| 87 ;; it the docstring DOC, and binds that function to KEY in the TGUD | |
| 88 ;; major mode. The function is also bound in the global keymap with the | |
| 89 ;; TGUD prefix. | |
| 90 | |
| 91 (defmacro tgud-def (func cmd key &optional doc) | |
| 92 "Define FUNC to be a command sending STR and bound to KEY, with | |
| 93 optional doc string DOC. Certain %-escapes in the string arguments | |
| 94 are interpreted specially if present. These are: | |
| 95 | |
| 96 %f name (without directory) of current source file. | |
| 97 %d directory of current source file. | |
| 98 %l number of current source line | |
| 99 %e text of the C lvalue or function-call expression surrounding point. | |
| 100 %a text of the hexadecimal address surrounding point | |
| 101 %p prefix argument to the command (if any) as a number | |
| 102 | |
| 103 The `current' source file is the file of the current buffer (if | |
| 104 we're in a C file) or the source file current at the last break or | |
| 105 step (if we're in the TGUD buffer). | |
| 106 The `current' line is that of the current buffer (if we're in a | |
| 107 source file) or the source line number at the last break or step (if | |
| 108 we're in the TGUD buffer)." | |
| 109 (list 'progn | |
| 110 (list 'defun func '(arg) | |
| 111 (or doc "") | |
| 112 '(interactive "p") | |
| 113 (list 'tgud-call cmd 'arg)) | |
| 114 (if key | |
| 115 (list 'define-key | |
| 116 '(current-local-map) | |
| 117 (concat "\C-c" key) | |
| 118 (list 'quote func))) | |
| 119 (if key | |
| 120 (list 'global-set-key | |
| 121 (list 'concat 'tgud-key-prefix key) | |
| 122 (list 'quote func))))) | |
| 123 | |
| 124 ;; Used by tgud-refresh, which should cause tgud-display-frame to redisplay | |
| 125 ;; the last frame, even if it's been called before and term-pending-frame has | |
| 126 ;; been set to nil. | |
| 127 (defvar tgud-last-last-frame nil) | |
| 128 | |
| 129 ;; All debugger-specific information is collected here. | |
| 130 ;; Here's how it works, in case you ever need to add a debugger to the mode. | |
| 131 ;; | |
| 132 ;; Each entry must define the following at startup: | |
| 133 ;; | |
| 134 ;;<name> | |
| 135 ;; term-prompt-regexp | |
| 136 ;; tgud-<name>-massage-args | |
| 137 ;; tgud-<name>-marker-filter | |
| 138 ;; tgud-<name>-find-file | |
| 139 ;; | |
| 140 ;; The job of the massage-args method is to modify the given list of | |
| 141 ;; debugger arguments before running the debugger. | |
| 142 ;; | |
| 143 ;; The job of the marker-filter method is to detect file/line markers in | |
| 144 ;; strings and set the global term-pending-frame to indicate what display | |
| 145 ;; action (if any) should be triggered by the marker. Note that only | |
| 146 ;; whatever the method *returns* is displayed in the buffer; thus, you | |
| 147 ;; can filter the debugger's output, interpreting some and passing on | |
| 148 ;; the rest. | |
| 149 ;; | |
| 150 ;; The job of the find-file method is to visit and return the buffer indicated | |
| 151 ;; by the car of tgud-tag-frame. This may be a file name, a tag name, or | |
| 152 ;; something else. | |
| 153 | |
| 154 ;; ====================================================================== | |
| 155 ;; gdb functions | |
| 156 | |
| 157 ;;; History of argument lists passed to gdb. | |
| 158 (defvar tgud-gdb-history nil) | |
| 159 | |
| 160 (defun tgud-gdb-massage-args (file args) | |
| 161 (cons "-fullname" (cons file args))) | |
| 162 | |
| 163 ;; Don't need to do anything, since term-mode does it for us. | |
| 164 ;; (This is so that you can run 'gdb -fullname' from a shell buffer.) | |
| 165 (defun tgud-gdb-marker-filter (string) | |
| 166 string) | |
| 167 | |
| 168 (defun tgud-gdb-find-file (f) | |
| 169 (find-file-noselect f)) | |
| 170 | |
| 171 (defvar gdb-minibuffer-local-map nil | |
| 172 "Keymap for minibuffer prompting of gdb startup command.") | |
| 173 (if gdb-minibuffer-local-map | |
| 174 () | |
| 175 (setq gdb-minibuffer-local-map (copy-keymap minibuffer-local-map)) | |
| 176 (define-key | |
| 177 gdb-minibuffer-local-map "\C-i" 'term-dynamic-complete-filename)) | |
| 178 | |
| 179 ;;;###autoload | |
| 180 (defun tgdb (command-line) | |
| 181 "Run gdb on program FILE in buffer *tgud-FILE*. | |
| 182 The directory containing FILE becomes the initial working directory | |
| 183 and source-file directory for your debugger." | |
| 184 (interactive | |
| 185 (list (read-from-minibuffer "Run gdb (like this): " | |
| 186 (if (consp tgud-gdb-history) | |
| 187 (car tgud-gdb-history) | |
| 188 "gdb ") | |
| 189 gdb-minibuffer-local-map nil | |
| 190 '(tgud-gdb-history . 1)))) | |
| 191 (tgud-overload-functions '((tgud-massage-args . tgud-gdb-massage-args) | |
| 192 (tgud-marker-filter . tgud-gdb-marker-filter) | |
| 193 (tgud-find-file . tgud-gdb-find-file) | |
| 194 )) | |
| 195 | |
| 196 (tgud-common-init command-line) | |
| 197 | |
| 198 (tgud-def tgud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") | |
| 199 (tgud-def tgud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") | |
| 200 (tgud-def tgud-remove "clear %l" "\C-d" "Remove breakpoint at current line") | |
| 201 (tgud-def tgud-step "step %p" "\C-s" "Step one source line with display.") | |
| 202 (tgud-def tgud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | |
| 203 (tgud-def tgud-next "next %p" "\C-n" "Step one line (skip functions).") | |
| 204 (tgud-def tgud-cont "cont" "\C-r" "Continue with display.") | |
| 205 (tgud-def tgud-finish "finish" "\C-f" "Finish executing current function.") | |
| 206 (tgud-def tgud-up "up %p" "<" "Up N stack frames (numeric arg).") | |
| 207 (tgud-def tgud-down "down %p" ">" "Down N stack frames (numeric arg).") | |
| 208 (tgud-def tgud-print "print %e" "\C-p" "Evaluate C expression at point.") | |
| 209 | |
| 210 (local-set-key "\C-i" 'tgud-gdb-complete-command) | |
| 211 (setq term-prompt-regexp "^(.*gdb[+]?) *") | |
| 212 (setq paragraph-start term-prompt-regexp) | |
| 213 (run-hooks 'gdb-mode-hook) | |
| 214 ) | |
| 215 | |
| 216 ;; One of the nice features of GDB is its impressive support for | |
| 217 ;; context-sensitive command completion. We preserve that feature | |
| 218 ;; in the TGUD buffer by using a GDB command designed just for Emacs. | |
| 219 | |
| 220 ;; The completion process filter indicates when it is finished. | |
| 221 (defvar tgud-gdb-complete-in-progress) | |
| 222 | |
| 223 ;; Since output may arrive in fragments we accumulate partials strings here. | |
| 224 (defvar tgud-gdb-complete-string) | |
| 225 | |
| 226 ;; We need to know how much of the completion to chop off. | |
| 227 (defvar tgud-gdb-complete-break) | |
| 228 | |
| 229 ;; The completion list is constructed by the process filter. | |
| 230 (defvar tgud-gdb-complete-list) | |
| 231 | |
| 232 (defvar tgud-term-buffer nil) | |
| 233 | |
| 234 (defun tgud-gdb-complete-command () | |
| 235 "Perform completion on the GDB command preceding point. | |
| 236 This is implemented using the GDB `complete' command which isn't | |
| 237 available with older versions of GDB." | |
| 238 (interactive) | |
| 239 (let* ((end (point)) | |
| 240 (command (save-excursion | |
| 241 (beginning-of-line) | |
| 242 (and (looking-at term-prompt-regexp) | |
| 243 (goto-char (match-end 0))) | |
| 244 (buffer-substring (point) end))) | |
| 245 command-word) | |
| 246 ;; Find the word break. This match will always succeed. | |
| 247 (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) | |
| 248 (setq tgud-gdb-complete-break (match-beginning 2) | |
| 249 command-word (substring command tgud-gdb-complete-break)) | |
| 250 (unwind-protect | |
| 251 (progn | |
| 252 ;; Temporarily install our filter function. | |
| 253 (tgud-overload-functions | |
| 254 '((tgud-marker-filter . tgud-gdb-complete-filter))) | |
| 255 ;; Issue the command to GDB. | |
| 256 (tgud-basic-call (concat "complete " command)) | |
| 257 (setq tgud-gdb-complete-in-progress t | |
| 258 tgud-gdb-complete-string nil | |
| 259 tgud-gdb-complete-list nil) | |
| 260 ;; Slurp the output. | |
| 261 (while tgud-gdb-complete-in-progress | |
| 262 (accept-process-output (get-buffer-process tgud-term-buffer)))) | |
| 263 ;; Restore the old filter function. | |
| 264 (tgud-overload-functions '((tgud-marker-filter . tgud-gdb-marker-filter)))) | |
| 265 ;; Protect against old versions of GDB. | |
| 266 (and tgud-gdb-complete-list | |
| 267 (string-match "^Undefined command: \"complete\"" | |
| 268 (car tgud-gdb-complete-list)) | |
| 269 (error "This version of GDB doesn't support the `complete' command.")) | |
| 270 ;; Sort the list like readline. | |
| 271 (setq tgud-gdb-complete-list | |
| 272 (sort tgud-gdb-complete-list (function string-lessp))) | |
| 273 ;; Remove duplicates. | |
| 274 (let ((first tgud-gdb-complete-list) | |
| 275 (second (cdr tgud-gdb-complete-list))) | |
| 276 (while second | |
| 277 (if (string-equal (car first) (car second)) | |
| 278 (setcdr first (setq second (cdr second))) | |
| 279 (setq first second | |
| 280 second (cdr second))))) | |
| 281 ;; Let term handle the rest. | |
| 282 (term-dynamic-simple-complete command-word tgud-gdb-complete-list))) | |
| 283 | |
| 284 ;; The completion process filter is installed temporarily to slurp the | |
| 285 ;; output of GDB up to the next prompt and build the completion list. | |
| 286 (defun tgud-gdb-complete-filter (string) | |
| 287 (setq string (concat tgud-gdb-complete-string string)) | |
| 288 (while (string-match "\n" string) | |
| 289 (setq tgud-gdb-complete-list | |
| 290 (cons (substring string tgud-gdb-complete-break (match-beginning 0)) | |
| 291 tgud-gdb-complete-list)) | |
| 292 (setq string (substring string (match-end 0)))) | |
| 293 (if (string-match term-prompt-regexp string) | |
| 294 (progn | |
| 295 (setq tgud-gdb-complete-in-progress nil) | |
| 296 string) | |
| 297 (progn | |
| 298 (setq tgud-gdb-complete-string string) | |
| 299 ""))) | |
| 300 | |
| 301 | |
| 302 ;; ====================================================================== | |
| 303 ;; sdb functions | |
| 304 | |
| 305 ;;; History of argument lists passed to sdb. | |
| 306 (defvar tgud-sdb-history nil) | |
| 307 | |
| 308 (defvar tgud-sdb-needs-tags (not (file-exists-p "/var")) | |
| 309 "If nil, we're on a System V Release 4 and don't need the tags hack.") | |
| 310 | |
| 311 (defvar tgud-sdb-lastfile nil) | |
| 312 | |
| 313 (defun tgud-sdb-massage-args (file args) | |
| 314 (cons file args)) | |
| 315 | |
| 316 (defun tgud-sdb-marker-filter (string) | |
| 317 (cond | |
| 318 ;; System V Release 3.2 uses this format | |
| 319 ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
| 320 string) | |
| 321 (setq term-pending-frame | |
| 322 (cons | |
| 323 (substring string (match-beginning 2) (match-end 2)) | |
| 324 (string-to-int | |
| 325 (substring string (match-beginning 3) (match-end 3)))))) | |
| 326 ;; System V Release 4.0 | |
| 327 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" | |
| 328 string) | |
| 329 (setq tgud-sdb-lastfile | |
| 330 (substring string (match-beginning 2) (match-end 2)))) | |
| 331 ((and tgud-sdb-lastfile (string-match "^\\([0-9]+\\):" string)) | |
| 332 (setq term-pending-frame | |
| 333 (cons | |
| 334 tgud-sdb-lastfile | |
| 335 (string-to-int | |
| 336 (substring string (match-beginning 1) (match-end 1)))))) | |
| 337 (t | |
| 338 (setq tgud-sdb-lastfile nil))) | |
| 339 string) | |
| 340 | |
| 341 (defun tgud-sdb-find-file (f) | |
| 342 (if tgud-sdb-needs-tags | |
| 343 (find-tag-noselect f) | |
| 344 (find-file-noselect f))) | |
| 345 | |
| 346 ;;;###autoload | |
| 347 (defun tsdb (command-line) | |
| 348 "Run sdb on program FILE in buffer *tgud-FILE*. | |
| 349 The directory containing FILE becomes the initial working directory | |
| 350 and source-file directory for your debugger." | |
| 351 (interactive | |
| 352 (list (read-from-minibuffer "Run sdb (like this): " | |
| 353 (if (consp tgud-sdb-history) | |
| 354 (car tgud-sdb-history) | |
| 355 "sdb ") | |
| 356 nil nil | |
| 357 '(tgud-sdb-history . 1)))) | |
| 358 (if (and tgud-sdb-needs-tags | |
| 359 (not (and (boundp 'tags-file-name) | |
| 360 (stringp tags-file-name) | |
| 361 (file-exists-p tags-file-name)))) | |
| 362 (error "The sdb support requires a valid tags table to work.")) | |
| 363 (tgud-overload-functions '((tgud-massage-args . tgud-sdb-massage-args) | |
| 364 (tgud-marker-filter . tgud-sdb-marker-filter) | |
| 365 (tgud-find-file . tgud-sdb-find-file) | |
| 366 )) | |
| 367 | |
| 368 (tgud-common-init command-line) | |
| 369 | |
| 370 (tgud-def tgud-break "%l b" "\C-b" "Set breakpoint at current line.") | |
| 371 (tgud-def tgud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") | |
| 372 (tgud-def tgud-remove "%l d" "\C-d" "Remove breakpoint at current line") | |
| 373 (tgud-def tgud-step "s %p" "\C-s" "Step one source line with display.") | |
| 374 (tgud-def tgud-stepi "i %p" "\C-i" "Step one instruction with display.") | |
| 375 (tgud-def tgud-next "S %p" "\C-n" "Step one line (skip functions).") | |
| 376 (tgud-def tgud-cont "c" "\C-r" "Continue with display.") | |
| 377 (tgud-def tgud-print "%e/" "\C-p" "Evaluate C expression at point.") | |
| 378 | |
| 379 (setq term-prompt-regexp "\\(^\\|\n\\)\\*") | |
| 380 (setq paragraph-start term-prompt-regexp) | |
| 381 (run-hooks 'sdb-mode-hook) | |
| 382 ) | |
| 383 | |
| 384 ;; ====================================================================== | |
| 385 ;; dbx functions | |
| 386 | |
| 387 ;;; History of argument lists passed to dbx. | |
| 388 (defvar tgud-dbx-history nil) | |
| 389 | |
| 390 (defun tgud-dbx-massage-args (file args) | |
| 391 (cons file args)) | |
| 392 | |
| 393 (defun tgud-dbx-marker-filter (string) | |
| 394 (if (or (string-match | |
| 395 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" | |
| 396 string) | |
| 397 (string-match | |
| 398 "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" | |
| 399 string)) | |
| 400 (setq term-pending-frame | |
| 401 (cons | |
| 402 (substring string (match-beginning 2) (match-end 2)) | |
| 403 (string-to-int | |
| 404 (substring string (match-beginning 1) (match-end 1)))))) | |
| 405 string) | |
| 406 | |
| 407 ;; Functions for Mips-style dbx. Given the option `-emacs', documented in | |
| 408 ;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's. | |
| 409 (defvar tgud-mips-p | |
| 410 (or (string-match "^mips-[^-]*-ultrix" system-configuration) | |
| 411 ;; We haven't tested tgud on this system: | |
| 412 (string-match "^mips-[^-]*-riscos" system-configuration) | |
| 413 ;; It's documented on OSF/1.3 | |
| 414 (string-match "^mips-[^-]*-osf1" system-configuration) | |
| 415 (string-match "^alpha-[^-]*-osf" system-configuration)) | |
| 416 "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") | |
| 417 | |
| 418 (defun tgud-mipsdbx-massage-args (file args) | |
| 419 (cons "-emacs" (cons file args))) | |
| 420 | |
| 421 ;; This is just like the gdb one except for the regexps since we need to cope | |
| 422 ;; with an optional breakpoint number in [] before the ^Z^Z | |
| 423 (defun tgud-mipsdbx-marker-filter (string) | |
| 424 (save-match-data | |
| 425 (setq tgud-marker-acc (concat tgud-marker-acc string)) | |
| 426 (let ((output "")) | |
| 427 | |
| 428 ;; Process all the complete markers in this chunk. | |
| 429 (while (string-match | |
| 430 ;; This is like th gdb marker but with an optional | |
| 431 ;; leading break point number like `[1] ' | |
| 432 "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
| 433 tgud-marker-acc) | |
| 434 (setq | |
| 435 | |
| 436 ;; Extract the frame position from the marker. | |
| 437 term-pending-frame | |
| 438 (cons (substring tgud-marker-acc (match-beginning 1) (match-end 1)) | |
| 439 (string-to-int (substring tgud-marker-acc | |
| 440 (match-beginning 2) | |
| 441 (match-end 2)))) | |
| 442 | |
| 443 ;; Append any text before the marker to the output we're going | |
| 444 ;; to return - we don't include the marker in this text. | |
| 445 output (concat output | |
| 446 (substring tgud-marker-acc 0 (match-beginning 0))) | |
| 447 | |
| 448 ;; Set the accumulator to the remaining text. | |
| 449 tgud-marker-acc (substring tgud-marker-acc (match-end 0)))) | |
| 450 | |
| 451 ;; Does the remaining text look like it might end with the | |
| 452 ;; beginning of another marker? If it does, then keep it in | |
| 453 ;; tgud-marker-acc until we receive the rest of it. Since we | |
| 454 ;; know the full marker regexp above failed, it's pretty simple to | |
| 455 ;; test for marker starts. | |
| 456 (if (string-match "[][ 0-9]*\032.*\\'" tgud-marker-acc) | |
| 457 (progn | |
| 458 ;; Everything before the potential marker start can be output. | |
| 459 (setq output (concat output (substring tgud-marker-acc | |
| 460 0 (match-beginning 0)))) | |
| 461 | |
| 462 ;; Everything after, we save, to combine with later input. | |
| 463 (setq tgud-marker-acc | |
| 464 (substring tgud-marker-acc (match-beginning 0)))) | |
| 465 | |
| 466 (setq output (concat output tgud-marker-acc) | |
| 467 tgud-marker-acc "")) | |
| 468 | |
| 469 output))) | |
| 470 | |
| 471 ;; The dbx in IRIX is a pain. It doesn't print the file name when | |
| 472 ;; stopping at a breakpoint (but you do get it from the `up' and | |
| 473 ;; `down' commands...). The only way to extract the information seems | |
| 474 ;; to be with a `file' command, although the current line number is | |
| 475 ;; available in $curline. Thus we have to look for output which | |
| 476 ;; appears to indicate a breakpoint. Then we prod the dbx sub-process | |
| 477 ;; to output the information we want with a combination of the | |
| 478 ;; `printf' and `file' commands as a pseudo marker which we can | |
| 479 ;; recognise next time through the marker-filter. This would be like | |
| 480 ;; the gdb marker but you can't get the file name without a newline... | |
| 481 ;; Note that tgud-remove won't work since Irix dbx expects a breakpoint | |
| 482 ;; number rather than a line number etc. Maybe this could be made to | |
| 483 ;; work by listing all the breakpoints and picking the one(s) with the | |
| 484 ;; correct line number, but life's too short. | |
| 485 ;; d.love@dl.ac.uk (Dave Love) can be blamed for this | |
| 486 | |
| 487 (defvar tgud-irix-p (string-match "^mips-[^-]*-irix" system-configuration) | |
| 488 "Non-nil to assume the interface appropriate for IRIX dbx. | |
| 489 This works in IRIX 4 and probably IRIX 5.") | |
| 490 ;; (It's been tested in IRIX 4 and the output from dbx on IRIX 5 looks | |
| 491 ;; the same.) | |
| 492 | |
| 493 ;; this filter is influenced by the xdb one rather than the gdb one | |
| 494 | |
| 495 (defun tgud-irixdbx-marker-filter (string) | |
| 496 (save-match-data | |
| 497 (let (result (case-fold-search nil)) | |
| 498 (if (or (string-match term-prompt-regexp string) | |
| 499 (string-match ".*\012" string)) | |
| 500 (setq result (concat tgud-marker-acc string) | |
| 501 tgud-marker-acc "") | |
| 502 (setq tgud-marker-acc (concat tgud-marker-acc string))) | |
| 503 (if result | |
| 504 (cond | |
| 505 ;; look for breakpoint or signal indication e.g.: | |
| 506 ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0] | |
| 507 ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8] | |
| 508 ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188] | |
| 509 ((string-match | |
| 510 "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" | |
| 511 result) | |
| 512 ;; prod dbx into printing out the line number and file | |
| 513 ;; name in a form we can grok as below | |
| 514 (process-send-string (get-buffer-process tgud-term-buffer) | |
| 515 "printf \"\032\032%1d:\",$curline;file\n")) | |
| 516 ;; look for result of, say, "up" e.g.: | |
| 517 ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] | |
| 518 ;; (this will also catch one of the lines printed by "where") | |
| 519 ((string-match | |
| 520 "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" | |
| 521 result) | |
| 522 (let ((file (substring result (match-beginning 1) | |
| 523 (match-end 1)))) | |
| 524 (if (file-exists-p file) | |
| 525 (setq term-pending-frame | |
| 526 (cons | |
| 527 (substring | |
| 528 result (match-beginning 1) (match-end 1)) | |
| 529 (string-to-int | |
| 530 (substring | |
| 531 result (match-beginning 2) (match-end 2))))))) | |
| 532 result) | |
| 533 ((string-match ; kluged-up marker as above | |
| 534 "\032\032\\([0-9]*\\):\\(.*\\)\n" result) | |
| 535 (let ((file (substring result (match-beginning 2) (match-end 2)))) | |
| 536 (if (file-exists-p file) | |
| 537 (setq term-pending-frame | |
| 538 (cons | |
| 539 file | |
| 540 (string-to-int | |
| 541 (substring | |
| 542 result (match-beginning 1) (match-end 1))))))) | |
| 543 (setq result (substring result 0 (match-beginning 0)))))) | |
| 544 (or result "")))) | |
| 545 | |
| 546 (defun tgud-dbx-find-file (f) | |
| 547 (find-file-noselect f)) | |
| 548 | |
| 549 ;;;###autoload | |
| 550 (defun tdbx (command-line) | |
| 551 "Run dbx on program FILE in buffer *tgud-FILE*. | |
| 552 The directory containing FILE becomes the initial working directory | |
| 553 and source-file directory for your debugger." | |
| 554 (interactive | |
| 555 (list (read-from-minibuffer "Run dbx (like this): " | |
| 556 (if (consp tgud-dbx-history) | |
| 557 (car tgud-dbx-history) | |
| 558 "dbx ") | |
| 559 nil nil | |
| 560 '(tgud-dbx-history . 1)))) | |
| 561 | |
| 562 (tgud-overload-functions | |
| 563 (cond | |
| 564 (tgud-mips-p | |
| 565 '((tgud-massage-args . tgud-mipsdbx-massage-args) | |
| 566 (tgud-marker-filter . tgud-mipsdbx-marker-filter) | |
| 567 (tgud-find-file . tgud-dbx-find-file))) | |
| 568 (tgud-irix-p | |
| 569 '((tgud-massage-args . tgud-dbx-massage-args) | |
| 570 (tgud-marker-filter . tgud-irixdbx-marker-filter) | |
| 571 (tgud-find-file . tgud-dbx-find-file))) | |
| 572 (t | |
| 573 '((tgud-massage-args . tgud-dbx-massage-args) | |
| 574 (tgud-marker-filter . tgud-dbx-marker-filter) | |
| 575 (tgud-find-file . tgud-dbx-find-file))))) | |
| 576 | |
| 577 (tgud-common-init command-line) | |
| 578 | |
| 579 (cond | |
| 580 (tgud-mips-p | |
| 581 (tgud-def tgud-break "stop at \"%f\":%l" | |
| 582 "\C-b" "Set breakpoint at current line.") | |
| 583 (tgud-def tgud-finish "return" "\C-f" "Finish executing current function.")) | |
| 584 (tgud-irix-p | |
| 585 (tgud-def tgud-break "stop at \"%d%f\":%l" | |
| 586 "\C-b" "Set breakpoint at current line.") | |
| 587 (tgud-def tgud-finish "return" "\C-f" "Finish executing current function.") | |
| 588 ;; Make dbx give out the source location info that we need. | |
| 589 (process-send-string (get-buffer-process tgud-term-buffer) | |
| 590 "printf \"\032\032%1d:\",$curline;file\n")) | |
| 591 (t | |
| 592 (tgud-def tgud-break "file \"%d%f\"\nstop at %l" | |
| 593 "\C-b" "Set breakpoint at current line."))) | |
| 594 | |
| 595 (tgud-def tgud-remove "clear %l" "\C-d" "Remove breakpoint at current line") | |
| 596 (tgud-def tgud-step "step %p" "\C-s" "Step one line with display.") | |
| 597 (tgud-def tgud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | |
| 598 (tgud-def tgud-next "next %p" "\C-n" "Step one line (skip functions).") | |
| 599 (tgud-def tgud-cont "cont" "\C-r" "Continue with display.") | |
| 600 (tgud-def tgud-up "up %p" "<" "Up (numeric arg) stack frames.") | |
| 601 (tgud-def tgud-down "down %p" ">" "Down (numeric arg) stack frames.") | |
| 602 (tgud-def tgud-print "print %e" "\C-p" "Evaluate C expression at point.") | |
| 603 | |
| 604 (setq term-prompt-regexp "^[^)\n]*dbx) *") | |
| 605 (setq paragraph-start term-prompt-regexp) | |
| 606 (run-hooks 'dbx-mode-hook) | |
| 607 ) | |
| 608 | |
| 609 ;;---ok | |
| 610 ;; ====================================================================== | |
| 611 ;; xdb (HP PARISC debugger) functions | |
| 612 | |
| 613 ;;; History of argument lists passed to xdb. | |
| 614 (defvar tgud-xdb-history nil) | |
| 615 | |
| 616 (defvar tgud-xdb-directories nil | |
| 617 "*A list of directories that xdb should search for source code. | |
| 618 If nil, only source files in the program directory | |
| 619 will be known to xdb. | |
| 620 | |
| 621 The file names should be absolute, or relative to the directory | |
| 622 containing the executable being debugged.") | |
| 623 | |
| 624 (defun tgud-xdb-massage-args (file args) | |
| 625 (nconc (let ((directories tgud-xdb-directories) | |
| 626 (result nil)) | |
| 627 (while directories | |
| 628 (setq result (cons (car directories) (cons "-d" result))) | |
| 629 (setq directories (cdr directories))) | |
| 630 (nreverse (cons file result))) | |
| 631 args)) | |
| 632 | |
| 633 (defun tgud-xdb-file-name (f) | |
| 634 "Transform a relative pathname to a full pathname in xdb mode" | |
| 635 (let ((result nil)) | |
| 636 (if (file-exists-p f) | |
| 637 (setq result (expand-file-name f)) | |
| 638 (let ((directories tgud-xdb-directories)) | |
| 639 (while directories | |
| 640 (let ((path (concat (car directories) "/" f))) | |
| 641 (if (file-exists-p path) | |
| 642 (setq result (expand-file-name path) | |
| 643 directories nil))) | |
| 644 (setq directories (cdr directories))))) | |
| 645 result)) | |
| 646 | |
| 647 ;; xdb does not print the lines all at once, so we have to accumulate them | |
| 648 (defun tgud-xdb-marker-filter (string) | |
| 649 (let (result) | |
| 650 (if (or (string-match term-prompt-regexp string) | |
| 651 (string-match ".*\012" string)) | |
| 652 (setq result (concat tgud-marker-acc string) | |
| 653 tgud-marker-acc "") | |
| 654 (setq tgud-marker-acc (concat tgud-marker-acc string))) | |
| 655 (if result | |
| 656 (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result) | |
| 657 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" | |
| 658 result)) | |
| 659 (let ((line (string-to-int | |
| 660 (substring result (match-beginning 2) (match-end 2)))) | |
| 661 (file (tgud-xdb-file-name | |
| 662 (substring result (match-beginning 1) (match-end 1))))) | |
| 663 (if file | |
| 664 (setq term-pending-frame (cons file line)))))) | |
| 665 (or result ""))) | |
| 666 | |
| 667 (defun tgud-xdb-find-file (f) | |
| 668 (let ((realf (tgud-xdb-file-name f))) | |
| 669 (if realf (find-file-noselect realf)))) | |
| 670 | |
| 671 ;;;###autoload | |
| 672 (defun txdb (command-line) | |
| 673 "Run xdb on program FILE in buffer *tgud-FILE*. | |
| 674 The directory containing FILE becomes the initial working directory | |
| 675 and source-file directory for your debugger. | |
| 676 | |
| 677 You can set the variable 'tgud-xdb-directories' to a list of program source | |
| 678 directories if your program contains sources from more than one directory." | |
| 679 (interactive | |
| 680 (list (read-from-minibuffer "Run xdb (like this): " | |
| 681 (if (consp tgud-xdb-history) | |
| 682 (car tgud-xdb-history) | |
| 683 "xdb ") | |
| 684 nil nil | |
| 685 '(tgud-xdb-history . 1)))) | |
| 686 (tgud-overload-functions '((tgud-massage-args . tgud-xdb-massage-args) | |
| 687 (tgud-marker-filter . tgud-xdb-marker-filter) | |
| 688 (tgud-find-file . tgud-xdb-find-file))) | |
| 689 | |
| 690 (tgud-common-init command-line) | |
| 691 | |
| 692 (tgud-def tgud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") | |
| 693 (tgud-def tgud-tbreak "b %f:%l\\t" "\C-t" | |
| 694 "Set temporary breakpoint at current line.") | |
| 695 (tgud-def tgud-remove "db" "\C-d" "Remove breakpoint at current line") | |
| 696 (tgud-def tgud-step "s %p" "\C-s" "Step one line with display.") | |
| 697 (tgud-def tgud-next "S %p" "\C-n" "Step one line (skip functions).") | |
| 698 (tgud-def tgud-cont "c" "\C-r" "Continue with display.") | |
| 699 (tgud-def tgud-up "up %p" "<" "Up (numeric arg) stack frames.") | |
| 700 (tgud-def tgud-down "down %p" ">" "Down (numeric arg) stack frames.") | |
| 701 (tgud-def tgud-finish "bu\\t" "\C-f" "Finish executing current function.") | |
| 702 (tgud-def tgud-print "p %e" "\C-p" "Evaluate C expression at point.") | |
| 703 | |
| 704 (setq term-prompt-regexp "^>") | |
| 705 (setq paragraph-start term-prompt-regexp) | |
| 706 (run-hooks 'xdb-mode-hook)) | |
| 707 | |
| 708 ;; ====================================================================== | |
| 709 ;; perldb functions | |
| 710 | |
| 711 ;;; History of argument lists passed to perldb. | |
| 712 (defvar tgud-perldb-history nil) | |
| 713 | |
| 714 (defun tgud-perldb-massage-args (file args) | |
| 715 (cons "-d" (cons file (cons "-emacs" args)))) | |
| 716 | |
| 717 ;; There's no guarantee that Emacs will hand the filter the entire | |
| 718 ;; marker at once; it could be broken up across several strings. We | |
| 719 ;; might even receive a big chunk with several markers in it. If we | |
| 720 ;; receive a chunk of text which looks like it might contain the | |
| 721 ;; beginning of a marker, we save it here between calls to the | |
| 722 ;; filter. | |
| 723 (defvar tgud-perldb-marker-acc "") | |
| 724 | |
| 725 (defun tgud-perldb-marker-filter (string) | |
| 726 (save-match-data | |
| 727 (setq tgud-marker-acc (concat tgud-marker-acc string)) | |
| 728 (let ((output "")) | |
| 729 | |
| 730 ;; Process all the complete markers in this chunk. | |
| 731 (while (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
| 732 tgud-marker-acc) | |
| 733 (setq | |
| 734 | |
| 735 ;; Extract the frame position from the marker. | |
| 736 term-pending-frame | |
| 737 (cons (substring tgud-marker-acc (match-beginning 1) (match-end 1)) | |
| 738 (string-to-int (substring tgud-marker-acc | |
| 739 (match-beginning 2) | |
| 740 (match-end 2)))) | |
| 741 | |
| 742 ;; Append any text before the marker to the output we're going | |
| 743 ;; to return - we don't include the marker in this text. | |
| 744 output (concat output | |
| 745 (substring tgud-marker-acc 0 (match-beginning 0))) | |
| 746 | |
| 747 ;; Set the accumulator to the remaining text. | |
| 748 tgud-marker-acc (substring tgud-marker-acc (match-end 0)))) | |
| 749 | |
| 750 ;; Does the remaining text look like it might end with the | |
| 751 ;; beginning of another marker? If it does, then keep it in | |
| 752 ;; tgud-marker-acc until we receive the rest of it. Since we | |
| 753 ;; know the full marker regexp above failed, it's pretty simple to | |
| 754 ;; test for marker starts. | |
| 755 (if (string-match "\032.*\\'" tgud-marker-acc) | |
| 756 (progn | |
| 757 ;; Everything before the potential marker start can be output. | |
| 758 (setq output (concat output (substring tgud-marker-acc | |
| 759 0 (match-beginning 0)))) | |
| 760 | |
| 761 ;; Everything after, we save, to combine with later input. | |
| 762 (setq tgud-marker-acc | |
| 763 (substring tgud-marker-acc (match-beginning 0)))) | |
| 764 | |
| 765 (setq output (concat output tgud-marker-acc) | |
| 766 tgud-marker-acc "")) | |
| 767 | |
| 768 output))) | |
| 769 | |
| 770 (defun tgud-perldb-find-file (f) | |
| 771 (find-file-noselect f)) | |
| 772 | |
| 773 ;;;###autoload | |
| 774 (defun tperldb (command-line) | |
| 775 "Run perldb on program FILE in buffer *tgud-FILE*. | |
| 776 The directory containing FILE becomes the initial working directory | |
| 777 and source-file directory for your debugger." | |
| 778 (interactive | |
| 779 (list (read-from-minibuffer "Run perldb (like this): " | |
| 780 (if (consp tgud-perldb-history) | |
| 781 (car tgud-perldb-history) | |
| 782 "perl ") | |
| 783 nil nil | |
| 784 '(tgud-perldb-history . 1)))) | |
| 785 (tgud-overload-functions '((tgud-massage-args . tgud-perldb-massage-args) | |
| 786 (tgud-marker-filter . tgud-perldb-marker-filter) | |
| 787 (tgud-find-file . tgud-perldb-find-file) | |
| 788 )) | |
| 789 | |
| 790 (tgud-common-init command-line) | |
| 791 | |
| 792 (tgud-def tgud-break "b %l" "\C-b" "Set breakpoint at current line.") | |
| 793 (tgud-def tgud-remove "d %l" "\C-d" "Remove breakpoint at current line") | |
| 794 (tgud-def tgud-step "s" "\C-s" "Step one source line with display.") | |
| 795 (tgud-def tgud-next "n" "\C-n" "Step one line (skip functions).") | |
| 796 (tgud-def tgud-cont "c" "\C-r" "Continue with display.") | |
| 797 ; (tgud-def tgud-finish "finish" "\C-f" "Finish executing current function.") | |
| 798 ; (tgud-def tgud-up "up %p" "<" "Up N stack frames (numeric arg).") | |
| 799 ; (tgud-def tgud-down "down %p" ">" "Down N stack frames (numeric arg).") | |
| 800 (tgud-def tgud-print "%e" "\C-p" "Evaluate perl expression at point.") | |
| 801 | |
| 802 (setq term-prompt-regexp "^ DB<[0-9]+> ") | |
| 803 (setq paragraph-start term-prompt-regexp) | |
| 804 (run-hooks 'perldb-mode-hook) | |
| 805 ) | |
| 806 | |
| 807 ;; | |
| 808 ;; End of debugger-specific information | |
| 809 ;; | |
| 810 | |
| 811 | |
| 812 ;;; When we send a command to the debugger via tgud-call, it's annoying | |
| 813 ;;; to see the command and the new prompt inserted into the debugger's | |
| 814 ;;; buffer; we have other ways of knowing the command has completed. | |
| 815 ;;; | |
| 816 ;;; If the buffer looks like this: | |
| 817 ;;; -------------------- | |
| 818 ;;; (gdb) set args foo bar | |
| 819 ;;; (gdb) -!- | |
| 820 ;;; -------------------- | |
| 821 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a | |
| 822 ;;; source file to set a breakpoint, we want the buffer to end up like | |
| 823 ;;; this: | |
| 824 ;;; -------------------- | |
| 825 ;;; (gdb) set args foo bar | |
| 826 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. | |
| 827 ;;; (gdb) -!- | |
| 828 ;;; -------------------- | |
| 829 ;;; Essentially, the old prompt is deleted, and the command's output | |
| 830 ;;; and the new prompt take its place. | |
| 831 ;;; | |
| 832 ;;; Not echoing the command is easy enough; you send it directly using | |
| 833 ;;; process-send-string, and it never enters the buffer. However, | |
| 834 ;;; getting rid of the old prompt is trickier; you don't want to do it | |
| 835 ;;; when you send the command, since that will result in an annoying | |
| 836 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs | |
| 837 ;;; waits for a response from the debugger, and the new prompt is | |
| 838 ;;; inserted. Instead, we'll wait until we actually get some output | |
| 839 ;;; from the subprocess before we delete the prompt. If the command | |
| 840 ;;; produced no output other than a new prompt, that prompt will most | |
| 841 ;;; likely be in the first chunk of output received, so we will delete | |
| 842 ;;; the prompt and then replace it with an identical one. If the | |
| 843 ;;; command produces output, the prompt is moving anyway, so the | |
| 844 ;;; flicker won't be annoying. | |
| 845 ;;; | |
| 846 ;;; So - when we want to delete the prompt upon receipt of the next | |
| 847 ;;; chunk of debugger output, we position term-pending-delete-marker at | |
| 848 ;;; the start of the prompt; the process filter will notice this, and | |
| 849 ;;; delete all text between it and the process output marker. If | |
| 850 ;;; term-pending-delete-marker points nowhere, we leave the current | |
| 851 ;;; prompt alone. | |
| 852 (defvar term-pending-delete-marker nil) | |
| 853 | |
| 854 | |
| 855 (defun tgud-mode () | |
| 856 "Major mode for interacting with an inferior debugger process. | |
| 857 | |
| 858 You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, | |
| 859 or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook', | |
| 860 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively. | |
| 861 | |
| 862 After startup, the following commands are available in both the TGUD | |
| 863 interaction buffer and any source buffer TGUD visits due to a breakpoint stop | |
| 864 or step operation: | |
| 865 | |
| 866 \\[tgud-break] sets a breakpoint at the current file and line. In the | |
| 867 TGUD buffer, the current file and line are those of the last breakpoint or | |
| 868 step. In a source buffer, they are the buffer's file and current line. | |
| 869 | |
| 870 \\[tgud-remove] removes breakpoints on the current file and line. | |
| 871 | |
| 872 \\[tgud-refresh] displays in the source window the last line referred to | |
| 873 in the tgud buffer. | |
| 874 | |
| 875 \\[tgud-step], \\[tgud-next], and \\[tgud-stepi] do a step-one-line, | |
| 876 step-one-line (not entering function calls), and step-one-instruction | |
| 877 and then update the source window with the current file and position. | |
| 878 \\[tgud-cont] continues execution. | |
| 879 | |
| 880 \\[tgud-print] tries to find the largest C lvalue or function-call expression | |
| 881 around point, and sends it to the debugger for value display. | |
| 882 | |
| 883 The above commands are common to all supported debuggers except xdb which | |
| 884 does not support stepping instructions. | |
| 885 | |
| 886 Under gdb, sdb and xdb, \\[tgud-tbreak] behaves exactly like \\[tgud-break], | |
| 887 except that the breakpoint is temporary; that is, it is removed when | |
| 888 execution stops on it. | |
| 889 | |
| 890 Under gdb, dbx, and xdb, \\[tgud-up] pops up through an enclosing stack | |
| 891 frame. \\[tgud-down] drops back down through one. | |
| 892 | |
| 893 If you are using gdb or xdb, \\[tgud-finish] runs execution to the return from | |
| 894 the current function and stops. | |
| 895 | |
| 896 All the keystrokes above are accessible in the TGUD buffer | |
| 897 with the prefix C-c, and in all buffers through the prefix C-x C-a. | |
| 898 | |
| 899 All pre-defined functions for which the concept make sense repeat | |
| 900 themselves the appropriate number of times if you give a prefix | |
| 901 argument. | |
| 902 | |
| 903 You may use the `tgud-def' macro in the initialization hook to define other | |
| 904 commands. | |
| 905 | |
| 906 Other commands for interacting with the debugger process are inherited from | |
| 907 term mode, which see." | |
| 908 (interactive) | |
| 909 (term-mode) | |
| 910 (setq major-mode 'tgud-mode) | |
| 911 (setq mode-name "Debugger") | |
| 912 (setq mode-line-process '(":%s")) | |
| 913 (use-local-map (copy-keymap term-mode-map)) | |
| 914 (define-key (current-local-map) "\C-m" 'tgud-send-input) | |
| 915 (define-key (current-local-map) "\C-c\C-l" 'tgud-refresh) | |
| 916 (make-local-variable 'term-prompt-regexp) | |
| 917 (make-local-variable 'paragraph-start) | |
| 918 (run-hooks 'tgud-mode-hook) | |
| 919 ) | |
| 920 | |
| 921 (defun tgud-send-input () | |
| 922 (interactive) | |
| 923 (let ((proc (get-buffer-process (current-buffer)))) | |
| 924 (if (not proc) (error "Current buffer has no process") | |
| 925 ;; If input line is empty, use tgud-call to get prompt deleted. | |
| 926 (if (and (= (point) (process-mark proc)) (= (point) (point-max))) | |
| 927 (tgud-call "") | |
| 928 (term-send-input))))) | |
| 929 | |
| 930 ;; Chop STRING into words separated by SPC or TAB and return a list of them. | |
| 931 (defun tgud-chop-words (string) | |
| 932 (let ((i 0) (beg 0) | |
| 933 (len (length string)) | |
| 934 (words nil)) | |
| 935 (while (< i len) | |
| 936 (if (memq (aref string i) '(?\t ? )) | |
| 937 (progn | |
| 938 (setq words (cons (substring string beg i) words) | |
| 939 beg (1+ i)) | |
| 940 (while (and (< beg len) (memq (aref string beg) '(?\t ? ))) | |
| 941 (setq beg (1+ beg))) | |
| 942 (setq i (1+ beg))) | |
| 943 (setq i (1+ i)))) | |
| 944 (if (< beg len) | |
| 945 (setq words (cons (substring string beg) words))) | |
| 946 (nreverse words))) | |
| 947 | |
| 948 ;; Perform initializations common to all debuggers. | |
| 949 (defun tgud-common-init (command-line) | |
| 950 (let* ((words (tgud-chop-words command-line)) | |
| 951 (program (car words)) | |
| 952 (file-word (let ((w (cdr words))) | |
| 953 (while (and w (= ?- (aref (car w) 0))) | |
| 954 (setq w (cdr w))) | |
| 955 (car w))) | |
| 956 (args (delq file-word (cdr words))) | |
| 957 (file (and file-word | |
| 958 (expand-file-name (substitute-in-file-name file-word)))) | |
| 959 (filepart (and file-word (file-name-nondirectory file)))) | |
| 960 (switch-to-buffer (concat "*tgud-" filepart "*")) | |
| 961 (and file-word (setq default-directory (file-name-directory file))) | |
| 962 (or (bolp) (newline)) | |
| 963 (insert "Current directory is " default-directory "\n") | |
| 964 (apply 'make-term (concat "tgud-" filepart) program nil | |
| 965 (if file-word (tgud-massage-args file args)))) | |
| 966 (tgud-mode) | |
| 967 ;; Note the insertion about of the line giving the "Current directory" | |
| 968 ;; is not known about by the terminal emulator, so clear the | |
| 969 ;; current-row cache to avoid confusion. | |
| 970 (setq term-current-row nil) | |
| 971 (set-process-filter (get-buffer-process (current-buffer)) 'tgud-filter) | |
| 972 (set-process-sentinel (get-buffer-process (current-buffer)) 'tgud-sentinel) | |
| 973 (tgud-set-buffer) | |
| 974 ) | |
| 975 | |
| 976 (defun tgud-set-buffer () | |
| 977 (cond ((eq major-mode 'tgud-mode) | |
| 978 (setq tgud-term-buffer (current-buffer))))) | |
| 979 | |
| 980 ;; These functions are responsible for inserting output from your debugger | |
| 981 ;; into the buffer. The hard work is done by the method that is | |
| 982 ;; the value of tgud-marker-filter. | |
| 983 | |
| 984 (defun tgud-filter (proc string) | |
| 985 ;; Here's where the actual buffer insertion is done | |
| 986 (set-buffer (process-buffer proc)) | |
| 987 (let ((inhibit-quit t)) ;; ??? | |
| 988 (term-emulate-terminal proc (tgud-marker-filter string)))) | |
| 989 | |
| 990 (defun tgud-sentinel (proc msg) | |
| 991 (cond ((null (buffer-name (process-buffer proc))) | |
| 992 ;; buffer killed | |
| 993 ;; Stop displaying an arrow in a source file. | |
| 994 (setq overlay-arrow-position nil) | |
| 995 (set-process-buffer proc nil)) | |
| 996 ((memq (process-status proc) '(signal exit)) | |
| 997 ;; Stop displaying an arrow in a source file. | |
| 998 (setq overlay-arrow-position nil) | |
| 999 ;; Fix the mode line. | |
| 1000 (setq mode-line-process | |
| 1001 (concat ":" | |
| 1002 (symbol-name (process-status proc)))) | |
| 1003 (let* ((obuf (current-buffer))) | |
| 1004 ;; save-excursion isn't the right thing if | |
| 1005 ;; process-buffer is current-buffer | |
| 1006 (unwind-protect | |
| 1007 (progn | |
| 1008 ;; Write something in *compilation* and hack its mode line, | |
| 1009 (set-buffer (process-buffer proc)) | |
| 1010 ;; Force mode line redisplay soon | |
| 1011 (set-buffer-modified-p (buffer-modified-p)) | |
| 1012 (if (eobp) | |
| 1013 (insert ?\n mode-name " " msg) | |
| 1014 (save-excursion | |
| 1015 (goto-char (point-max)) | |
| 1016 (insert ?\n mode-name " " msg))) | |
| 1017 ;; If buffer and mode line will show that the process | |
| 1018 ;; is dead, we can delete it now. Otherwise it | |
| 1019 ;; will stay around until M-x list-processes. | |
| 1020 (delete-process proc)) | |
| 1021 ;; Restore old buffer, but don't restore old point | |
| 1022 ;; if obuf is the tgud buffer. | |
| 1023 (set-buffer obuf)))))) | |
| 1024 | |
| 1025 (defun tgud-display-frame () | |
| 1026 "Find and obey the last filename-and-line marker from the debugger. | |
| 1027 Obeying it means displaying in another window the specified file and line." | |
| 1028 (interactive) | |
| 1029 (if term-pending-frame | |
| 1030 (progn | |
| 1031 (tgud-set-buffer) | |
| 1032 (term-display-buffer-line (tgud-visit-file (car term-pending-frame)) | |
| 1033 (cdr term-pending-frame)) | |
| 1034 (setq term-pending-frame nil)))) | |
| 1035 | |
| 1036 ;;; The tgud-call function must do the right thing whether its invoking | |
| 1037 ;;; keystroke is from the TGUD buffer itself (via major-mode binding) | |
| 1038 ;;; or a C buffer. In the former case, we want to supply data from | |
| 1039 ;;; term-pending-frame. Here's how we do it: | |
| 1040 | |
| 1041 (defun tgud-format-command (str arg) | |
| 1042 (let ((insource (not (eq (current-buffer) tgud-term-buffer))) | |
| 1043 (frame (or term-pending-frame tgud-last-last-frame)) | |
| 1044 result) | |
| 1045 (while (and str (string-match "\\([^%]*\\)%\\([adeflp]\\)" str)) | |
| 1046 (let ((key (string-to-char (substring str (match-beginning 2)))) | |
| 1047 subst) | |
| 1048 (cond | |
| 1049 ((eq key ?f) | |
| 1050 (setq subst (file-name-nondirectory (if insource | |
| 1051 (buffer-file-name) | |
| 1052 (car frame))))) | |
| 1053 ((eq key ?d) | |
| 1054 (setq subst (file-name-directory (if insource | |
| 1055 (buffer-file-name) | |
| 1056 (car frame))))) | |
| 1057 ((eq key ?l) | |
| 1058 (setq subst (if insource | |
| 1059 (save-excursion | |
| 1060 (beginning-of-line) | |
| 1061 (save-restriction (widen) | |
| 1062 (1+ (count-lines 1 (point))))) | |
| 1063 (cdr frame)))) | |
| 1064 ((eq key ?e) | |
| 1065 (setq subst (find-c-expr))) | |
| 1066 ((eq key ?a) | |
| 1067 (setq subst (tgud-read-address))) | |
| 1068 ((eq key ?p) | |
| 1069 (setq subst (if arg (int-to-string arg) "")))) | |
| 1070 (setq result (concat result | |
| 1071 (substring str (match-beginning 1) (match-end 1)) | |
| 1072 subst))) | |
| 1073 (setq str (substring str (match-end 2)))) | |
| 1074 ;; There might be text left in STR when the loop ends. | |
| 1075 (concat result str))) | |
| 1076 | |
| 1077 (defun tgud-read-address () | |
| 1078 "Return a string containing the core-address found in the buffer at point." | |
| 1079 (save-excursion | |
| 1080 (let ((pt (point)) found begin) | |
| 1081 (setq found (if (search-backward "0x" (- pt 7) t) (point))) | |
| 1082 (cond | |
| 1083 (found (forward-char 2) | |
| 1084 (buffer-substring found | |
| 1085 (progn (re-search-forward "[^0-9a-f]") | |
| 1086 (forward-char -1) | |
| 1087 (point)))) | |
| 1088 (t (setq begin (progn (re-search-backward "[^0-9]") | |
| 1089 (forward-char 1) | |
| 1090 (point))) | |
| 1091 (forward-char 1) | |
| 1092 (re-search-forward "[^0-9]") | |
| 1093 (forward-char -1) | |
| 1094 (buffer-substring begin (point))))))) | |
| 1095 | |
| 1096 (defun tgud-call (fmt &optional arg) | |
| 1097 (let ((msg (tgud-format-command fmt arg))) | |
| 1098 (message "Command: %s" msg) | |
| 1099 (sit-for 0) | |
| 1100 (tgud-basic-call msg))) | |
| 1101 | |
| 1102 (defun tgud-basic-call (command) | |
| 1103 "Invoke the debugger COMMAND displaying source in other window." | |
| 1104 (interactive) | |
| 1105 (tgud-set-buffer) | |
| 1106 (let ((proc (get-buffer-process tgud-term-buffer))) | |
| 1107 | |
| 1108 ;; Arrange for the current prompt to get deleted. | |
| 1109 (save-excursion | |
| 1110 (set-buffer tgud-term-buffer) | |
| 1111 (goto-char (process-mark proc)) | |
| 1112 (beginning-of-line) | |
| 1113 (if (looking-at term-prompt-regexp) | |
| 1114 (set-marker term-pending-delete-marker (point))) | |
| 1115 (term-send-invisible command proc)))) | |
| 1116 | |
| 1117 (defun tgud-refresh (&optional arg) | |
| 1118 "Fix up a possibly garbled display, and redraw the arrow." | |
| 1119 (interactive "P") | |
| 1120 (recenter arg) | |
| 1121 (or term-pending-frame (setq term-pending-frame tgud-last-last-frame)) | |
| 1122 (tgud-display-frame)) | |
| 1123 | |
| 1124 ;;; Code for parsing expressions out of C code. The single entry point is | |
| 1125 ;;; find-c-expr, which tries to return an lvalue expression from around point. | |
| 1126 ;;; | |
| 1127 ;;; The rest of this file is a hacked version of gdbsrc.el by | |
| 1128 ;;; Debby Ayers <ayers@asc.slb.com>, | |
| 1129 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. | |
| 1130 | |
| 1131 (defun find-c-expr () | |
| 1132 "Returns the C expr that surrounds point." | |
| 1133 (interactive) | |
| 1134 (save-excursion | |
| 1135 (let ((p) (expr) (test-expr)) | |
| 1136 (setq p (point)) | |
| 1137 (setq expr (expr-cur)) | |
| 1138 (setq test-expr (expr-prev)) | |
| 1139 (while (expr-compound test-expr expr) | |
| 1140 (setq expr (cons (car test-expr) (cdr expr))) | |
| 1141 (goto-char (car expr)) | |
| 1142 (setq test-expr (expr-prev))) | |
| 1143 (goto-char p) | |
| 1144 (setq test-expr (expr-next)) | |
| 1145 (while (expr-compound expr test-expr) | |
| 1146 (setq expr (cons (car expr) (cdr test-expr))) | |
| 1147 (setq test-expr (expr-next)) | |
| 1148 ) | |
| 1149 (buffer-substring (car expr) (cdr expr))))) | |
| 1150 | |
| 1151 (defun expr-cur () | |
| 1152 "Returns the expr that point is in; point is set to beginning of expr. | |
| 1153 The expr is represented as a cons cell, where the car specifies the point in | |
| 1154 the current buffer that marks the beginning of the expr and the cdr specifies | |
| 1155 the character after the end of the expr." | |
| 1156 (let ((p (point)) (begin) (end)) | |
| 1157 (expr-backward-sexp) | |
| 1158 (setq begin (point)) | |
| 1159 (expr-forward-sexp) | |
| 1160 (setq end (point)) | |
| 1161 (if (>= p end) | |
| 1162 (progn | |
| 1163 (setq begin p) | |
| 1164 (goto-char p) | |
| 1165 (expr-forward-sexp) | |
| 1166 (setq end (point)) | |
| 1167 ) | |
| 1168 ) | |
| 1169 (goto-char begin) | |
| 1170 (cons begin end))) | |
| 1171 | |
| 1172 (defun expr-backward-sexp () | |
| 1173 "Version of `backward-sexp' that catches errors." | |
| 1174 (condition-case nil | |
| 1175 (backward-sexp) | |
| 1176 (error t))) | |
| 1177 | |
| 1178 (defun expr-forward-sexp () | |
| 1179 "Version of `forward-sexp' that catches errors." | |
| 1180 (condition-case nil | |
| 1181 (forward-sexp) | |
| 1182 (error t))) | |
| 1183 | |
| 1184 (defun expr-prev () | |
| 1185 "Returns the previous expr, point is set to beginning of that expr. | |
| 1186 The expr is represented as a cons cell, where the car specifies the point in | |
| 1187 the current buffer that marks the beginning of the expr and the cdr specifies | |
| 1188 the character after the end of the expr" | |
| 1189 (let ((begin) (end)) | |
| 1190 (expr-backward-sexp) | |
| 1191 (setq begin (point)) | |
| 1192 (expr-forward-sexp) | |
| 1193 (setq end (point)) | |
| 1194 (goto-char begin) | |
| 1195 (cons begin end))) | |
| 1196 | |
| 1197 (defun expr-next () | |
| 1198 "Returns the following expr, point is set to beginning of that expr. | |
| 1199 The expr is represented as a cons cell, where the car specifies the point in | |
| 1200 the current buffer that marks the beginning of the expr and the cdr specifies | |
| 1201 the character after the end of the expr." | |
| 1202 (let ((begin) (end)) | |
| 1203 (expr-forward-sexp) | |
| 1204 (expr-forward-sexp) | |
| 1205 (setq end (point)) | |
| 1206 (expr-backward-sexp) | |
| 1207 (setq begin (point)) | |
| 1208 (cons begin end))) | |
| 1209 | |
| 1210 (defun expr-compound-sep (span-start span-end) | |
| 1211 "Returns '.' for '->' & '.', returns ' ' for white space, | |
| 1212 returns '?' for other punctuation." | |
| 1213 (let ((result ? ) | |
| 1214 (syntax)) | |
| 1215 (while (< span-start span-end) | |
| 1216 (setq syntax (char-syntax (char-after span-start))) | |
| 1217 (cond | |
| 1218 ((= syntax ? ) t) | |
| 1219 ((= syntax ?.) (setq syntax (char-after span-start)) | |
| 1220 (cond | |
| 1221 ((= syntax ?.) (setq result ?.)) | |
| 1222 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) | |
| 1223 (setq result ?.) | |
| 1224 (setq span-start (+ span-start 1))) | |
| 1225 (t (setq span-start span-end) | |
| 1226 (setq result ??))))) | |
| 1227 (setq span-start (+ span-start 1))) | |
| 1228 result)) | |
| 1229 | |
| 1230 (defun expr-compound (first second) | |
| 1231 "Non-nil if concatenating FIRST and SECOND makes a single C token. | |
| 1232 The two exprs are represented as a cons cells, where the car | |
| 1233 specifies the point in the current buffer that marks the beginning of the | |
| 1234 expr and the cdr specifies the character after the end of the expr. | |
| 1235 Link exprs of the form: | |
| 1236 Expr -> Expr | |
| 1237 Expr . Expr | |
| 1238 Expr (Expr) | |
| 1239 Expr [Expr] | |
| 1240 (Expr) Expr | |
| 1241 [Expr] Expr" | |
| 1242 (let ((span-start (cdr first)) | |
| 1243 (span-end (car second)) | |
| 1244 (syntax)) | |
| 1245 (setq syntax (expr-compound-sep span-start span-end)) | |
| 1246 (cond | |
| 1247 ((= (car first) (car second)) nil) | |
| 1248 ((= (cdr first) (cdr second)) nil) | |
| 1249 ((= syntax ?.) t) | |
| 1250 ((= syntax ? ) | |
| 1251 (setq span-start (char-after (- span-start 1))) | |
| 1252 (setq span-end (char-after span-end)) | |
| 1253 (cond | |
| 1254 ((= span-start ?) ) t ) | |
| 1255 ((= span-start ?] ) t ) | |
| 1256 ((= span-end ?( ) t ) | |
| 1257 ((= span-end ?[ ) t ) | |
| 1258 (t nil)) | |
| 1259 ) | |
| 1260 (t nil)))) | |
| 1261 | |
| 1262 (provide 'tgud) | |
| 1263 | |
| 1264 ;;; tgud.el ends here |