cgit.sxemacs.org Git - packages/blob - xemacs-packages/eterm/tgud.el

   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 \f
  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 \f
 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 "\r?\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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
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