code.delx.au - gnu-emacs/blob - lisp/gud.el

   1 ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb
   2 ;;;            under Emacs
   3
   4 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
   5 ;; Version: 1.3
   6 ;; Keywords: unix, tools
   7
   8 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
  29 ;; It was later rewritten by rms.  Some ideas were due to Masanobu.
  30 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
  31 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
  32 ;; who also hacked the mode to use comint.el.  Shane Hartman <shane@spr.com>
  33 ;; added support for xdb (HPUX debugger).
  34
  35 ;;; Code:
  36
  37 (require 'comint)
  38 (require 'etags)
  39
  40 ;; ======================================================================
  41 ;; GUD commands must be visible in C buffers visited by GUD
  42
  43 (defvar gud-key-prefix "\C-x\C-a"
  44   "Prefix of all GUD commands valid in C buffers.")
  45
  46 (global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
  47 (global-set-key "\C-x " 'gud-break)     ;; backward compatibility hack
  48
  49 ;; ======================================================================
  50 ;; the overloading mechanism
  51
  52 (defun gud-overload-functions (gud-overload-alist)
  53   "Overload functions defined in GUD-OVERLOAD-ALIST.
  54 This association list has elements of the form
  55      (ORIGINAL-FUNCTION-NAME  OVERLOAD-FUNCTION)"
  56   (mapcar
  57    (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
  58    gud-overload-alist))
  59
  60 (defun gud-massage-args (file args)
  61   (error "GUD not properly entered."))
  62
  63 (defun gud-marker-filter (str)
  64   (error "GUD not properly entered."))
  65
  66 (defun gud-find-file (f)
  67   (error "GUD not properly entered."))
  68
  69 ;; ======================================================================
  70 ;; command definition
  71
  72 ;; This macro is used below to define some basic debugger interface commands.
  73 ;; Of course you may use `gud-def' with any other debugger command, including
  74 ;; user defined ones.
  75
  76 ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
  77 ;; which defines FUNC to send the command NAME to the debugger, gives
  78 ;; it the docstring DOC, and binds that function to KEY in the GUD
  79 ;; major mode.  The function is also bound in the global keymap with the
  80 ;; GUD prefix.
  81
  82 (defmacro gud-def (func cmd key &optional doc)
  83   "Define FUNC to be a command sending STR and bound to KEY, with
  84 optional doc string DOC.  Certain %-escapes in the string arguments
  85 are interpreted specially if present.  These are:
  86
  87   %f    name of current source file.
  88   %l    number of current source line
  89   %e    text of the C lvalue or function-call expression surrounding point.
  90   %a    text of the hexadecimal address surrounding point
  91   %p    prefix argument to the command (if any) as a number
  92
  93   The `current' source file is the file of the current buffer (if
  94 we're in a C file) or the source file current at the last break or
  95 step (if we're in the GUD buffer).
  96   The `current' line is that of the current buffer (if we're in a
  97 source file) or the source line number at the last break or step (if
  98 we're in the GUD buffer)."
  99   (list 'progn
 100         (list 'defun func '(arg)
 101               (or doc "")
 102               '(interactive "p")
 103               (list 'gud-call cmd 'arg))
 104         (if key
 105             (list 'define-key
 106                   '(current-local-map)
 107                   (concat "\C-c" key)
 108                   (list 'quote func)))
 109         (if key
 110             (list 'global-set-key
 111                   (list 'concat 'gud-key-prefix key)
 112                   (list 'quote func)))))
 113
 114 ;; Where gud-display-frame should put the debugging arrow.  This is
 115 ;; set by the marker-filter, which scans the debugger's output for
 116 ;; indications of the current program counter.
 117 (defvar gud-last-frame nil)
 118
 119 ;; Used by gud-refresh, which should cause gud-display-frame to redisplay
 120 ;; the last frame, even if it's been called before and gud-last-frame has
 121 ;; been set to nil.
 122 (defvar gud-last-last-frame)
 123
 124 ;; All debugger-specific information is collected here.
 125 ;; Here's how it works, in case you ever need to add a debugger to the mode.
 126 ;;
 127 ;; Each entry must define the following at startup:
 128 ;;
 129 ;;<name>
 130 ;; comint-prompt-regexp
 131 ;; gud-<name>-massage-args
 132 ;; gud-<name>-marker-filter
 133 ;; gud-<name>-find-file
 134 ;;
 135 ;; The job of the massage-args method is to modify the given list of
 136 ;; debugger arguments before running the debugger.
 137 ;;
 138 ;; The job of the marker-filter method is to detect file/line markers in
 139 ;; strings and set the global gud-last-frame to indicate what display
 140 ;; action (if any) should be triggered by the marker.  Note that only
 141 ;; whatever the method *returns* is displayed in the buffer; thus, you
 142 ;; can filter the debugger's output, interpreting some and passing on
 143 ;; the rest.
 144 ;;
 145 ;; The job of the find-file method is to visit and return the buffer indicated
 146 ;; by the car of gud-tag-frame.  This may be a file name, a tag name, or
 147 ;; something else.
 148
 149 ;; ======================================================================
 150 ;; gdb functions
 151
 152 ;;; History of argument lists passed to gdb.
 153 (defvar gud-gdb-history nil)
 154
 155 (defun gud-gdb-massage-args (file args)
 156   (cons "-fullname" (cons file args)))
 157
 158 (defun gud-gdb-marker-filter (string)
 159   (if (string-match  "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" string)
 160       (progn
 161         (setq gud-last-frame
 162               (cons
 163                (substring string (match-beginning 1) (match-end 1))
 164                (string-to-int
 165                 (substring string (match-beginning 2) (match-end 2)))))
 166         ;; this computation means the ^Z^Z-initiated marker in the
 167         ;; input string is never emitted.
 168         (concat
 169          (substring string 0 (match-beginning 0))
 170          (substring string (match-end 0))
 171          ))
 172     string))
 173
 174 (defun gud-gdb-find-file (f)
 175   (find-file-noselect f))
 176
 177 ;;;###autoload
 178 (defun gdb (command-line)
 179   "Run gdb on program FILE in buffer *gud-FILE*.
 180 The directory containing FILE becomes the initial working directory
 181 and source-file directory for your debugger."
 182   (interactive
 183    (list (read-from-minibuffer "Run gdb (like this): "
 184                                (if (consp gud-gdb-history)
 185                                    (car gud-gdb-history)
 186                                  "gdb ")
 187                                nil nil
 188                                '(gud-gdb-history . 1))))
 189   (gud-overload-functions '((gud-massage-args . gud-gdb-massage-args)
 190                             (gud-marker-filter . gud-gdb-marker-filter)
 191                             (gud-find-file . gud-gdb-find-file)
 192                             ))
 193
 194   (gud-common-init command-line)
 195
 196   (gud-def gud-break  "break %f:%l"  "\C-b" "Set breakpoint at current line.")
 197   (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
 198   (gud-def gud-remove "clear %l"     "\C-d" "Remove breakpoint at current line")
 199   (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
 200   (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
 201   (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
 202   (gud-def gud-cont   "cont"         "\C-r" "Continue with display.")
 203   (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
 204   (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
 205   (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
 206   (gud-def gud-print  "print %e"     "\C-p" "Evaluate C expression at point.")
 207
 208   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
 209   (run-hooks 'gdb-mode-hook)
 210   )
 211
 212
 213 ;; ======================================================================
 214 ;; sdb functions
 215
 216 ;;; History of argument lists passed to sdb.
 217 (defvar gud-sdb-history nil)
 218
 219 (defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
 220   "If nil, we're on a System V Release 4 and don't need the tags hack.")
 221
 222 (defvar gud-sdb-lastfile nil)
 223
 224 (defun gud-sdb-massage-args (file args)
 225   (cons file args))
 226
 227 (defun gud-sdb-marker-filter (string)
 228   (cond
 229    ;; System V Release 3.2 uses this format
 230    ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
 231                     string)
 232     (setq gud-last-frame
 233           (cons
 234            (substring string (match-beginning 2) (match-end 2))
 235            (string-to-int
 236             (substring string (match-beginning 3) (match-end 3))))))
 237    ;; System V Release 4.0
 238    ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
 239                        string)
 240     (setq gud-sdb-lastfile
 241           (substring string (match-beginning 2) (match-end 2))))
 242    ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
 243          (setq gud-last-frame
 244                (cons
 245                 gud-sdb-lastfile
 246                 (string-to-int
 247                  (substring string (match-beginning 1) (match-end 1))))))
 248    (t
 249     (setq gud-sdb-lastfile nil)))
 250   string)
 251
 252 (defun gud-sdb-find-file (f)
 253   (if gud-sdb-needs-tags
 254       (find-tag-noselect f)
 255     (find-file-noselect f)))
 256
 257 ;;;###autoload
 258 (defun sdb (command-line)
 259   "Run sdb on program FILE in buffer *gud-FILE*.
 260 The directory containing FILE becomes the initial working directory
 261 and source-file directory for your debugger."
 262   (interactive
 263    (list (read-from-minibuffer "Run sdb (like this): "
 264                                (if (consp gud-sdb-history)
 265                                    (car gud-sdb-history)
 266                                  "sdb ")
 267                                nil nil
 268                                '(gud-sdb-history . 1))))
 269   (if (and gud-sdb-needs-tags
 270            (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))))
 271       (error "The sdb support requires a valid tags table to work."))
 272   (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args)
 273                             (gud-marker-filter . gud-sdb-marker-filter)
 274                             (gud-find-file . gud-sdb-find-file)
 275                             ))
 276
 277   (gud-common-init command-line)
 278
 279   (gud-def gud-break  "%l b" "\C-b"   "Set breakpoint at current line.")
 280   (gud-def gud-tbreak "%l c" "\C-t"   "Set temporary breakpoint at current line.")
 281   (gud-def gud-remove "%l d" "\C-d"   "Remove breakpoint at current line")
 282   (gud-def gud-step   "s %p" "\C-s"   "Step one source line with display.")
 283   (gud-def gud-stepi  "i %p" "\C-i"   "Step one instruction with display.")
 284   (gud-def gud-next   "S %p" "\C-n"   "Step one line (skip functions).")
 285   (gud-def gud-cont   "c"    "\C-r"   "Continue with display.")
 286   (gud-def gud-print  "%e/"  "\C-p"   "Evaluate C expression at point.")
 287
 288   (setq comint-prompt-regexp  "\\(^\\|\n\\)\\*")
 289   (run-hooks 'sdb-mode-hook)
 290   )
 291
 292 ;; ======================================================================
 293 ;; dbx functions
 294
 295 ;;; History of argument lists passed to dbx.
 296 (defvar gud-dbx-history nil)
 297
 298 (defun gud-dbx-massage-args (file args)
 299   (cons file args))
 300
 301 (defun gud-dbx-marker-filter (string)
 302   (if (string-match
 303        "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string)
 304       (setq gud-last-frame
 305             (cons
 306              (substring string (match-beginning 2) (match-end 2))
 307              (string-to-int
 308               (substring string (match-beginning 1) (match-end 1))))))
 309   string)
 310
 311 (defun gud-dbx-find-file (f)
 312   (find-file-noselect f))
 313
 314 ;;;###autoload
 315 (defun dbx (command-line)
 316   "Run dbx on program FILE in buffer *gud-FILE*.
 317 The directory containing FILE becomes the initial working directory
 318 and source-file directory for your debugger."
 319   (interactive
 320    (list (read-from-minibuffer "Run dbx (like this): "
 321                                (if (consp gud-dbx-history)
 322                                    (car gud-dbx-history)
 323                                  "dbx ")
 324                                nil nil
 325                                '(gud-dbx-history . 1))))
 326   (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args)
 327                             (gud-marker-filter . gud-dbx-marker-filter)
 328                             (gud-find-file . gud-dbx-find-file)
 329                             ))
 330
 331   (gud-common-init command-line)
 332
 333   (gud-def gud-break  "file \"%f\"\nstop at %l"
 334                                   "\C-b" "Set breakpoint at current line.")
 335 ;;  (gud-def gud-break  "stop at \"%f\":%l"
 336 ;;                                "\C-b" "Set breakpoint at current line.")
 337   (gud-def gud-remove "clear %l"  "\C-d" "Remove breakpoint at current line")
 338   (gud-def gud-step   "step %p"   "\C-s" "Step one line with display.")
 339   (gud-def gud-stepi  "stepi %p"  "\C-i" "Step one instruction with display.")
 340   (gud-def gud-next   "next %p"   "\C-n" "Step one line (skip functions).")
 341   (gud-def gud-cont   "cont"      "\C-r" "Continue with display.")
 342   (gud-def gud-up     "up %p"     "<" "Up (numeric arg) stack frames.")
 343   (gud-def gud-down   "down %p"   ">" "Down (numeric arg) stack frames.")
 344   (gud-def gud-print  "print %e"  "\C-p" "Evaluate C expression at point.")
 345
 346   (setq comint-prompt-regexp  "^[^)]*dbx) *")
 347   (run-hooks 'dbx-mode-hook)
 348   )
 349
 350 ;; ======================================================================
 351 ;; xdb (HP PARISC debugger) functions
 352
 353 ;;; History of argument lists passed to xdb.
 354 (defvar gud-xdb-history nil)
 355
 356 (defvar gud-xdb-directories nil
 357   "*A list of directories that xdb should search for source code.
 358 If nil, only source files in the program directory
 359 will be known to xdb.
 360
 361 The file names should be absolute, or relative to the directory
 362 containing the executable being debugged.")
 363
 364 (defun gud-xdb-massage-args (file args)
 365   (nconc (let ((directories gud-xdb-directories)
 366                (result nil))
 367            (while directories
 368              (setq result (cons (car directories) (cons "-d" result)))
 369              (setq directories (cdr directories)))
 370            (nreverse (cons file result)))
 371          args))
 372
 373 (defun gud-xdb-file-name (f)
 374   "Transform a relative pathname to a full pathname in xdb mode"
 375   (let ((result nil))
 376     (if (file-exists-p f)
 377         (setq result (expand-file-name f))
 378       (let ((directories gud-xdb-directories))
 379         (while directories
 380           (let ((path (concat (car directories) "/" f)))
 381             (if (file-exists-p path)
 382                 (setq result (expand-file-name path)
 383                       directories nil)))
 384           (setq directories (cdr directories)))))
 385     result))
 386
 387 ;; xdb does not print the lines all at once, so we have to accumulate them
 388 (defvar gud-xdb-accumulation "")
 389
 390 (defun gud-xdb-marker-filter (string)
 391   (let (result)
 392     (if (or (string-match comint-prompt-regexp string)
 393             (string-match ".*\012" string))
 394         (setq result (concat gud-xdb-accumulation string)
 395               gud-xdb-accumulation "")
 396       (setq gud-xdb-accumulation (concat gud-xdb-accumulation string)))
 397     (if result
 398         (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result)
 399                 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
 400                               result))
 401             (let ((line (string-to-int
 402                          (substring result (match-beginning 2) (match-end 2))))
 403                   (file (gud-xdb-file-name
 404                          (substring result (match-beginning 1) (match-end 1)))))
 405               (if file
 406                   (setq gud-last-frame (cons file line))))))
 407     (or result "")))
 408
 409 (defun gud-xdb-find-file (f)
 410   (let ((realf (gud-xdb-file-name f)))
 411     (if realf (find-file-noselect realf))))
 412
 413 ;;;###autoload
 414 (defun xdb (command-line)
 415   "Run xdb on program FILE in buffer *gud-FILE*.
 416 The directory containing FILE becomes the initial working directory
 417 and source-file directory for your debugger.
 418
 419 You can set the variable 'gud-xdb-directories' to a list of program source
 420 directories if your program contains sources from more than one directory."
 421   (interactive
 422    (list (read-from-minibuffer "Run xdb (like this): "
 423                                (if (consp gud-xdb-history)
 424                                    (car gud-xdb-history)
 425                                  "xdb ")
 426                                nil nil
 427                                '(gud-xdb-history . 1))))
 428   (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args)
 429                             (gud-marker-filter . gud-xdb-marker-filter)
 430                             (gud-find-file . gud-xdb-find-file)))
 431
 432   (gud-common-init command-line)
 433
 434   (gud-def gud-break  "b %f:%l"    "\C-b" "Set breakpoint at current line.")
 435   (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
 436            "Set temporary breakpoint at current line.")
 437   (gud-def gud-remove "db"         "\C-d" "Remove breakpoint at current line")
 438   (gud-def gud-step   "s %p"       "\C-s" "Step one line with display.")
 439   (gud-def gud-next   "S %p"       "\C-n" "Step one line (skip functions).")
 440   (gud-def gud-cont   "c"          "\C-r" "Continue with display.")
 441   (gud-def gud-up     "up %p"      "<"    "Up (numeric arg) stack frames.")
 442   (gud-def gud-down   "down %p"    ">"    "Down (numeric arg) stack frames.")
 443   (gud-def gud-finish "bu\\t"      "\C-f" "Finish executing current function.")
 444   (gud-def gud-print  "p %e"       "\C-p" "Evaluate C expression at point.")
 445
 446   (setq comint-prompt-regexp  "^>")
 447   (make-local-variable 'gud-xdb-accumulation)
 448   (setq gud-xdb-accumulation "")
 449   (run-hooks 'xdb-mode-hook))
 450
 451 ;;
 452 ;; End of debugger-specific information
 453 ;;
 454
 455 ;;; When we send a command to the debugger via gud-call, it's annoying
 456 ;;; to see the command and the new prompt inserted into the debugger's
 457 ;;; buffer; we have other ways of knowing the command has completed.
 458 ;;;
 459 ;;; If the buffer looks like this:
 460 ;;; --------------------
 461 ;;; (gdb) set args foo bar
 462 ;;; (gdb) -!-
 463 ;;; --------------------
 464 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a
 465 ;;; source file to set a breakpoint, we want the buffer to end up like
 466 ;;; this:
 467 ;;; --------------------
 468 ;;; (gdb) set args foo bar
 469 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
 470 ;;; (gdb) -!-
 471 ;;; --------------------
 472 ;;; Essentially, the old prompt is deleted, and the command's output
 473 ;;; and the new prompt take its place.
 474 ;;;
 475 ;;; Not echoing the command is easy enough; you send it directly using
 476 ;;; process-send-string, and it never enters the buffer.  However,
 477 ;;; getting rid of the old prompt is trickier; you don't want to do it
 478 ;;; when you send the command, since that will result in an annoying
 479 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs
 480 ;;; waits for a response from the debugger, and the new prompt is
 481 ;;; inserted.  Instead, we'll wait until we actually get some output
 482 ;;; from the subprocess before we delete the prompt.  If the command
 483 ;;; produced no output other than a new prompt, that prompt will most
 484 ;;; likely be in the first chunk of output received, so we will delete
 485 ;;; the prompt and then replace it with an identical one.  If the
 486 ;;; command produces output, the prompt is moving anyway, so the
 487 ;;; flicker won't be annoying.
 488 ;;;
 489 ;;; So - when we want to delete the prompt upon receipt of the next
 490 ;;; chunk of debugger output, we position gud-delete-prompt-marker at
 491 ;;; the start of the prompt; the process filter will notice this, and
 492 ;;; delete all text between it and the process output marker.  If
 493 ;;; gud-delete-prompt-marker points nowhere, we leave the current
 494 ;;; prompt alone.
 495 (defvar gud-delete-prompt-marker nil)
 496
 497 \f
 498 (defun gud-mode ()
 499   "Major mode for interacting with an inferior debugger process.
 500
 501    You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
 502 or M-x xdb.  Each entry point finishes by executing a hook; `gdb-mode-hook',
 503 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively.
 504
 505 After startup, the following commands are available in both the GUD
 506 interaction buffer and any source buffer GUD visits due to a breakpoint stop
 507 or step operation:
 508
 509 \\[gud-break] sets a breakpoint at the current file and line.  In the
 510 GUD buffer, the current file and line are those of the last breakpoint or
 511 step.  In a source buffer, they are the buffer's file and current line.
 512
 513 \\[gud-remove] removes breakpoints on the current file and line.
 514
 515 \\[gud-refresh] displays in the source window the last line referred to
 516 in the gud buffer.
 517
 518 \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
 519 step-one-line (not entering function calls), and step-one-instruction
 520 and then update the source window with the current file and position.
 521 \\[gud-cont] continues execution.
 522
 523 \\[gud-print] tries to find the largest C lvalue or function-call expression
 524 around point, and sends it to the debugger for value display.
 525
 526 The above commands are common to all supported debuggers except xdb which
 527 does not support stepping instructions.
 528
 529 Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
 530 except that the breakpoint is temporary; that is, it is removed when
 531 execution stops on it.
 532
 533 Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
 534 frame.  \\[gud-down] drops back down through one.
 535
 536 If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
 537 the current function and stops.
 538
 539 All the keystrokes above are accessible in the GUD buffer
 540 with the prefix C-c, and in all buffers through the prefix C-x C-a.
 541
 542 All pre-defined functions for which the concept make sense repeat
 543 themselves the appropriate number of times if you give a prefix
 544 argument.
 545
 546 You may use the `gud-def' macro in the initialization hook to define other
 547 commands.
 548
 549 Other commands for interacting with the debugger process are inherited from
 550 comint mode, which see."
 551   (interactive)
 552   (comint-mode)
 553   (setq major-mode 'gud-mode)
 554   (setq mode-name "Debugger")
 555   (setq mode-line-process '(": %s"))
 556   (use-local-map (copy-keymap comint-mode-map))
 557   (make-local-variable 'gud-last-frame)
 558   (setq gud-last-frame nil)
 559   (make-local-variable 'comint-prompt-regexp)
 560   (make-local-variable 'gud-delete-prompt-marker)
 561   (setq gud-delete-prompt-marker (make-marker))
 562   (run-hooks 'gud-mode-hook)
 563 )
 564
 565 (defvar gud-comint-buffer nil)
 566
 567 ;; Chop STRING into words separated by SPC or TAB and return a list of them.
 568 (defun gud-chop-words (string)
 569   (let ((i 0) (beg 0)
 570         (len (length string))
 571         (words nil))
 572     (while (< i len)
 573       (if (memq (aref string i) '(?\t ? ))
 574           (progn
 575             (setq words (cons (substring string beg i) words)
 576                   beg (1+ i))
 577             (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
 578               (setq beg (1+ beg)))
 579             (setq i (1+ beg)))
 580         (setq i (1+ i))))
 581     (if (< beg len)
 582         (setq words (cons (substring string beg) words)))
 583     (nreverse words)))
 584
 585 ;; Perform initializations common to all debuggers.
 586 (defun gud-common-init (command-line)
 587   (let* ((words (gud-chop-words command-line))
 588          (program (car words))
 589          (file-word (let ((w (cdr words)))
 590                       (while (and w (= ?- (aref (car w) 0)))
 591                         (setq w (cdr w)))
 592                       (car w)))
 593          (args (delq file-word (cdr words)))
 594          (file (expand-file-name file-word))
 595          (filepart (file-name-nondirectory file)))
 596       (switch-to-buffer (concat "*gud-" filepart "*"))
 597       (setq default-directory (file-name-directory file))
 598       (or (bolp) (newline))
 599       (insert "Current directory is " default-directory "\n")
 600       (apply 'make-comint (concat "gud-" filepart) program nil
 601              (gud-massage-args file args)))
 602   (gud-mode)
 603   (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
 604   (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
 605   (gud-set-buffer)
 606   )
 607
 608 (defun gud-set-buffer ()
 609   (cond ((eq major-mode 'gud-mode)
 610         (setq gud-comint-buffer (current-buffer)))))
 611
 612 ;; These functions are responsible for inserting output from your debugger
 613 ;; into the buffer.  The hard work is done by the method that is
 614 ;; the value of gud-marker-filter.
 615
 616 (defun gud-filter (proc string)
 617   ;; Here's where the actual buffer insertion is done
 618   (let ((inhibit-quit t))
 619     (save-excursion
 620       (set-buffer (process-buffer proc))
 621       (let (moving output-after-point)
 622         (save-excursion
 623           (goto-char (process-mark proc))
 624           ;; If we have been so requested, delete the debugger prompt.
 625           (if (marker-buffer gud-delete-prompt-marker)
 626               (progn
 627                 (delete-region (point) gud-delete-prompt-marker)
 628                 (set-marker gud-delete-prompt-marker nil)))
 629           (insert-before-markers (gud-marker-filter string))
 630           (setq moving (= (point) (process-mark proc)))
 631           (setq output-after-point (< (point) (process-mark proc)))
 632           ;; Check for a filename-and-line number.
 633           ;; Don't display the specified file
 634           ;; unless (1) point is at or after the position where output appears
 635           ;; and (2) this buffer is on the screen.
 636           (if (and gud-last-frame
 637                    (not output-after-point)
 638                    (get-buffer-window (current-buffer)))
 639               (gud-display-frame)))
 640         (if moving (goto-char (process-mark proc)))))))
 641
 642 (defun gud-sentinel (proc msg)
 643   (cond ((null (buffer-name (process-buffer proc)))
 644          ;; buffer killed
 645          ;; Stop displaying an arrow in a source file.
 646          (setq overlay-arrow-position nil)
 647          (set-process-buffer proc nil))
 648         ((memq (process-status proc) '(signal exit))
 649          ;; Stop displaying an arrow in a source file.
 650          (setq overlay-arrow-position nil)
 651          ;; Fix the mode line.
 652          (setq mode-line-process
 653                (concat ": "
 654                        (symbol-name (process-status proc))))
 655          (let* ((obuf (current-buffer)))
 656            ;; save-excursion isn't the right thing if
 657            ;;  process-buffer is current-buffer
 658            (unwind-protect
 659                (progn
 660                  ;; Write something in *compilation* and hack its mode line,
 661                  (set-buffer (process-buffer proc))
 662                  ;; Force mode line redisplay soon
 663                  (set-buffer-modified-p (buffer-modified-p))
 664                  (if (eobp)
 665                      (insert ?\n mode-name " " msg)
 666                    (save-excursion
 667                      (goto-char (point-max))
 668                      (insert ?\n mode-name " " msg)))
 669                  ;; If buffer and mode line will show that the process
 670                  ;; is dead, we can delete it now.  Otherwise it
 671                  ;; will stay around until M-x list-processes.
 672                  (delete-process proc))
 673              ;; Restore old buffer, but don't restore old point
 674              ;; if obuf is the gud buffer.
 675              (set-buffer obuf))))))
 676
 677 (defun gud-display-frame ()
 678   "Find and obey the last filename-and-line marker from the debugger.
 679 Obeying it means displaying in another window the specified file and line."
 680   (interactive)
 681   (if gud-last-frame
 682    (progn
 683      (gud-set-buffer)
 684      (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
 685      (setq gud-last-last-frame gud-last-frame
 686            gud-last-frame nil))))
 687
 688 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
 689 ;; and that its line LINE is visible.
 690 ;; Put the overlay-arrow on the line LINE in that buffer.
 691 ;; Most of the trickiness in here comes from wanting to preserve the current
 692 ;; region-restriction if that's possible.  We use an explicit display-buffer
 693 ;; to get around the fact that this is called inside a save-excursion.
 694
 695 (defun gud-display-line (true-file line)
 696   (let* ((buffer (gud-find-file true-file))
 697          (window (display-buffer buffer))
 698          (pos))
 699 ;;;    (if (equal buffer (current-buffer))
 700 ;;;     nil
 701 ;;;      (setq buffer-read-only nil))
 702     (save-excursion
 703 ;;;      (setq buffer-read-only t)
 704       (set-buffer buffer)
 705       (save-restriction
 706         (widen)
 707         (goto-line line)
 708         (setq pos (point))
 709         (setq overlay-arrow-string "=>")
 710         (or overlay-arrow-position
 711             (setq overlay-arrow-position (make-marker)))
 712         (set-marker overlay-arrow-position (point) (current-buffer)))
 713       (cond ((or (< pos (point-min)) (> pos (point-max)))
 714              (widen)
 715              (goto-char pos))))
 716     (set-window-point window overlay-arrow-position)))
 717
 718 ;;; The gud-call function must do the right thing whether its invoking
 719 ;;; keystroke is from the GUD buffer itself (via major-mode binding)
 720 ;;; or a C buffer.  In the former case, we want to supply data from
 721 ;;; gud-last-frame.  Here's how we do it:
 722
 723 (defun gud-format-command (str arg)
 724   (let ((insource (not (eq (current-buffer) gud-comint-buffer))))
 725     (if (string-match "\\(.*\\)%f\\(.*\\)" str)
 726         (progn
 727           (setq str (concat
 728                      (substring str (match-beginning 1) (match-end 1))
 729                      (file-name-nondirectory (if insource
 730                                                  (buffer-file-name)
 731                                                (car gud-last-frame)))
 732                      (substring str (match-beginning 2) (match-end 2))))))
 733     (if (string-match "\\(.*\\)%l\\(.*\\)" str)
 734         (progn
 735           (setq str (concat
 736                      (substring str (match-beginning 1) (match-end 1))
 737                      (if insource
 738                          (save-excursion
 739                            (beginning-of-line)
 740                            (save-restriction (widen)
 741                                              (1+ (count-lines 1 (point)))))
 742                        (cdr gud-last-frame))
 743                      (substring str (match-beginning 2) (match-end 2))))))
 744     (if (string-match "\\(.*\\)%e\\(.*\\)" str)
 745         (progn
 746           (setq str (concat
 747                      (substring str (match-beginning 1) (match-end 1))
 748                      (find-c-expr)
 749                      (substring str (match-beginning 2) (match-end 2))))))
 750     (if (string-match "\\(.*\\)%a\\(.*\\)" str)
 751         (progn
 752           (setq str (concat
 753                      (substring str (match-beginning 1) (match-end 1))
 754                      (gud-read-address)
 755                      (substring str (match-beginning 2) (match-end 2))))))
 756     (if (string-match "\\(.*\\)%p\\(.*\\)" str)
 757         (progn
 758           (setq str (concat
 759                      (substring str (match-beginning 1) (match-end 1))
 760                      (if arg (int-to-string arg) "")
 761                      (substring str (match-beginning 2) (match-end 2))))))
 762     )
 763   str
 764   )
 765
 766 (defun gud-read-address ()
 767   "Return a string containing the core-address found in the buffer at point."
 768   (save-excursion
 769     (let ((pt (point)) found begin)
 770       (setq found (if (search-backward "0x" (- pt 7) t) (point)))
 771       (cond
 772        (found (forward-char 2)
 773               (buffer-substring found
 774                                 (progn (re-search-forward "[^0-9a-f]")
 775                                        (forward-char -1)
 776                                        (point))))
 777        (t (setq begin (progn (re-search-backward "[^0-9]")
 778                              (forward-char 1)
 779                              (point)))
 780           (forward-char 1)
 781           (re-search-forward "[^0-9]")
 782           (forward-char -1)
 783           (buffer-substring begin (point)))))))
 784
 785 (defun gud-call (fmt &optional arg)
 786   (let ((msg (gud-format-command fmt arg)))
 787     (message "Command: %s" msg)
 788     (sit-for 0)
 789     (gud-basic-call msg)))
 790
 791 (defun gud-basic-call (command)
 792   "Invoke the debugger COMMAND displaying source in other window."
 793   (interactive)
 794   (gud-set-buffer)
 795   (let ((command (concat command "\n"))
 796         (proc (get-buffer-process gud-comint-buffer)))
 797
 798     ;; Arrange for the current prompt to get deleted.
 799     (save-excursion
 800       (set-buffer gud-comint-buffer)
 801       (goto-char (process-mark proc))
 802       (beginning-of-line)
 803       (if (looking-at comint-prompt-regexp)
 804           (set-marker gud-delete-prompt-marker (point))))
 805     (process-send-string proc command)))
 806
 807 (defun gud-refresh (&optional arg)
 808   "Fix up a possibly garbled display, and redraw the arrow."
 809   (interactive "P")
 810   (recenter arg)
 811   (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
 812   (gud-display-frame))
 813 \f
 814 ;;; Code for parsing expressions out of C code.  The single entry point is
 815 ;;; find-c-expr, which tries to return an lvalue expression from around point.
 816 ;;;
 817 ;;; The rest of this file is a hacked version of gdbsrc.el by
 818 ;;; Debby Ayers <ayers@asc.slb.com>,
 819 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
 820
 821 (defun find-c-expr ()
 822   "Returns the C expr that surrounds point."
 823   (interactive)
 824   (save-excursion
 825     (let ((p) (expr) (test-expr))
 826       (setq p (point))
 827       (setq expr (expr-cur))
 828       (setq test-expr (expr-prev))
 829       (while (expr-compound test-expr expr)
 830         (setq expr (cons (car test-expr) (cdr expr)))
 831         (goto-char (car expr))
 832         (setq test-expr (expr-prev)))
 833       (goto-char p)
 834       (setq test-expr (expr-next))
 835       (while (expr-compound expr test-expr)
 836         (setq expr (cons (car expr) (cdr test-expr)))
 837         (setq test-expr (expr-next))
 838         )
 839       (buffer-substring (car expr) (cdr expr)))))
 840
 841 (defun expr-cur ()
 842   "Returns the expr that point is in; point is set to beginning of expr.
 843 The expr is represented as a cons cell, where the car specifies the point in
 844 the current buffer that marks the beginning of the expr and the cdr specifies
 845 the character after the end of the expr."
 846   (let ((p (point)) (begin) (end))
 847     (expr-backward-sexp)
 848     (setq begin (point))
 849     (expr-forward-sexp)
 850     (setq end (point))
 851     (if (>= p end)
 852         (progn
 853          (setq begin p)
 854          (goto-char p)
 855          (expr-forward-sexp)
 856          (setq end (point))
 857          )
 858       )
 859     (goto-char begin)
 860     (cons begin end)))
 861
 862 (defun expr-backward-sexp ()
 863   "Version of `backward-sexp' that catches errors."
 864   (condition-case nil
 865       (backward-sexp)
 866     (error t)))
 867
 868 (defun expr-forward-sexp ()
 869   "Version of `forward-sexp' that catches errors."
 870   (condition-case nil
 871      (forward-sexp)
 872     (error t)))
 873
 874 (defun expr-prev ()
 875   "Returns the previous expr, point is set to beginning of that expr.
 876 The expr is represented as a cons cell, where the car specifies the point in
 877 the current buffer that marks the beginning of the expr and the cdr specifies
 878 the character after the end of the expr"
 879   (let ((begin) (end))
 880     (expr-backward-sexp)
 881     (setq begin (point))
 882     (expr-forward-sexp)
 883     (setq end (point))
 884     (goto-char begin)
 885     (cons begin end)))
 886
 887 (defun expr-next ()
 888   "Returns the following expr, point is set to beginning of that expr.
 889 The expr is represented as a cons cell, where the car specifies the point in
 890 the current buffer that marks the beginning of the expr and the cdr specifies
 891 the character after the end of the expr."
 892   (let ((begin) (end))
 893     (expr-forward-sexp)
 894     (expr-forward-sexp)
 895     (setq end (point))
 896     (expr-backward-sexp)
 897     (setq begin (point))
 898     (cons begin end)))
 899
 900 (defun expr-compound-sep (span-start span-end)
 901   "Returns '.' for '->' & '.', returns ' ' for white space,
 902 returns '?' for other punctuation."
 903   (let ((result ? )
 904         (syntax))
 905     (while (< span-start span-end)
 906       (setq syntax (char-syntax (char-after span-start)))
 907       (cond
 908        ((= syntax ? ) t)
 909        ((= syntax ?.) (setq syntax (char-after span-start))
 910         (cond
 911          ((= syntax ?.) (setq result ?.))
 912          ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
 913           (setq result ?.)
 914           (setq span-start (+ span-start 1)))
 915          (t (setq span-start span-end)
 916             (setq result ??)))))
 917       (setq span-start (+ span-start 1)))
 918     result))
 919
 920 (defun expr-compound (first second)
 921   "Non-nil if concatenating FIRST and SECOND makes a single C token.
 922 The two exprs are represented as a cons cells, where the car
 923 specifies the point in the current buffer that marks the beginning of the
 924 expr and the cdr specifies the character after the end of the expr.
 925 Link exprs of the form:
 926       Expr -> Expr
 927       Expr . Expr
 928       Expr (Expr)
 929       Expr [Expr]
 930       (Expr) Expr
 931       [Expr] Expr"
 932   (let ((span-start (cdr first))
 933         (span-end (car second))
 934         (syntax))
 935     (setq syntax (expr-compound-sep span-start span-end))
 936     (cond
 937      ((= (car first) (car second)) nil)
 938      ((= (cdr first) (cdr second)) nil)
 939      ((= syntax ?.) t)
 940      ((= syntax ? )
 941          (setq span-start (char-after (- span-start 1)))
 942          (setq span-end (char-after span-end))
 943          (cond
 944           ((= span-start ?) ) t )
 945           ((= span-start ?] ) t )
 946           ((= span-end ?( ) t )
 947           ((= span-end ?[ ) t )
 948           (t nil))
 949          )
 950      (t nil))))
 951
 952 (provide 'gud)
 953
 954 ;;; gud.el ends here