contrib/gdb/gdb/gdba.el

   1 (defmacro gud (form)
   2   (` (save-excursion (set-buffer "*gud-a.out*") (, form))))
   3
   4 (defun dbug (foo &optional fun)
   5   (save-excursion
   6     (set-buffer (get-buffer-create "*trace*"))
   7     (goto-char (point-max))
   8     (insert "***" (symbol-name foo) "\n")
   9     (if fun
  10         (funcall fun))))
  11
  12
  13 ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb
  14 ;;;            under Emacs
  15
  16 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
  17 ;; Maintainer: FSF
  18 ;; Version: 1.3
  19 ;; Keywords: unix, tools
  20
  21 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  22
  23 ;; This file is part of GNU Emacs.
  24
  25 ;; GNU Emacs is free software; you can redistribute it and/or modify
  26 ;; it under the terms of the GNU General Public License as published by
  27 ;; the Free Software Foundation; either version 2, or (at your option)
  28 ;; any later version.
  29
  30 ;; GNU Emacs is distributed in the hope that it will be useful,
  31 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  32 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33 ;; GNU General Public License for more details.
  34
  35 ;; You should have received a copy of the GNU General Public License
  36 ;; along with GNU Emacs; if not, write to the Free Software
  37 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  38
  39 ;;; Commentary:
  40
  41 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
  42 ;; It was later rewritten by rms.  Some ideas were due to Masanobu.
  43 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
  44 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
  45 ;; who also hacked the mode to use comint.el.  Shane Hartman <shane@spr.com>
  46 ;; added support for xdb (HPUX debugger).
  47
  48 ;; Cygnus Support added support for gdb's --annotate=2.
  49
  50 ;;; Code:
  51
  52 (require 'comint)
  53 (require 'etags)
  54
  55 ;; ======================================================================
  56 ;; GUD commands must be visible in C buffers visited by GUD
  57
  58 (defvar gud-key-prefix "\C-x\C-a"
  59   "Prefix of all GUD commands valid in C buffers.")
  60
  61 (global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
  62 (global-set-key "\C-x " 'gud-break)     ;; backward compatibility hack
  63
  64 ;; ======================================================================
  65 ;; the overloading mechanism
  66
  67 (defun gud-overload-functions (gud-overload-alist)
  68   "Overload functions defined in GUD-OVERLOAD-ALIST.
  69 This association list has elements of the form
  70      (ORIGINAL-FUNCTION-NAME  OVERLOAD-FUNCTION)"
  71   (mapcar
  72    (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
  73    gud-overload-alist))
  74
  75 (defun gud-massage-args (file args)
  76   (error "GUD not properly entered."))
  77
  78 (defun gud-marker-filter (str)
  79   (error "GUD not properly entered."))
  80
  81 (defun gud-find-file (f)
  82   (error "GUD not properly entered."))
  83 \f
  84 ;; ======================================================================
  85 ;; command definition
  86
  87 ;; This macro is used below to define some basic debugger interface commands.
  88 ;; Of course you may use `gud-def' with any other debugger command, including
  89 ;; user defined ones.
  90
  91 ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
  92 ;; which defines FUNC to send the command NAME to the debugger, gives
  93 ;; it the docstring DOC, and binds that function to KEY in the GUD
  94 ;; major mode.  The function is also bound in the global keymap with the
  95 ;; GUD prefix.
  96
  97 (defmacro gud-def (func cmd key &optional doc)
  98   "Define FUNC to be a command sending STR and bound to KEY, with
  99 optional doc string DOC.  Certain %-escapes in the string arguments
 100 are interpreted specially if present.  These are:
 101
 102   %f    name (without directory) of current source file.
 103   %d    directory of current source file.
 104   %l    number of current source line
 105   %e    text of the C lvalue or function-call expression surrounding point.
 106   %a    text of the hexadecimal address surrounding point
 107   %p    prefix argument to the command (if any) as a number
 108
 109   The `current' source file is the file of the current buffer (if
 110 we're in a C file) or the source file current at the last break or
 111 step (if we're in the GUD buffer).
 112   The `current' line is that of the current buffer (if we're in a
 113 source file) or the source line number at the last break or step (if
 114 we're in the GUD buffer)."
 115   (list 'progn
 116         (list 'defun func '(arg)
 117               (or doc "")
 118               '(interactive "p")
 119               (list 'gud-call cmd 'arg))
 120         (if key
 121             (list 'define-key
 122                   '(current-local-map)
 123                   (concat "\C-c" key)
 124                   (list 'quote func)))
 125         (if key
 126             (list 'global-set-key
 127                   (list 'concat 'gud-key-prefix key)
 128                   (list 'quote func)))))
 129
 130 ;; Where gud-display-frame should put the debugging arrow.  This is
 131 ;; set by the marker-filter, which scans the debugger's output for
 132 ;; indications of the current program counter.
 133 (defvar gud-last-frame nil)
 134
 135 ;; Used by gud-refresh, which should cause gud-display-frame to redisplay
 136 ;; the last frame, even if it's been called before and gud-last-frame has
 137 ;; been set to nil.
 138 (defvar gud-last-last-frame nil)
 139
 140 ;; All debugger-specific information is collected here.
 141 ;; Here's how it works, in case you ever need to add a debugger to the mode.
 142 ;;
 143 ;; Each entry must define the following at startup:
 144 ;;
 145 ;;<name>
 146 ;; comint-prompt-regexp
 147 ;; gud-<name>-massage-args
 148 ;; gud-<name>-marker-filter
 149 ;; gud-<name>-find-file
 150 ;;
 151 ;; The job of the massage-args method is to modify the given list of
 152 ;; debugger arguments before running the debugger.
 153 ;;
 154 ;; The job of the marker-filter method is to detect file/line markers in
 155 ;; strings and set the global gud-last-frame to indicate what display
 156 ;; action (if any) should be triggered by the marker.  Note that only
 157 ;; whatever the method *returns* is displayed in the buffer; thus, you
 158 ;; can filter the debugger's output, interpreting some and passing on
 159 ;; the rest.
 160 ;;
 161 ;; The job of the find-file method is to visit and return the buffer indicated
 162 ;; by the car of gud-tag-frame.  This may be a file name, a tag name, or
 163 ;; something else.
 164 \f
 165 ;; ======================================================================
 166 ;; gdb functions
 167
 168 ;;; History of argument lists passed to gdb.
 169 (defvar gud-gdb-history nil)
 170
 171 (defun gud-gdb-massage-args (file args)
 172   (cons "--annotate=2" (cons file args)))
 173
 174 \f
 175 ;;
 176 ;; In this world, there are gdb instance objects (of unspecified
 177 ;; representation) and buffers associated with those objects.
 178 ;;
 179
 180 ;;
 181 ;; gdb-instance objects
 182 ;;
 183
 184 (defun make-gdb-instance (proc)
 185   "Create a gdb instance object from a gdb process."
 186   (setq last-proc proc)
 187   (let ((instance (cons 'gdb-instance proc)))
 188     (save-excursion
 189       (set-buffer (process-buffer proc))
 190       (setq gdb-buffer-instance instance)
 191       (progn
 192         (mapcar 'make-variable-buffer-local gdb-instance-variables)
 193         (setq gdb-buffer-type 'gud)
 194         ;; If we're taking over the buffer of another process,
 195         ;; take over it's ancillery buffers as well.
 196         ;;
 197         (let ((dead (or old-gdb-buffer-instance)))
 198           (mapcar
 199            (function
 200             (lambda (b)
 201               (progn
 202                 (set-buffer b)
 203                 (if (eq dead gdb-buffer-instance)
 204                     (setq gdb-buffer-instance instance)))))
 205              (buffer-list)))))
 206     instance))
 207
 208 (defun gdb-instance-process (inst) (cdr inst))
 209
 210 ;;; The list of instance variables is built up by the expansions of
 211 ;;; DEF-GDB-VARIABLE
 212 ;;;
 213 (defvar gdb-instance-variables '()
 214   "A list of variables that are local to the gud buffer associated
 215 with a gdb instance.")
 216
 217 (defmacro def-gdb-variable
 218   (name accessor setter &optional default doc)
 219   (`
 220    (progn
 221      (defvar (, name) (, default) (, (or doc "undocumented")))
 222      (if (not (memq '(, name) gdb-instance-variables))
 223          (setq gdb-instance-variables
 224                (cons '(, name) gdb-instance-variables)))
 225      (, (and accessor
 226              (`
 227               (defun (, accessor) (instance)
 228                 (let
 229                     ((buffer (gdb-get-instance-buffer instance 'gud)))
 230                   (and buffer
 231                        (save-excursion
 232                          (set-buffer buffer)
 233                          (, name))))))))
 234      (, (and setter
 235              (`
 236               (defun (, setter) (instance val)
 237                 (let
 238                     ((buffer (gdb-get-instance-buffer instance 'gud)))
 239                   (and buffer
 240                        (save-excursion
 241                          (set-buffer buffer)
 242                          (setq (, name) val)))))))))))
 243
 244 (defmacro def-gdb-var (root-symbol &optional default doc)
 245   (let* ((root (symbol-name root-symbol))
 246          (accessor (intern (concat "gdb-instance-" root)))
 247          (setter (intern (concat "set-gdb-instance-" root)))
 248          (var-name (intern (concat "gdb-" root))))
 249     (` (def-gdb-variable
 250          (, var-name) (, accessor) (, setter)
 251          (, default) (, doc)))))
 252
 253 (def-gdb-var buffer-instance nil
 254   "In an instance buffer, the buffer's instance.")
 255
 256 (def-gdb-var buffer-type nil
 257   "One of the symbols bound in gdb-instance-buffer-rules")
 258
 259 (def-gdb-var burst ""
 260   "A string of characters from gdb that have not yet been processed.")
 261
 262 (def-gdb-var input-queue ()
 263   "A list of high priority gdb command objects.")
 264
 265 (def-gdb-var idle-input-queue ()
 266   "A list of low priority gdb command objects.")
 267
 268 (def-gdb-var prompting nil
 269   "True when gdb is idle with no pending input.")
 270
 271 (def-gdb-var output-sink 'user
 272   "The disposition of the output of the current gdb command.
 273 Possible values are these symbols:
 274
 275     user -- gdb output should be copied to the gud buffer
 276             for the user to see.
 277
 278     inferior -- gdb output should be copied to the inferior-io buffer
 279
 280     pre-emacs -- output should be ignored util the post-prompt
 281                  annotation is received.  Then the output-sink
 282                  becomes:...
 283     emacs -- output should be collected in the partial-output-buffer
 284              for subsequent processing by a command.  This is the
 285              disposition of output generated by commands that
 286              gud mode sends to gdb on its own behalf.
 287     post-emacs -- ignore input until the prompt annotation is
 288                   received, then go to USER disposition.
 289 ")
 290
 291 (def-gdb-var current-item nil
 292   "The most recent command item sent to gdb.")
 293
 294 (def-gdb-var pending-triggers '()
 295   "A list of trigger functions that have run later than their output
 296 handlers.")
 297
 298 (defun in-gdb-instance-context (instance form)
 299   "Funcall `form' in the gud buffer of `instance'"
 300   (save-excursion
 301     (set-buffer (gdb-get-instance-buffer instance 'gud))
 302     (funcall form)))
 303
 304 ;; end of instance vars
 305
 306 ;;
 307 ;; finding instances
 308 ;;
 309
 310 (defun gdb-proc->instance (proc)
 311   (save-excursion
 312     (set-buffer (process-buffer proc))
 313     gdb-buffer-instance))
 314
 315 (defun gdb-mru-instance-buffer ()
 316   "Return the most recently used (non-auxiliary) gdb gud buffer."
 317   (save-excursion
 318     (gdb-goto-first-gdb-instance (buffer-list))))
 319
 320 (defun gdb-goto-first-gdb-instance (blist)
 321   "Use gdb-mru-instance-buffer -- not this."
 322   (and blist
 323        (progn
 324          (set-buffer (car blist))
 325          (or (and gdb-buffer-instance
 326                   (eq gdb-buffer-type 'gud)
 327                   (car blist))
 328              (gdb-goto-first-gdb-instance (cdr blist))))))
 329
 330 (defun buffer-gdb-instance (buf)
 331   (save-excursion
 332     (set-buffer buf)
 333     gdb-buffer-instance))
 334
 335 (defun gdb-needed-default-instance ()
 336   "Return the most recently used gdb instance or signal an error."
 337   (let ((buffer (gdb-mru-instance-buffer)))
 338     (or (and buffer (buffer-gdb-instance buffer))
 339         (error "No instance of gdb found."))))
 340
 341 (defun gdb-instance-target-string (instance)
 342   "The apparent name of the program being debugged by a gdb instance.
 343 For sure this the root string used in smashing together the gud
 344 buffer's name, even if that doesn't happen to be the name of a
 345 program."
 346   (in-gdb-instance-context
 347    instance
 348    (function (lambda () gud-target-name))))
 349
 350 \f
 351
 352 ;;
 353 ;; Instance Buffers.
 354 ;;
 355
 356 ;; More than one buffer can be associated with a gdb instance.
 357 ;;
 358 ;; Each buffer has a TYPE -- a symbol that identifies the function
 359 ;; of that particular buffer.
 360 ;;
 361 ;; The usual gud interaction buffer is given the type `gud' and
 362 ;; is constructed specially.
 363 ;;
 364 ;; Others are constructed by gdb-get-create-instance-buffer and
 365 ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc
 366
 367 (defun gdb-get-instance-buffer (instance key)
 368   "Return the instance buffer for `instance' tagged with type `key'.
 369 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
 370   (save-excursion
 371     (gdb-look-for-tagged-buffer instance key (buffer-list))))
 372
 373 (defun gdb-get-create-instance-buffer (instance key)
 374   "Create a new gdb instance buffer of the type specified by `key'.
 375 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
 376   (or (gdb-get-instance-buffer instance key)
 377       (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
 378              (name (funcall (gdb-rules-name-maker rules) instance))
 379              (new (get-buffer-create name)))
 380         (save-excursion
 381           (set-buffer new)
 382           (make-variable-buffer-local 'gdb-buffer-type)
 383           (setq gdb-buffer-type key)
 384           (make-variable-buffer-local 'gdb-buffer-instance)
 385           (setq gdb-buffer-instance instance)
 386           (if (cdr (cdr rules))
 387               (funcall (car (cdr (cdr rules)))))
 388           new))))
 389
 390 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
 391
 392 (defun gdb-look-for-tagged-buffer (instance key bufs)
 393   (let ((retval nil))
 394     (while (and (not retval) bufs)
 395       (set-buffer (car bufs))
 396       (if (and (eq gdb-buffer-instance instance)
 397                (eq gdb-buffer-type key))
 398           (setq retval (car bufs)))
 399       (setq bufs (cdr bufs))
 400       )
 401     retval))
 402
 403 (defun gdb-instance-buffer-p (buf)
 404   (save-excursion
 405     (set-buffer buf)
 406     (and gdb-buffer-type
 407          (not (eq gdb-buffer-type 'gud)))))
 408
 409 ;;
 410 ;; This assoc maps buffer type symbols to rules.  Each rule is a list of
 411 ;; at least one and possible more functions.  The functions have these
 412 ;; roles in defining a buffer type:
 413 ;;
 414 ;;     NAME - take an instance, return a name for this type buffer for that
 415 ;;            instance.
 416 ;; The remaining function(s) are optional:
 417 ;;
 418 ;;     MODE - called in new new buffer with no arguments, should establish
 419 ;;            the proper mode for the buffer.
 420 ;;
 421
 422 (defvar gdb-instance-buffer-rules-assoc '())
 423
 424 (defun gdb-set-instance-buffer-rules (buffer-type &rest rules)
 425   (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc)))
 426     (if binding
 427         (setcdr binding rules)
 428       (setq gdb-instance-buffer-rules-assoc
 429             (cons (cons buffer-type rules)
 430                   gdb-instance-buffer-rules-assoc)))))
 431
 432 (gdb-set-instance-buffer-rules 'gud 'error) ; gud buffers are an exception to the rules
 433
 434 ;;
 435 ;; partial-output buffers
 436 ;;
 437 ;; These accumulate output from a command executed on
 438 ;; behalf of emacs (rather than the user).
 439 ;;
 440
 441 (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
 442                                'gdb-partial-output-name)
 443
 444 (defun gdb-partial-output-name (instance)
 445   (concat "*partial-output-"
 446           (gdb-instance-target-string instance)
 447           "*"))
 448
 449 \f
 450 (gdb-set-instance-buffer-rules 'gdb-inferior-io
 451                                'gdb-inferior-io-name
 452                                'gud-inferior-io-mode)
 453
 454 (defun gdb-inferior-io-name (instance)
 455   (concat "*input/output of "
 456           (gdb-instance-target-string instance)
 457           "*"))
 458
 459 (defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
 460 (define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
 461 (define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)
 462 (define-key comint-mode-map "\C-c\C-\\" 'gdb-inferior-io-quit)
 463 (define-key comint-mode-map "\C-c\C-d" 'gdb-inferior-io-eof)
 464
 465 (defun gud-inferior-io-mode ()
 466   "Major mode for gud inferior-io.
 467
 468 \\{comint-mode-map}"
 469   ;; We want to use comint because it has various nifty and familiar
 470   ;; features.  We don't need a process, but comint wants one, so create
 471   ;; a dummy one.
 472   (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1))
 473                "/bin/cat")
 474   (setq major-mode 'gud-inferior-io-mode)
 475   (setq mode-name "Debuggee I/O")
 476   (setq comint-input-sender 'gud-inferior-io-sender)
 477 )
 478
 479 (defun gud-inferior-io-sender (proc string)
 480   (save-excursion
 481     (set-buffer (process-buffer proc))
 482     (let ((instance gdb-buffer-instance))
 483       (set-buffer (gdb-get-instance-buffer instance 'gud))
 484       (let ((gud-proc (get-buffer-process (current-buffer))))
 485         (process-send-string gud-proc string)
 486         (process-send-string gud-proc "\n")
 487     ))
 488     ))
 489
 490 (defun gdb-inferior-io-interrupt (instance)
 491   "Interrupt the program being debugged."
 492   (interactive (list (gdb-needed-default-instance)))
 493   (interrupt-process
 494    (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
 495
 496 (defun gdb-inferior-io-quit (instance)
 497   "Send quit signal to the program being debugged."
 498   (interactive (list (gdb-needed-default-instance)))
 499   (quit-process
 500    (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
 501
 502 (defun gdb-inferior-io-stop (instance)
 503   "Stop the program being debugged."
 504   (interactive (list (gdb-needed-default-instance)))
 505   (stop-process
 506    (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
 507
 508 (defun gdb-inferior-io-eof (instance)
 509   "Send end-of-file to the program being debugged."
 510   (interactive (list (gdb-needed-default-instance)))
 511   (process-send-eof
 512    (get-buffer-process (gdb-get-instance-buffer instance 'gud))))
 513 \f
 514
 515 ;;
 516 ;; gdb communications
 517 ;;
 518
 519 ;; INPUT: things sent to gdb
 520 ;;
 521 ;; Each instance has a high and low priority
 522 ;; input queue.  Low priority input is sent only
 523 ;; when the high priority queue is idle.
 524 ;;
 525 ;; The queues are lists.  Each element is either
 526 ;; a string (indicating user or user-like input)
 527 ;; or a list of the form:
 528 ;;
 529 ;;    (INPUT-STRING  HANDLER-FN)
 530 ;;
 531 ;;
 532 ;; The handler function will be called from the
 533 ;; partial-output buffer when the command completes.
 534 ;; This is the way to write commands which
 535 ;; invoke gdb commands autonomously.
 536 ;;
 537 ;; These lists are consumed tail first.
 538 ;;
 539
 540 (defun gdb-send (proc string)
 541   "A comint send filter for gdb.
 542 This filter may simply queue output for a later time."
 543   (let ((instance (gdb-proc->instance proc)))
 544     (gdb-instance-enqueue-input instance (concat string "\n"))))
 545
 546 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
 547 ;; is a query, or other non-top-level prompt.  To guarantee stuff will get
 548 ;; sent to the top-level prompt, currently it must be put in the idle queue.
 549 ;;                               ^^^^^^^^^
 550 ;; [This should encourage gud extentions that invoke gdb commands to let
 551 ;;  the user go first; it is not a bug.     -t]
 552 ;;
 553
 554 (defun gdb-instance-enqueue-input (instance item)
 555   (if (gdb-instance-prompting instance)
 556       (progn
 557         (gdb-send-item instance item)
 558         (set-gdb-instance-prompting instance nil))
 559     (set-gdb-instance-input-queue
 560      instance
 561      (cons item (gdb-instance-input-queue instance)))))
 562
 563 (defun gdb-instance-dequeue-input (instance)
 564   (let ((queue (gdb-instance-input-queue instance)))
 565     (and queue
 566        (if (not (cdr queue))
 567            (let ((answer (car queue)))
 568              (set-gdb-instance-input-queue instance '())
 569              answer)
 570          (gdb-take-last-elt queue)))))
 571
 572 (defun gdb-instance-enqueue-idle-input (instance item)
 573   (if (and (gdb-instance-prompting instance)
 574            (not (gdb-instance-input-queue instance)))
 575       (progn
 576         (gdb-send-item instance item)
 577         (set-gdb-instance-prompting instance nil))
 578     (set-gdb-instance-idle-input-queue
 579      instance
 580      (cons item (gdb-instance-idle-input-queue instance)))))
 581
 582 (defun gdb-instance-dequeue-idle-input (instance)
 583   (let ((queue (gdb-instance-idle-input-queue instance)))
 584     (and queue
 585        (if (not (cdr queue))
 586            (let ((answer (car queue)))
 587              (set-gdb-instance-idle-input-queue instance '())
 588              answer)
 589          (gdb-take-last-elt queue)))))
 590
 591 ; Don't use this in general.
 592 (defun gdb-take-last-elt (l)
 593   (if (cdr (cdr l))
 594       (gdb-take-last-elt (cdr l))
 595     (let ((answer (car (cdr l))))
 596       (setcdr l '())
 597       answer)))
 598
 599 \f
 600 ;;
 601 ;; output -- things gdb prints to emacs
 602 ;;
 603 ;; GDB output is a stream interrupted by annotations.
 604 ;; Annotations can be recognized by their beginning
 605 ;; with \C-j\C-z\C-z<tag><opt>\C-j
 606 ;;
 607 ;; The tag is a string obeying symbol syntax.
 608 ;;
 609 ;; The optional part `<opt>' can be either the empty string
 610 ;; or a space followed by more data relating to the annotation.
 611 ;; For example, the SOURCE annotation is followed by a filename,
 612 ;; line number and various useless goo.  This data must not include
 613 ;; any newlines.
 614 ;;
 615
 616
 617 (defun gud-gdb-marker-filter (string)
 618   "A gud marker filter for gdb."
 619   ;; Bogons don't tell us the process except through scoping crud.
 620   (let ((instance (gdb-proc->instance proc)))
 621     (gdb-output-burst instance string)))
 622
 623 (defvar gdb-annotation-rules
 624   '(("frames-invalid" gdb-invalidate-frames)
 625     ("breakpoints-invalid" gdb-invalidate-breakpoints)
 626     ("pre-prompt" gdb-pre-prompt)
 627     ("prompt" gdb-prompt)
 628     ("commands" gdb-subprompt)
 629     ("overload-choice" gdb-subprompt)
 630     ("query" gdb-subprompt)
 631     ("prompt-for-continue" gdb-subprompt)
 632     ("post-prompt" gdb-post-prompt)
 633     ("source" gdb-source)
 634     ("starting" gdb-starting)
 635     ("exited" gdb-stopping)
 636     ("signalled" gdb-stopping)
 637     ("signal" gdb-stopping)
 638     ("breakpoint" gdb-stopping)
 639     ("watchpoint" gdb-stopping)
 640     ("stopped" gdb-stopped)
 641     )
 642   "An assoc mapping annotation tags to functions which process them.")
 643
 644
 645 (defun gdb-ignore-annotation (instance args)
 646   nil)
 647
 648 (defconst gdb-source-spec-regexp
 649   "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*")
 650
 651 ;; Do not use this except as an annotation handler."
 652 (defun gdb-source (instance args)
 653   (string-match gdb-source-spec-regexp args)
 654   ;; Extract the frame position from the marker.
 655   (setq gud-last-frame
 656         (cons
 657          (substring args (match-beginning 1) (match-end 1))
 658          (string-to-int (substring args
 659                                    (match-beginning 2)
 660                                    (match-end 2))))))
 661
 662 ;; An annotation handler for `prompt'.
 663 ;; This sends the next command (if any) to gdb.
 664 (defun gdb-prompt (instance ignored)
 665   (let ((sink (gdb-instance-output-sink instance)))
 666     (cond
 667      ((eq sink 'user) t)
 668      ((eq sink 'post-emacs)
 669       (set-gdb-instance-output-sink instance 'user))
 670      (t
 671       (set-gdb-instance-output-sink instance 'user)
 672       (error "Phase error in gdb-prompt (got %s)" sink))))
 673   (let ((highest (gdb-instance-dequeue-input instance)))
 674     (if highest
 675         (gdb-send-item instance highest)
 676       (let ((lowest (gdb-instance-dequeue-idle-input instance)))
 677         (if lowest
 678             (gdb-send-item instance lowest)
 679           (progn
 680             (set-gdb-instance-prompting instance t)
 681             (gud-display-frame)))))))
 682
 683 ;; An annotation handler for non-top-level prompts.
 684 (defun gdb-subprompt (instance ignored)
 685   (let ((highest (gdb-instance-dequeue-input instance)))
 686     (if highest
 687         (gdb-send-item instance highest)
 688       (set-gdb-instance-prompting instance t))))
 689
 690 (defun gdb-send-item (instance item)
 691   (set-gdb-instance-current-item instance item)
 692   (if (stringp item)
 693       (progn
 694         (set-gdb-instance-output-sink instance 'user)
 695         (process-send-string (gdb-instance-process instance)
 696                              item))
 697     (progn
 698       (gdb-clear-partial-output instance)
 699       (set-gdb-instance-output-sink instance 'pre-emacs)
 700       (process-send-string (gdb-instance-process instance)
 701                            (car item)))))
 702
 703 ;; An annotation handler for `pre-prompt'.
 704 ;; This terminates the collection of output from a previous
 705 ;; command if that happens to be in effect.
 706 (defun gdb-pre-prompt (instance ignored)
 707   (let ((sink (gdb-instance-output-sink instance)))
 708     (cond
 709      ((eq sink 'user) t)
 710      ((eq sink 'emacs)
 711       (set-gdb-instance-output-sink instance 'post-emacs)
 712       (let ((handler
 713              (car (cdr (gdb-instance-current-item instance)))))
 714         (save-excursion
 715           (set-buffer (gdb-get-create-instance-buffer
 716                        instance 'gdb-partial-output-buffer))
 717           (funcall handler))))
 718      (t
 719       (set-gdb-instance-output-sink instance 'user)
 720       (error "Output sink phase error 1.")))))
 721
 722 ;; An annotation handler for `starting'.  This says that I/O for the subprocess
 723 ;; is now the program being debugged, not GDB.
 724 (defun gdb-starting (instance ignored)
 725   (let ((sink (gdb-instance-output-sink instance)))
 726     (cond
 727      ((eq sink 'user)
 728       (set-gdb-instance-output-sink instance 'inferior)
 729       ;; FIXME: need to send queued input
 730       )
 731      (t (error "Unexpected `starting' annotation")))))
 732
 733 ;; An annotation handler for `exited' and other annotations which say that
 734 ;; I/O for the subprocess is now GDB, not the program being debugged.
 735 (defun gdb-stopping (instance ignored)
 736   (let ((sink (gdb-instance-output-sink instance)))
 737     (cond
 738      ((eq sink 'inferior)
 739       (set-gdb-instance-output-sink instance 'user)
 740       )
 741      (t (error "Unexpected stopping annotation")))))
 742
 743 ;; An annotation handler for `stopped'.  It is just like gdb-stopping, except
 744 ;; that if we already set the output sink to 'user in gdb-stopping, that is
 745 ;; fine.
 746 (defun gdb-stopped (instance ignored)
 747   (let ((sink (gdb-instance-output-sink instance)))
 748     (cond
 749      ((eq sink 'inferior)
 750       (set-gdb-instance-output-sink instance 'user)
 751       )
 752      ((eq sink 'user)
 753       t)
 754      (t (error "Unexpected stopping annotation")))))
 755
 756 ;; An annotation handler for `post-prompt'.
 757 ;; This begins the collection of output from the current
 758 ;; command if that happens to be appropriate."
 759 (defun gdb-post-prompt (instance ignored)
 760   (gdb-invalidate-registers instance ignored)
 761   (let ((sink (gdb-instance-output-sink instance)))
 762     (cond
 763      ((eq sink 'user) t)
 764      ((eq sink 'pre-emacs)
 765       (set-gdb-instance-output-sink instance 'emacs))
 766
 767      (t
 768       (set-gdb-instance-output-sink instance 'user)
 769       (error "Output sink phase error 3.")))))
 770
 771 ;; Handle a burst of output from a gdb instance.
 772 ;; This function is (indirectly) used as a gud-marker-filter.
 773 ;; It must return output (if any) to be insterted in the gud
 774 ;; buffer.
 775
 776 (defun gdb-output-burst (instance string)
 777   "Handle a burst of output from a gdb instance.
 778 This function is (indirectly) used as a gud-marker-filter.
 779 It must return output (if any) to be insterted in the gud
 780 buffer."
 781
 782   (save-match-data
 783     (let (
 784           ;; Recall the left over burst from last time
 785           (burst (concat (gdb-instance-burst instance) string))
 786           ;; Start accumulating output for the gud buffer
 787           (output ""))
 788
 789       ;; Process all the complete markers in this chunk.
 790
 791       (while (string-match "\n\032\032\\(.*\\)\n" burst)
 792         (let ((annotation (substring burst
 793                                      (match-beginning 1)
 794                                      (match-end 1))))
 795
 796           ;; Stuff prior to the match is just ordinary output.
 797           ;; It is either concatenated to OUTPUT or directed
 798           ;; elsewhere.
 799           (setq output
 800                 (gdb-concat-output
 801                  instance
 802                  output
 803                  (substring burst 0 (match-beginning 0))))
 804
 805           ;; Take that stuff off the burst.
 806           (setq burst (substring burst (match-end 0)))
 807
 808           ;; Parse the tag from the annotation, and maybe its arguments.
 809           (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
 810           (let* ((annotation-type (substring annotation
 811                                              (match-beginning 1)
 812                                              (match-end 1)))
 813                  (annotation-arguments (substring annotation
 814                                                   (match-beginning 2)
 815                                                   (match-end 2)))
 816                  (annotation-rule (assoc annotation-type
 817                                          gdb-annotation-rules)))
 818             ;; Call the handler for this annotation.
 819             (if annotation-rule
 820                 (funcall (car (cdr annotation-rule))
 821                          instance
 822                          annotation-arguments)
 823               ;; Else the annotation is not recognized.  Ignore it silently,
 824               ;; so that GDB can add new annotations without causing
 825               ;; us to blow up.
 826               ))))
 827
 828
 829       ;; Does the remaining text end in a partial line?
 830       ;; If it does, then keep part of the burst until we get more.
 831       (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
 832                         burst)
 833           (progn
 834             ;; Everything before the potential marker start can be output.
 835             (setq output
 836                   (gdb-concat-output
 837                    instance
 838                    output
 839                    (substring burst 0 (match-beginning 0))))
 840
 841             ;; Everything after, we save, to combine with later input.
 842             (setq burst (substring burst (match-beginning 0))))
 843
 844         ;; In case we know the burst contains no partial annotations:
 845         (progn
 846           (setq output (gdb-concat-output instance output burst))
 847           (setq burst "")))
 848
 849       ;; Save the remaining burst for the next call to this function.
 850       (set-gdb-instance-burst instance burst)
 851       output)))
 852
 853 (defun gdb-concat-output (instance so-far new)
 854   (let ((sink (gdb-instance-output-sink instance)))
 855     (cond
 856      ((eq sink 'user) (concat so-far new))
 857      ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
 858      ((eq sink 'emacs)
 859       (gdb-append-to-partial-output instance new)
 860       so-far)
 861      ((eq sink 'inferior)
 862       (gdb-append-to-inferior-io instance new)
 863       so-far)
 864      (t (error "Bogon output sink %S" sink)))))
 865
 866 (defun gdb-append-to-partial-output (instance string)
 867   (save-excursion
 868     (set-buffer
 869      (gdb-get-create-instance-buffer
 870       instance 'gdb-partial-output-buffer))
 871     (goto-char (point-max))
 872     (insert string)))
 873
 874 (defun gdb-clear-partial-output (instance)
 875   (save-excursion
 876     (set-buffer
 877      (gdb-get-create-instance-buffer
 878       instance 'gdb-partial-output-buffer))
 879     (delete-region (point-min) (point-max))))
 880
 881 (defun gdb-append-to-inferior-io (instance string)
 882   (save-excursion
 883     (set-buffer
 884      (gdb-get-create-instance-buffer
 885       instance 'gdb-inferior-io))
 886     (goto-char (point-max))
 887     (insert-before-markers string))
 888   (gud-display-buffer
 889    (gdb-get-create-instance-buffer instance
 890                                    'gdb-inferior-io)))
 891
 892 (defun gdb-clear-inferior-io (instance)
 893   (save-excursion
 894     (set-buffer
 895      (gdb-get-create-instance-buffer
 896       instance 'gdb-inferior-io))
 897     (delete-region (point-min) (point-max))))
 898 \f
 899
 900
 901 ;; One trick is to have a command who's output is always available in
 902 ;; a buffer of it's own, and is always up to date.  We build several
 903 ;; buffers of this type.
 904 ;;
 905 ;; There are two aspects to this: gdb has to tell us when the output
 906 ;; for that command might have changed, and we have to be able to run
 907 ;; the command behind the user's back.
 908 ;;
 909 ;; The idle input queue and the output phasing associated with
 910 ;; the instance variable `(gdb-instance-output-sink instance)' help
 911 ;; us to run commands behind the user's back.
 912 ;;
 913 ;; Below is the code for specificly managing buffers of output from one
 914 ;; command.
 915 ;;
 916
 917
 918 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
 919 ;; It adds an idle input for the command we are tracking.  It should be the
 920 ;; annotation rule binding of whatever gdb sends to tell us this command
 921 ;; might have changed it's output.
 922 ;;
 923 ;; NAME is the fucntion name.  DEMAND-PREDICATE tests if output is really needed.
 924 ;; GDB-COMMAND is a string of such.  OUTPUT-HANDLER is the function bound to the
 925 ;; input in the input queue (see comment about ``gdb communications'' above).
 926 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
 927   (`
 928    (defun (, name) (instance &optional ignored)
 929      (if (and ((, demand-predicate) instance)
 930               (not (member '(, name)
 931                            (gdb-instance-pending-triggers instance))))
 932          (progn
 933            (gdb-instance-enqueue-idle-input
 934             instance
 935             (list (, gdb-command) '(, output-handler)))
 936            (set-gdb-instance-pending-triggers
 937             instance
 938             (cons '(, name)
 939                   (gdb-instance-pending-triggers instance))))))))
 940
 941 (defmacro def-gdb-auto-update-handler (name trigger buf-key)
 942   (`
 943    (defun (, name) ()
 944      (set-gdb-instance-pending-triggers
 945       instance
 946       (delq '(, trigger)
 947             (gdb-instance-pending-triggers instance)))
 948      (let ((buf (gdb-get-instance-buffer instance
 949                                           '(, buf-key))))
 950        (and buf
 951             (save-excursion
 952               (set-buffer buf)
 953               (let ((p (point))
 954                     (buffer-read-only nil))
 955                 (delete-region (point-min) (point-max))
 956                 (insert-buffer (gdb-get-create-instance-buffer
 957                                 instance
 958                                 'gdb-partial-output-buffer))
 959                 (goto-char p))))))))
 960
 961 (defmacro def-gdb-auto-updated-buffer
 962   (buffer-key trigger-name gdb-command output-handler-name)
 963   (`
 964    (progn
 965      (def-gdb-auto-update-trigger (, trigger-name)
 966        ;; The demand predicate:
 967        (lambda (instance)
 968          (gdb-get-instance-buffer instance '(, buffer-key)))
 969        (, gdb-command)
 970        (, output-handler-name))
 971      (def-gdb-auto-update-handler (, output-handler-name)
 972        (, trigger-name) (, buffer-key)))))
 973
 974
 975 \f
 976 ;;
 977 ;; Breakpoint buffers
 978 ;;
 979 ;; These display the output of `info breakpoints'.
 980 ;;
 981
 982
 983 (gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer
 984                                'gdb-breakpoints-buffer-name
 985                                'gud-breakpoints-mode)
 986
 987 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
 988   ;; This defines the auto update rule for buffers of type
 989   ;; `gdb-breakpoints-buffer'.
 990   ;;
 991   ;; It defines a function to serve as the annotation handler that
 992   ;; handles the `foo-invalidated' message.  That function is called:
 993   gdb-invalidate-breakpoints
 994
 995   ;; To update the buffer, this command is sent to gdb.
 996   "server info breakpoints\n"
 997
 998   ;; This also defines a function to be the handler for the output
 999   ;; from the command above.  That function will copy the output into
1000   ;; the appropriately typed buffer.  That function will be called:
1001   gdb-info-breakpoints-handler)
1002
1003 (defun gdb-breakpoints-buffer-name (instance)
1004   (save-excursion
1005     (set-buffer (process-buffer (gdb-instance-process instance)))
1006     (concat "*breakpoints of " (gdb-instance-target-string instance) "*")))
1007
1008 (defun gud-display-breakpoints-buffer (instance)
1009   (interactive (list (gdb-needed-default-instance)))
1010   (gud-display-buffer
1011    (gdb-get-create-instance-buffer instance
1012                                     'gdb-breakpoints-buffer)))
1013
1014 (defun gud-frame-breakpoints-buffer (instance)
1015   (interactive (list (gdb-needed-default-instance)))
1016   (gud-frame-buffer
1017    (gdb-get-create-instance-buffer instance
1018                                     'gdb-breakpoints-buffer)))
1019
1020 (defvar gud-breakpoints-mode-map nil)
1021 (setq gud-breakpoints-mode-map (make-keymap))
1022 (suppress-keymap gud-breakpoints-mode-map)
1023 (define-key gud-breakpoints-mode-map " " 'gud-toggle-bp-this-line)
1024 (define-key gud-breakpoints-mode-map "d" 'gud-delete-bp-this-line)
1025
1026 (defun gud-breakpoints-mode ()
1027   "Major mode for gud breakpoints.
1028
1029 \\{gud-breakpoints-mode-map}"
1030   (setq major-mode 'gud-breakpoints-mode)
1031   (setq mode-name "Breakpoints")
1032   (use-local-map gud-breakpoints-mode-map)
1033   (setq buffer-read-only t)
1034   (gdb-invalidate-breakpoints gdb-buffer-instance))
1035
1036 (defun gud-toggle-bp-this-line ()
1037   (interactive)
1038   (save-excursion
1039     (beginning-of-line 1)
1040     (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
1041         (error "Not recognized as breakpoint line (demo foo).")
1042       (gdb-instance-enqueue-idle-input
1043        gdb-buffer-instance
1044        (list
1045         (concat
1046          (if (eq ?y (char-after (match-beginning 2)))
1047              "server disable "
1048            "server enable ")
1049          (buffer-substring (match-beginning 0)
1050                            (match-end 1))
1051          "\n")
1052         '(lambda () nil)))
1053       )))
1054
1055 (defun gud-delete-bp-this-line ()
1056   (interactive)
1057   (save-excursion
1058     (beginning-of-line 1)
1059     (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
1060         (error "Not recognized as breakpoint line (demo foo).")
1061       (gdb-instance-enqueue-idle-input
1062        gdb-buffer-instance
1063        (list
1064         (concat
1065          "server delete "
1066          (buffer-substring (match-beginning 0)
1067                            (match-end 1))
1068          "\n")
1069         '(lambda () nil)))
1070       )))
1071
1072
1073
1074 \f
1075 ;;
1076 ;; Frames buffers.  These display a perpetually correct bactracktrace
1077 ;; (from the command `where').
1078 ;;
1079 ;; Alas, if your stack is deep, they are costly.
1080 ;;
1081
1082 (gdb-set-instance-buffer-rules 'gdb-stack-buffer
1083                                'gdb-stack-buffer-name
1084                                'gud-frames-mode)
1085
1086 (def-gdb-auto-updated-buffer gdb-stack-buffer
1087   gdb-invalidate-frames
1088   "server where\n"
1089   gdb-info-frames-handler)
1090
1091 (defun gdb-stack-buffer-name (instance)
1092   (save-excursion
1093     (set-buffer (process-buffer (gdb-instance-process instance)))
1094     (concat "*stack frames of "
1095             (gdb-instance-target-string instance) "*")))
1096
1097 (defun gud-display-stack-buffer (instance)
1098   (interactive (list (gdb-needed-default-instance)))
1099   (gud-display-buffer
1100    (gdb-get-create-instance-buffer instance
1101                                     'gdb-stack-buffer)))
1102
1103 (defun gud-frame-stack-buffer (instance)
1104   (interactive (list (gdb-needed-default-instance)))
1105   (gud-frame-buffer
1106    (gdb-get-create-instance-buffer instance
1107                                     'gdb-stack-buffer)))
1108
1109 (defvar gud-frames-mode-map nil)
1110 (setq gud-frames-mode-map (make-keymap))
1111 (suppress-keymap gud-frames-mode-map)
1112 (define-key gud-frames-mode-map [mouse-2]
1113   'gud-frames-select-by-mouse)
1114
1115 (defun gud-frames-mode ()
1116   "Major mode for gud frames.
1117
1118 \\{gud-frames-mode-map}"
1119   (setq major-mode 'gud-frames-mode)
1120   (setq mode-name "Frames")
1121   (setq buffer-read-only t)
1122   (use-local-map gud-frames-mode-map)
1123   (gdb-invalidate-frames gdb-buffer-instance))
1124
1125 (defun gud-get-frame-number ()
1126   (save-excursion
1127     (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1128            (n (or (and pos
1129                        (string-to-int
1130                         (buffer-substring (match-beginning 1)
1131                                           (match-end 1))))
1132                   0)))
1133       n)))
1134
1135 (defun gud-frames-select-by-mouse (e)
1136   (interactive "e")
1137   (let (selection)
1138     (save-excursion
1139       (set-buffer (window-buffer (posn-window (event-end e))))
1140       (save-excursion
1141         (goto-char (posn-point (event-end e)))
1142         (setq selection (gud-get-frame-number))))
1143     (select-window (posn-window (event-end e)))
1144     (save-excursion
1145       (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gud))
1146       (gud-call "fr %p" selection)
1147       (gud-display-frame))))
1148
1149 \f
1150 ;;
1151 ;; Registers buffers
1152 ;;
1153
1154 (def-gdb-auto-updated-buffer gdb-registers-buffer
1155   gdb-invalidate-registers
1156   "server info registers\n"
1157   gdb-info-registers-handler)
1158
1159 (gdb-set-instance-buffer-rules 'gdb-registers-buffer
1160                                'gdb-registers-buffer-name
1161                                'gud-registers-mode)
1162
1163 (defvar gud-registers-mode-map nil)
1164 (setq gud-registers-mode-map (make-keymap))
1165 (suppress-keymap gud-registers-mode-map)
1166
1167 (defun gud-registers-mode ()
1168   "Major mode for gud registers.
1169
1170 \\{gud-registers-mode-map}"
1171   (setq major-mode 'gud-registers-mode)
1172   (setq mode-name "Registers")
1173   (setq buffer-read-only t)
1174   (use-local-map gud-registers-mode-map)
1175   (gdb-invalidate-registers gdb-buffer-instance))
1176
1177 (defun gdb-registers-buffer-name (instance)
1178   (save-excursion
1179     (set-buffer (process-buffer (gdb-instance-process instance)))
1180     (concat "*registers of " (gdb-instance-target-string instance) "*")))
1181
1182 (defun gud-display-registers-buffer (instance)
1183   (interactive (list (gdb-needed-default-instance)))
1184   (gud-display-buffer
1185    (gdb-get-create-instance-buffer instance
1186                                     'gdb-registers-buffer)))
1187
1188 (defun gud-frame-registers-buffer (instance)
1189   (interactive (list (gdb-needed-default-instance)))
1190   (gud-frame-buffer
1191    (gdb-get-create-instance-buffer instance
1192                                     'gdb-registers-buffer)))
1193
1194 \f
1195
1196 ;;;; Menu windows:
1197
1198
1199 ;; MENU-LIST is ((option option option...) (option option ...)...)
1200 ;;
1201 (defun gud-display-menu (menu-list)
1202   (setq fill-column (min 120 (- (window-width)
1203                                 (min 8 (window-width)))))
1204   (while menu-list
1205     (mapcar (function (lambda (x) (insert (symbol-name x) " "))) (car menu-list))
1206     (fill-paragraph nil)
1207     (insert "\n\n")
1208     (setq menu-list (cdr menu-list)))
1209   (goto-char (point-min))
1210   (while (re-search-forward "\\([^ \n]+\\)\\(\n\\| \\)" nil t)
1211     (put-text-property (match-beginning 1) (match-end 1)
1212                        'mouse-face 'highlight))
1213   (goto-char (point-min)))
1214
1215 (defun gud-goto-menu (menu)
1216   (setq gud-menu-position menu)
1217   (let ((buffer-read-only nil))
1218     (delete-region (point-min) (point-max))
1219     (gud-display-menu menu)))
1220
1221 (defun gud-menu-pick (event)
1222   "Choose an item from a gdb command menu."
1223   (interactive "e")
1224   (let (choice)
1225     (save-excursion
1226       (set-buffer (window-buffer (posn-window (event-start event))))
1227       (goto-char (posn-point (event-start event)))
1228       (let (beg end)
1229         (skip-chars-forward "^ \t\n")
1230         (setq end (point))
1231         (skip-chars-backward "^ \t\n")
1232         (setq beg (point))
1233         (setq choice (buffer-substring beg end))
1234         (message choice)
1235         (gud-invoke-menu (intern choice))))))
1236
1237 (defun gud-invoke-menu (symbol)
1238   (let ((meaning (assoc symbol gud-menu-rules)))
1239     (cond
1240      ((and (consp meaning)
1241            (consp (car (cdr meaning))))
1242       (gud-goto-menu (car (cdr meaning))))
1243      (meaning (call-interactively (car (cdr meaning)))))))
1244
1245 \f
1246
1247 (gdb-set-instance-buffer-rules 'gdb-command-buffer
1248                                'gdb-command-buffer-name
1249                                'gud-command-mode)
1250
1251 (defvar gud-command-mode-map nil)
1252 (setq gud-command-mode-map (make-keymap))
1253 (suppress-keymap gud-command-mode-map)
1254 (define-key gud-command-mode-map [mouse-2] 'gud-menu-pick)
1255
1256 (defun gud-command-mode ()
1257   "Major mode for gud menu.
1258
1259 \\{gud-command-mode-map}" (interactive) (setq major-mode 'gud-command-mode)
1260   (setq mode-name "Menu") (setq buffer-read-only t) (use-local-map
1261   gud-command-mode-map) (make-variable-buffer-local 'gud-menu-position)
1262   (if (not gud-menu-position) (gud-goto-menu gud-running-menu)))
1263
1264 (defun gdb-command-buffer-name (instance)
1265   (save-excursion
1266     (set-buffer (process-buffer (gdb-instance-process instance)))
1267     (concat "*menu of " (gdb-instance-target-string instance) "*")))
1268
1269 (defun gud-display-command-buffer (instance)
1270   (interactive (list (gdb-needed-default-instance)))
1271   (gud-display-buffer
1272    (gdb-get-create-instance-buffer instance
1273                                    'gdb-command-buffer)
1274    6))
1275
1276 (defun gud-frame-command-buffer (instance)
1277   (interactive (list (gdb-needed-default-instance)))
1278   (gud-frame-buffer
1279    (gdb-get-create-instance-buffer instance
1280                                     'gdb-command-buffer)))
1281
1282 (defvar gud-selected-menu-titles ())
1283 (setq gud-selected-menu-titles
1284       '(RUNNING STACK DATA BREAKPOINTS FILES))
1285
1286 (setq gud-running-menu
1287   (list
1288    '(RUNNING stack breakpoints files)
1289    '(target run next step continue finish stepi kill help-running)))
1290
1291 (setq gud-stack-menu
1292   (list
1293    '(running STACK breakpoints files)
1294    '(up down frame backtrace return help-stack)))
1295
1296 (setq gud-data-menu
1297   (list
1298    '(running stack DATA breakpoints files)
1299    '(whatis ptype print set display undisplay disassemble help-data)))
1300
1301 (setq gud-breakpoints-menu
1302   (list
1303    '(running stack BREAKPOINTS files)
1304    '(awatch rwatch watch break delete enable disable condition ignore help-breakpoints)))
1305
1306 (setq gud-files-menu
1307   (list
1308    '(running stack breakpoints FILES)
1309    '(file core-file help-files)
1310    '(exec-file load symbol-file add-symbol-file sharedlibrary)))
1311
1312 (setq gud-menu-rules
1313       (list
1314        (list 'running gud-running-menu)
1315        (list 'RUNNING gud-running-menu)
1316        (list 'stack gud-stack-menu)
1317        (list 'STACK gud-stack-menu)
1318        (list 'data gud-data-menu)
1319        (list 'DATA gud-data-menu)
1320        (list 'breakpoints gud-breakpoints-menu)
1321        (list 'BREAKPOINTS gud-breakpoints-menu)
1322        (list 'files gud-files-menu)
1323        (list 'FILES gud-files-menu)
1324
1325        (list 'target 'gud-target)
1326        (list 'kill 'gud-kill)
1327        (list 'stepi 'gud-stepi)
1328        (list 'step 'gud-step)
1329        (list 'next 'gud-next)
1330        (list 'finish 'gud-finish)
1331        (list 'continue 'gud-cont)
1332        (list 'run 'gud-run)
1333
1334        (list 'backtrace 'gud-backtrace)
1335        (list 'frame 'gud-frame)
1336        (list 'down 'gud-down)
1337        (list 'up 'gud-up)
1338        (list 'return 'gud-return)
1339
1340        (list 'file 'gud-file)
1341        (list 'core-file 'gud-core-file)
1342        (list 'cd 'gud-cd)
1343
1344        (list 'exec-file 'gud-exec-file)
1345        (list 'load 'gud-load)
1346        (list 'symbol-file 'gud-symbol-file)
1347        (list 'add-symbol-file 'gud-add-symbol-file)
1348        (list 'sharedlibrary 'gud-sharedlibrary)
1349        ))
1350
1351
1352 \f
1353
1354 (defun gdb-call-showing-gud (instance command)
1355   (gud-display-gud-buffer instance)
1356   (comint-input-sender (gdb-instance-process instance) command))
1357
1358 (defvar gud-target-history ())
1359
1360 (defun gud-temp-buffer-show (buf)
1361   (let ((ow (selected-window)))
1362     (unwind-protect
1363         (progn
1364           (pop-to-buffer buf)
1365
1366           ;; This insertion works around a bug in emacs.
1367           ;; The bug is that all the empty space after a
1368           ;; highlighted word that terminates a buffer
1369           ;; gets highlighted.  That's really ugly, so
1370           ;; make sure a highlighted word can't ever
1371           ;; terminate the buffer.
1372           (goto-char (point-max))
1373           (insert "\n")
1374           (goto-char (point-min))
1375
1376           (if (< (window-height) 10)
1377               (enlarge-window (- 10 (window-height)))))
1378       (select-window ow))))
1379
1380 (defun gud-target (instance command)
1381   (interactive
1382    (let* ((instance (gdb-needed-default-instance))
1383           (temp-buffer-show-function (function gud-temp-buffer-show))
1384           (target-name (completing-read (format "Target type: ")
1385                                         '(("remote")
1386                                           ("core")
1387                                           ("child")
1388                                           ("exec"))
1389                                         nil
1390                                         t
1391                                         nil
1392                                         'gud-target-history)))
1393      (list instance
1394            (cond
1395             ((equal target-name "child") "run")
1396
1397             ((equal target-name "core")
1398              (concat "target core "
1399                      (read-file-name "core file: "
1400                                      nil
1401                                      "core"
1402                                      t)))
1403
1404             ((equal target-name "exec")
1405              (concat "target exec "
1406                      (read-file-name "exec file: "
1407                                      nil
1408                                      "a.out"
1409                                      t)))
1410
1411             ((equal target-name "remote")
1412              (concat "target remote "
1413                      (read-file-name "serial line for remote: "
1414                                      "/dev/"
1415                                      "ttya"
1416                                      t)))
1417
1418             (t "echo No such target command!")))))
1419
1420   (gud-display-gud-buffer instance)
1421   (apply comint-input-sender
1422          (list (gdb-instance-process instance) command)))
1423
1424 (defun gud-backtrace ()
1425   (interactive)
1426   (let ((instance  (gdb-needed-default-instance)))
1427     (gud-display-gud-buffer instance)
1428     (apply comint-input-sender
1429            (list (gdb-instance-process instance)
1430                  "backtrace"))))
1431
1432 (defun gud-frame ()
1433   (interactive)
1434   (let ((instance  (gdb-needed-default-instance)))
1435     (apply comint-input-sender
1436            (list (gdb-instance-process instance)
1437                  "frame"))))
1438
1439 (defun gud-return (instance command)
1440    (interactive
1441     (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1442       (list (gdb-needed-default-instance)
1443             (concat "return " (read-string "Expression to return: ")))))
1444    (gud-display-gud-buffer instance)
1445    (apply comint-input-sender
1446           (list (gdb-instance-process instance) command)))
1447
1448
1449 (defun gud-file (instance command)
1450   (interactive
1451    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1452      (list (gdb-needed-default-instance)
1453            (concat "file " (read-file-name "Executable to debug: "
1454                                            nil
1455                                            "a.out"
1456                                            t)))))
1457   (gud-display-gud-buffer instance)
1458   (apply comint-input-sender
1459          (list (gdb-instance-process instance) command)))
1460
1461 (defun gud-core-file (instance command)
1462   (interactive
1463    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1464      (list (gdb-needed-default-instance)
1465            (concat "core " (read-file-name "Core file to debug: "
1466                                            nil
1467                                            "core-file"
1468                                            t)))))
1469   (gud-display-gud-buffer instance)
1470   (apply comint-input-sender
1471          (list (gdb-instance-process instance) command)))
1472
1473 (defun gud-cd (dir)
1474   (interactive "FChange GDB's default directory: ")
1475   (let ((instance (gdb-needed-default-instance)))
1476     (save-excursion
1477       (set-buffer (gdb-get-instance-buffer instance 'gud))
1478       (cd dir))
1479     (gud-display-gud-buffer instance)
1480     (apply comint-input-sender
1481            (list (gdb-instance-process instance)
1482                  (concat "cd " dir)))))
1483
1484
1485 (defun gud-exec-file (instance command)
1486   (interactive
1487    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1488      (list (gdb-needed-default-instance)
1489            (concat "exec-file " (read-file-name "Init memory from executable: "
1490                                                 nil
1491                                                 "a.out"
1492                                                 t)))))
1493   (gud-display-gud-buffer instance)
1494   (apply comint-input-sender
1495          (list (gdb-instance-process instance) command)))
1496
1497 (defun gud-load (instance command)
1498   (interactive
1499    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1500      (list (gdb-needed-default-instance)
1501            (concat "load " (read-file-name "Dynamicly load from file: "
1502                                            nil
1503                                            "a.out"
1504                                            t)))))
1505   (gud-display-gud-buffer instance)
1506   (apply comint-input-sender
1507          (list (gdb-instance-process instance) command)))
1508
1509 (defun gud-symbol-file (instance command)
1510   (interactive
1511    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1512      (list (gdb-needed-default-instance)
1513            (concat "symbol-file " (read-file-name "Read symbol table from file: "
1514                                                   nil
1515                                                   "a.out"
1516                                                   t)))))
1517   (gud-display-gud-buffer instance)
1518   (apply comint-input-sender
1519          (list (gdb-instance-process instance) command)))
1520
1521
1522 (defun gud-add-symbol-file (instance command)
1523   (interactive
1524    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1525      (list (gdb-needed-default-instance)
1526            (concat "add-symbol-file "
1527                    (read-file-name "Add symbols from file: "
1528                                    nil
1529                                    "a.out"
1530                                    t)))))
1531   (gud-display-gud-buffer instance)
1532   (apply comint-input-sender
1533          (list (gdb-instance-process instance) command)))
1534
1535
1536 (defun gud-sharedlibrary (instance command)
1537   (interactive
1538    (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
1539      (list (gdb-needed-default-instance)
1540            (concat "sharedlibrary "
1541                    (read-string "Load symbols for files matching regexp: ")))))
1542   (gud-display-gud-buffer instance)
1543   (apply comint-input-sender
1544          (list (gdb-instance-process instance) command)))
1545
1546
1547
1548 \f
1549
1550 ;;;; Window management
1551
1552
1553 ;;; FIXME: This should only return true for buffers in the current instance
1554 (defun gud-protected-buffer-p (buffer)
1555   "Is BUFFER a buffer which we want to leave displayed?"
1556   (save-excursion
1557     (set-buffer buffer)
1558     (or gdb-buffer-type
1559         overlay-arrow-position)))
1560
1561 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1562 ;;; to do the right thing.  Seeing as there is no way for Lisp code to
1563 ;;; get at the use_time field of a window, I'm not sure there exists a
1564 ;;; more elegant solution without writing C code.
1565
1566 (defun gud-display-buffer (buf &optional size)
1567   (let ((must-split nil)
1568         (answer nil))
1569     (unwind-protect
1570         (progn
1571           (walk-windows
1572            '(lambda (win)
1573               (if (gud-protected-buffer-p (window-buffer win))
1574                   (set-window-dedicated-p win t))))
1575           (setq answer (get-buffer-window buf))
1576           (if (not answer)
1577               (let ((window (get-lru-window)))
1578                 (if window
1579                     (progn
1580                       (set-window-buffer window buf)
1581                       (setq answer window))
1582                   (setq must-split t)))))
1583       (walk-windows
1584        '(lambda (win)
1585           (if (gud-protected-buffer-p (window-buffer win))
1586               (set-window-dedicated-p win nil)))))
1587     (if must-split
1588         (let* ((largest (get-largest-window))
1589                (cur-size (window-height largest))
1590                (new-size (and size (< size cur-size) (- cur-size size))))
1591           (setq answer (split-window largest new-size))
1592           (set-window-buffer answer buf)))
1593     answer))
1594
1595 (defun existing-source-window (buffer)
1596   (catch 'found
1597     (save-excursion
1598       (walk-windows
1599        (function
1600         (lambda (win)
1601           (if (and overlay-arrow-position
1602                    (eq (window-buffer win)
1603                        (marker-buffer overlay-arrow-position)))
1604               (progn
1605                 (set-window-buffer win buffer)
1606                 (throw 'found win))))))
1607       nil)))
1608
1609 (defun gud-display-source-buffer (buffer)
1610   (or (existing-source-window buffer)
1611       (gud-display-buffer buffer)))
1612
1613 (defun gud-frame-buffer (buf)
1614   (save-excursion
1615     (set-buffer buf)
1616     (make-frame)))
1617
1618 \f
1619
1620 ;;; Shared keymap initialization:
1621
1622 (defun make-windows-menu (map)
1623   (define-key map [menu-bar displays]
1624     (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows")))
1625   (define-key map [menu-bar displays gdb]
1626     '("Gdb" . gud-display-gud-buffer))
1627   (define-key map [menu-bar displays registers]
1628     '("Registers" . gud-display-registers-buffer))
1629   (define-key map [menu-bar displays frames]
1630     '("Stack" . gud-display-stack-buffer))
1631   (define-key map [menu-bar displays breakpoints]
1632     '("Breakpoints" . gud-display-breakpoints-buffer))
1633   (define-key map [menu-bar displays commands]
1634     '("Commands" . gud-display-command-buffer)))
1635
1636 (defun gud-display-gud-buffer (instance)
1637   (interactive (list (gdb-needed-default-instance)))
1638   (gud-display-buffer
1639    (gdb-get-create-instance-buffer instance 'gud)))
1640
1641 (make-windows-menu gud-breakpoints-mode-map)
1642 (make-windows-menu gud-frames-mode-map)
1643 (make-windows-menu gud-registers-mode-map)
1644
1645
1646
1647 (defun make-frames-menu (map)
1648   (define-key map [menu-bar frames]
1649     (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
1650   (define-key map [menu-bar frames gdb]
1651     '("Gdb" . gud-frame-gud-buffer))
1652   (define-key map [menu-bar frames registers]
1653     '("Registers" . gud-frame-registers-buffer))
1654   (define-key map [menu-bar frames frames]
1655     '("Stack" . gud-frame-stack-buffer))
1656   (define-key map [menu-bar frames breakpoints]
1657     '("Breakpoints" . gud-frame-breakpoints-buffer))
1658   (define-key map [menu-bar displays commands]
1659     '("Commands" . gud-display-command-buffer)))
1660
1661 (defun gud-frame-gud-buffer (instance)
1662   (interactive (list (gdb-needed-default-instance)))
1663   (gud-frame-buffer
1664    (gdb-get-create-instance-buffer instance 'gud)))
1665
1666 (make-frames-menu gud-breakpoints-mode-map)
1667 (make-frames-menu gud-frames-mode-map)
1668 (make-frames-menu gud-registers-mode-map)
1669
1670 \f
1671 (defun gud-gdb-find-file (f)
1672   (find-file-noselect f))
1673
1674 ;;;###autoload
1675 (defun gdb (command-line)
1676   "Run gdb on program FILE in buffer *gud-FILE*.
1677 The directory containing FILE becomes the initial working directory
1678 and source-file directory for your debugger."
1679   (interactive
1680    (list (read-from-minibuffer "Run gdb (like this): "
1681                                (if (consp gud-gdb-history)
1682                                    (car gud-gdb-history)
1683                                  "gdb ")
1684                                nil nil
1685                                '(gud-gdb-history . 1))))
1686   (gud-overload-functions
1687    '((gud-massage-args . gud-gdb-massage-args)
1688      (gud-marker-filter . gud-gdb-marker-filter)
1689      (gud-find-file . gud-gdb-find-file)
1690      ))
1691
1692   (let* ((words (gud-chop-words command-line))
1693          (program (car words))
1694          (file-word (let ((w (cdr words)))
1695                       (while (and w (= ?- (aref (car w) 0)))
1696                         (setq w (cdr w)))
1697                       (car w)))
1698          (args (delq file-word (cdr words)))
1699          (file (expand-file-name file-word))
1700          (filepart (file-name-nondirectory file))
1701          (buffer-name (concat "*gud-" filepart "*")))
1702     (setq gdb-first-time (not (get-buffer-process buffer-name))))
1703
1704   (gud-common-init command-line)
1705
1706   (gud-def gud-break  "break %f:%l"  "\C-b" "Set breakpoint at current line.")
1707   (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
1708   (gud-def gud-remove "clear %l"     "\C-d" "Remove breakpoint at current line")
1709   (gud-def gud-kill   "kill"         nil    "Kill the program.")
1710   (gud-def gud-run    "run"          nil    "Run the program.")
1711   (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
1712   (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
1713   (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
1714   (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
1715   (gud-def gud-cont   "cont"         "\C-r" "Continue with display.")
1716   (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
1717   (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
1718   (gud-def gud-print  "print %e"     "\C-p" "Evaluate C expression at point.")
1719
1720   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
1721   (setq comint-input-sender 'gdb-send)
1722   (run-hooks 'gdb-mode-hook)
1723   (let ((instance
1724          (make-gdb-instance (get-buffer-process (current-buffer)))
1725          ))
1726     (if gdb-first-time (gdb-clear-inferior-io instance)))
1727   )
1728
1729 \f
1730 ;; ======================================================================
1731 ;; sdb functions
1732
1733 ;;; History of argument lists passed to sdb.
1734 (defvar gud-sdb-history nil)
1735
1736 (defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
1737   "If nil, we're on a System V Release 4 and don't need the tags hack.")
1738
1739 (defvar gud-sdb-lastfile nil)
1740
1741 (defun gud-sdb-massage-args (file args)
1742   (cons file args))
1743
1744 (defun gud-sdb-marker-filter (string)
1745   (cond
1746    ;; System V Release 3.2 uses this format
1747    ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
1748                     string)
1749     (setq gud-last-frame
1750           (cons
1751            (substring string (match-beginning 2) (match-end 2))
1752            (string-to-int
1753             (substring string (match-beginning 3) (match-end 3))))))
1754    ;; System V Release 4.0
1755    ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
1756                        string)
1757     (setq gud-sdb-lastfile
1758           (substring string (match-beginning 2) (match-end 2))))
1759    ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
1760          (setq gud-last-frame
1761                (cons
1762                 gud-sdb-lastfile
1763                 (string-to-int
1764                  (substring string (match-beginning 1) (match-end 1))))))
1765    (t
1766     (setq gud-sdb-lastfile nil)))
1767   string)
1768
1769 (defun gud-sdb-find-file (f)
1770   (if gud-sdb-needs-tags
1771       (find-tag-noselect f)
1772     (find-file-noselect f)))
1773
1774 ;;;###autoload
1775 (defun sdb (command-line)
1776   "Run sdb on program FILE in buffer *gud-FILE*.
1777 The directory containing FILE becomes the initial working directory
1778 and source-file directory for your debugger."
1779   (interactive
1780    (list (read-from-minibuffer "Run sdb (like this): "
1781                                (if (consp gud-sdb-history)
1782                                    (car gud-sdb-history)
1783                                  "sdb ")
1784                                nil nil
1785                                '(gud-sdb-history . 1))))
1786   (if (and gud-sdb-needs-tags
1787            (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))))
1788       (error "The sdb support requires a valid tags table to work."))
1789   (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args)
1790                             (gud-marker-filter . gud-sdb-marker-filter)
1791                             (gud-find-file . gud-sdb-find-file)
1792                             ))
1793
1794   (gud-common-init command-line)
1795
1796   (gud-def gud-break  "%l b" "\C-b"   "Set breakpoint at current line.")
1797   (gud-def gud-tbreak "%l c" "\C-t"   "Set temporary breakpoint at current line.")
1798   (gud-def gud-remove "%l d" "\C-d"   "Remove breakpoint at current line")
1799   (gud-def gud-step   "s %p" "\C-s"   "Step one source line with display.")
1800   (gud-def gud-stepi  "i %p" "\C-i"   "Step one instruction with display.")
1801   (gud-def gud-next   "S %p" "\C-n"   "Step one line (skip functions).")
1802   (gud-def gud-cont   "c"    "\C-r"   "Continue with display.")
1803   (gud-def gud-print  "%e/"  "\C-p"   "Evaluate C expression at point.")
1804
1805   (setq comint-prompt-regexp  "\\(^\\|\n\\)\\*")
1806   (run-hooks 'sdb-mode-hook)
1807   )
1808 \f
1809 ;; ======================================================================
1810 ;; dbx functions
1811
1812 ;;; History of argument lists passed to dbx.
1813 (defvar gud-dbx-history nil)
1814
1815 (defun gud-dbx-massage-args (file args)
1816   (cons file args))
1817
1818 (defun gud-dbx-marker-filter (string)
1819   (if (or (string-match
1820          "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
1821          string)
1822         (string-match
1823          "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
1824          string))
1825       (setq gud-last-frame
1826             (cons
1827              (substring string (match-beginning 2) (match-end 2))
1828              (string-to-int
1829               (substring string (match-beginning 1) (match-end 1))))))
1830   string)
1831
1832 (defun gud-dbx-find-file (f)
1833   (find-file-noselect f))
1834
1835 ;;;###autoload
1836 (defun dbx (command-line)
1837   "Run dbx on program FILE in buffer *gud-FILE*.
1838 The directory containing FILE becomes the initial working directory
1839 and source-file directory for your debugger."
1840   (interactive
1841    (list (read-from-minibuffer "Run dbx (like this): "
1842                                (if (consp gud-dbx-history)
1843                                    (car gud-dbx-history)
1844                                  "dbx ")
1845                                nil nil
1846                                '(gud-dbx-history . 1))))
1847   (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args)
1848                             (gud-marker-filter . gud-dbx-marker-filter)
1849                             (gud-find-file . gud-dbx-find-file)
1850                             ))
1851
1852   (gud-common-init command-line)
1853
1854   (gud-def gud-break  "file \"%d%f\"\nstop at %l"
1855                                   "\C-b" "Set breakpoint at current line.")
1856 ;;  (gud-def gud-break  "stop at \"%f\":%l"
1857 ;;                                "\C-b" "Set breakpoint at current line.")
1858   (gud-def gud-remove "clear %l"  "\C-d" "Remove breakpoint at current line")
1859   (gud-def gud-step   "step %p"   "\C-s" "Step one line with display.")
1860   (gud-def gud-stepi  "stepi %p"  "\C-i" "Step one instruction with display.")
1861   (gud-def gud-next   "next %p"   "\C-n" "Step one line (skip functions).")
1862   (gud-def gud-cont   "cont"      "\C-r" "Continue with display.")
1863   (gud-def gud-up     "up %p"     "<" "Up (numeric arg) stack frames.")
1864   (gud-def gud-down   "down %p"   ">" "Down (numeric arg) stack frames.")
1865   (gud-def gud-print  "print %e"  "\C-p" "Evaluate C expression at point.")
1866
1867   (setq comint-prompt-regexp  "^[^)]*dbx) *")
1868   (run-hooks 'dbx-mode-hook)
1869   )
1870 \f
1871 ;; ======================================================================
1872 ;; xdb (HP PARISC debugger) functions
1873
1874 ;;; History of argument lists passed to xdb.
1875 (defvar gud-xdb-history nil)
1876
1877 (defvar gud-xdb-directories nil
1878   "*A list of directories that xdb should search for source code.
1879 If nil, only source files in the program directory
1880 will be known to xdb.
1881
1882 The file names should be absolute, or relative to the directory
1883 containing the executable being debugged.")
1884
1885 (defun gud-xdb-massage-args (file args)
1886   (nconc (let ((directories gud-xdb-directories)
1887                (result nil))
1888            (while directories
1889              (setq result (cons (car directories) (cons "-d" result)))
1890              (setq directories (cdr directories)))
1891            (nreverse (cons file result)))
1892          args))
1893
1894 (defun gud-xdb-file-name (f)
1895   "Transform a relative pathname to a full pathname in xdb mode"
1896   (let ((result nil))
1897     (if (file-exists-p f)
1898         (setq result (expand-file-name f))
1899       (let ((directories gud-xdb-directories))
1900         (while directories
1901           (let ((path (concat (car directories) "/" f)))
1902             (if (file-exists-p path)
1903                 (setq result (expand-file-name path)
1904                       directories nil)))
1905           (setq directories (cdr directories)))))
1906     result))
1907
1908 ;; xdb does not print the lines all at once, so we have to accumulate them
1909 (defvar gud-xdb-accumulation "")
1910
1911 (defun gud-xdb-marker-filter (string)
1912   (let (result)
1913     (if (or (string-match comint-prompt-regexp string)
1914             (string-match ".*\012" string))
1915         (setq result (concat gud-xdb-accumulation string)
1916               gud-xdb-accumulation "")
1917       (setq gud-xdb-accumulation (concat gud-xdb-accumulation string)))
1918     (if result
1919         (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result)
1920                 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
1921                               result))
1922             (let ((line (string-to-int
1923                          (substring result (match-beginning 2) (match-end 2))))
1924                   (file (gud-xdb-file-name
1925                          (substring result (match-beginning 1) (match-end 1)))))
1926               (if file
1927                   (setq gud-last-frame (cons file line))))))
1928     (or result "")))
1929
1930 (defun gud-xdb-find-file (f)
1931   (let ((realf (gud-xdb-file-name f)))
1932     (if realf (find-file-noselect realf))))
1933
1934 ;;;###autoload
1935 (defun xdb (command-line)
1936   "Run xdb on program FILE in buffer *gud-FILE*.
1937 The directory containing FILE becomes the initial working directory
1938 and source-file directory for your debugger.
1939
1940 You can set the variable 'gud-xdb-directories' to a list of program source
1941 directories if your program contains sources from more than one directory."
1942   (interactive
1943    (list (read-from-minibuffer "Run xdb (like this): "
1944                                (if (consp gud-xdb-history)
1945                                    (car gud-xdb-history)
1946                                  "xdb ")
1947                                nil nil
1948                                '(gud-xdb-history . 1))))
1949   (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args)
1950                             (gud-marker-filter . gud-xdb-marker-filter)
1951                             (gud-find-file . gud-xdb-find-file)))
1952
1953   (gud-common-init command-line)
1954
1955   (gud-def gud-break  "b %f:%l"    "\C-b" "Set breakpoint at current line.")
1956   (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
1957            "Set temporary breakpoint at current line.")
1958   (gud-def gud-remove "db"         "\C-d" "Remove breakpoint at current line")
1959   (gud-def gud-step   "s %p"       "\C-s" "Step one line with display.")
1960   (gud-def gud-next   "S %p"       "\C-n" "Step one line (skip functions).")
1961   (gud-def gud-cont   "c"          "\C-r" "Continue with display.")
1962   (gud-def gud-up     "up %p"      "<"    "Up (numeric arg) stack frames.")
1963   (gud-def gud-down   "down %p"    ">"    "Down (numeric arg) stack frames.")
1964   (gud-def gud-finish "bu\\t"      "\C-f" "Finish executing current function.")
1965   (gud-def gud-print  "p %e"       "\C-p" "Evaluate C expression at point.")
1966
1967   (setq comint-prompt-regexp  "^>")
1968   (make-local-variable 'gud-xdb-accumulation)
1969   (setq gud-xdb-accumulation "")
1970   (run-hooks 'xdb-mode-hook))
1971 \f
1972 ;; ======================================================================
1973 ;; perldb functions
1974
1975 ;;; History of argument lists passed to perldb.
1976 (defvar gud-perldb-history nil)
1977
1978 (defun gud-perldb-massage-args (file args)
1979   (cons "-d" (cons file (cons "-emacs" args))))
1980
1981 ;; There's no guarantee that Emacs will hand the filter the entire
1982 ;; marker at once; it could be broken up across several strings.  We
1983 ;; might even receive a big chunk with several markers in it.  If we
1984 ;; receive a chunk of text which looks like it might contain the
1985 ;; beginning of a marker, we save it here between calls to the
1986 ;; filter.
1987 (defvar gud-perldb-marker-acc "")
1988
1989 (defun gud-perldb-marker-filter (string)
1990   (save-match-data
1991     (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string))
1992     (let ((output ""))
1993
1994       ;; Process all the complete markers in this chunk.
1995       (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
1996                            gud-perldb-marker-acc)
1997         (setq
1998
1999          ;; Extract the frame position from the marker.
2000          gud-last-frame
2001          (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1))
2002                (string-to-int (substring gud-perldb-marker-acc
2003                                          (match-beginning 2)
2004                                          (match-end 2))))
2005
2006          ;; Append any text before the marker to the output we're going
2007          ;; to return - we don't include the marker in this text.
2008          output (concat output
2009                         (substring gud-perldb-marker-acc 0 (match-beginning 0)))
2010
2011          ;; Set the accumulator to the remaining text.
2012          gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0))))
2013
2014       ;; Does the remaining text look like it might end with the
2015       ;; beginning of another marker?  If it does, then keep it in
2016       ;; gud-perldb-marker-acc until we receive the rest of it.  Since we
2017       ;; know the full marker regexp above failed, it's pretty simple to
2018       ;; test for marker starts.
2019       (if (string-match "^\032.*\\'" gud-perldb-marker-acc)
2020           (progn
2021             ;; Everything before the potential marker start can be output.
2022             (setq output (concat output (substring gud-perldb-marker-acc
2023                                                    0 (match-beginning 0))))
2024
2025             ;; Everything after, we save, to combine with later input.
2026             (setq gud-perldb-marker-acc
2027                   (substring gud-perldb-marker-acc (match-beginning 0))))
2028
2029         (setq output (concat output gud-perldb-marker-acc)
2030               gud-perldb-marker-acc ""))
2031
2032       output)))
2033
2034 (defun gud-perldb-find-file (f)
2035   (find-file-noselect f))
2036
2037 ;;;###autoload
2038 (defun perldb (command-line)
2039   "Run perldb on program FILE in buffer *gud-FILE*.
2040 The directory containing FILE becomes the initial working directory
2041 and source-file directory for your debugger."
2042   (interactive
2043    (list (read-from-minibuffer "Run perldb (like this): "
2044                                (if (consp gud-perldb-history)
2045                                    (car gud-perldb-history)
2046                                  "perl ")
2047                                nil nil
2048                                '(gud-perldb-history . 1))))
2049   (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
2050                             (gud-marker-filter . gud-perldb-marker-filter)
2051                             (gud-find-file . gud-perldb-find-file)
2052                             ))
2053
2054   (gud-common-init command-line)
2055
2056   (gud-def gud-break  "b %l"         "\C-b" "Set breakpoint at current line.")
2057   (gud-def gud-remove "d %l"         "\C-d" "Remove breakpoint at current line")
2058   (gud-def gud-step   "s"            "\C-s" "Step one source line with display.")
2059   (gud-def gud-next   "n"            "\C-n" "Step one line (skip functions).")
2060   (gud-def gud-cont   "c"            "\C-r" "Continue with display.")
2061 ;  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
2062 ;  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
2063 ;  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
2064   (gud-def gud-print  "%e"           "\C-p" "Evaluate perl expression at point.")
2065
2066   (setq comint-prompt-regexp "^  DB<[0-9]+> ")
2067   (run-hooks 'perldb-mode-hook)
2068   )
2069
2070 ;;
2071 ;; End of debugger-specific information
2072 ;;
2073
2074 \f
2075 ;;; When we send a command to the debugger via gud-call, it's annoying
2076 ;;; to see the command and the new prompt inserted into the debugger's
2077 ;;; buffer; we have other ways of knowing the command has completed.
2078 ;;;
2079 ;;; If the buffer looks like this:
2080 ;;; --------------------
2081 ;;; (gdb) set args foo bar
2082 ;;; (gdb) -!-
2083 ;;; --------------------
2084 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a
2085 ;;; source file to set a breakpoint, we want the buffer to end up like
2086 ;;; this:
2087 ;;; --------------------
2088 ;;; (gdb) set args foo bar
2089 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
2090 ;;; (gdb) -!-
2091 ;;; --------------------
2092 ;;; Essentially, the old prompt is deleted, and the command's output
2093 ;;; and the new prompt take its place.
2094 ;;;
2095 ;;; Not echoing the command is easy enough; you send it directly using
2096 ;;; comint-input-sender, and it never enters the buffer.  However,
2097 ;;; getting rid of the old prompt is trickier; you don't want to do it
2098 ;;; when you send the command, since that will result in an annoying
2099 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs
2100 ;;; waits for a response from the debugger, and the new prompt is
2101 ;;; inserted.  Instead, we'll wait until we actually get some output
2102 ;;; from the subprocess before we delete the prompt.  If the command
2103 ;;; produced no output other than a new prompt, that prompt will most
2104 ;;; likely be in the first chunk of output received, so we will delete
2105 ;;; the prompt and then replace it with an identical one.  If the
2106 ;;; command produces output, the prompt is moving anyway, so the
2107 ;;; flicker won't be annoying.
2108 ;;;
2109 ;;; So - when we want to delete the prompt upon receipt of the next
2110 ;;; chunk of debugger output, we position gud-delete-prompt-marker at
2111 ;;; the start of the prompt; the process filter will notice this, and
2112 ;;; delete all text between it and the process output marker.  If
2113 ;;; gud-delete-prompt-marker points nowhere, we leave the current
2114 ;;; prompt alone.
2115 (defvar gud-delete-prompt-marker nil)
2116
2117 \f
2118 (defvar gdbish-comint-mode-map (copy-keymap comint-mode-map))
2119 (define-key gdbish-comint-mode-map "\C-c\M-\C-r" 'gud-display-registers-buffer)
2120 (define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-stack-buffer)
2121 (define-key gdbish-comint-mode-map "\C-c\M-\C-b" 'gud-display-breakpoints-buffer)
2122
2123 (make-windows-menu gdbish-comint-mode-map)
2124 (make-frames-menu gdbish-comint-mode-map)
2125
2126 (defun gud-mode ()
2127   "Major mode for interacting with an inferior debugger process.
2128
2129    You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
2130 or M-x xdb.  Each entry point finishes by executing a hook; `gdb-mode-hook',
2131 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively.
2132
2133 After startup, the following commands are available in both the GUD
2134 interaction buffer and any source buffer GUD visits due to a breakpoint stop
2135 or step operation:
2136
2137 \\[gud-break] sets a breakpoint at the current file and line.  In the
2138 GUD buffer, the current file and line are those of the last breakpoint or
2139 step.  In a source buffer, they are the buffer's file and current line.
2140
2141 \\[gud-remove] removes breakpoints on the current file and line.
2142
2143 \\[gud-refresh] displays in the source window the last line referred to
2144 in the gud buffer.
2145
2146 \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
2147 step-one-line (not entering function calls), and step-one-instruction
2148 and then update the source window with the current file and position.
2149 \\[gud-cont] continues execution.
2150
2151 \\[gud-print] tries to find the largest C lvalue or function-call expression
2152 around point, and sends it to the debugger for value display.
2153
2154 The above commands are common to all supported debuggers except xdb which
2155 does not support stepping instructions.
2156
2157 Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
2158 except that the breakpoint is temporary; that is, it is removed when
2159 execution stops on it.
2160
2161 Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
2162 frame.  \\[gud-down] drops back down through one.
2163
2164 If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
2165 the current function and stops.
2166
2167 All the keystrokes above are accessible in the GUD buffer
2168 with the prefix C-c, and in all buffers through the prefix C-x C-a.
2169
2170 All pre-defined functions for which the concept make sense repeat
2171 themselves the appropriate number of times if you give a prefix
2172 argument.
2173
2174 You may use the `gud-def' macro in the initialization hook to define other
2175 commands.
2176
2177 Other commands for interacting with the debugger process are inherited from
2178 comint mode, which see."
2179   (interactive)
2180   (comint-mode)
2181   (setq major-mode 'gud-mode)
2182   (setq mode-name "Debugger")
2183   (setq mode-line-process '(": %s"))
2184   (use-local-map (copy-keymap gdbish-comint-mode-map))
2185   (setq gud-last-frame nil)
2186   (make-local-variable 'comint-prompt-regexp)
2187   (make-local-variable 'gud-delete-prompt-marker)
2188   (setq gud-delete-prompt-marker (make-marker))
2189   (run-hooks 'gud-mode-hook)
2190 )
2191
2192 (defvar gud-comint-buffer nil)
2193
2194 ;; Chop STRING into words separated by SPC or TAB and return a list of them.
2195 (defun gud-chop-words (string)
2196   (let ((i 0) (beg 0)
2197         (len (length string))
2198         (words nil))
2199     (while (< i len)
2200       (if (memq (aref string i) '(?\t ? ))
2201           (progn
2202             (setq words (cons (substring string beg i) words)
2203                   beg (1+ i))
2204             (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
2205               (setq beg (1+ beg)))
2206             (setq i (1+ beg)))
2207         (setq i (1+ i))))
2208     (if (< beg len)
2209         (setq words (cons (substring string beg) words)))
2210     (nreverse words)))
2211
2212 (defvar gud-target-name "--unknown--"
2213   "The apparent name of the program being debugged in a gud buffer.
2214 For sure this the root string used in smashing together the gud
2215 buffer's name, even if that doesn't happen to be the name of a
2216 program.")
2217
2218 ;; Perform initializations common to all debuggers.
2219 (defun gud-common-init (command-line)
2220   (let* ((words (gud-chop-words command-line))
2221          (program (car words))
2222          (file-word (let ((w (cdr words)))
2223                       (while (and w (= ?- (aref (car w) 0)))
2224                         (setq w (cdr w)))
2225                       (car w)))
2226          (args (delq file-word (cdr words)))
2227          (file (expand-file-name file-word))
2228          (filepart (file-name-nondirectory file))
2229          (buffer-name (concat "*gud-" filepart "*")))
2230     (switch-to-buffer buffer-name)
2231     (setq default-directory (file-name-directory file))
2232     (or (bolp) (newline))
2233     (insert "Current directory is " default-directory "\n")
2234     (let ((old-instance gdb-buffer-instance))
2235       (apply 'make-comint (concat "gud-" filepart) program nil
2236              (gud-massage-args file args))
2237       (gud-mode)
2238       (make-variable-buffer-local 'old-gdb-buffer-instance)
2239       (setq old-gdb-buffer-instance old-instance))
2240     (make-variable-buffer-local 'gud-target-name)
2241     (setq gud-target-name filepart))
2242   (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
2243   (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
2244   (gud-set-buffer)
2245   )
2246
2247 (defun gud-set-buffer ()
2248   (cond ((eq major-mode 'gud-mode)
2249         (setq gud-comint-buffer (current-buffer)))))
2250
2251 ;; These functions are responsible for inserting output from your debugger
2252 ;; into the buffer.  The hard work is done by the method that is
2253 ;; the value of gud-marker-filter.
2254
2255 (defun gud-filter (proc string)
2256   ;; Here's where the actual buffer insertion is done
2257   (let ((inhibit-quit t))
2258     (save-excursion
2259       (set-buffer (process-buffer proc))
2260       (let (moving output-after-point)
2261         (save-excursion
2262           (goto-char (process-mark proc))
2263           ;; If we have been so requested, delete the debugger prompt.
2264           (if (marker-buffer gud-delete-prompt-marker)
2265               (progn
2266                 (delete-region (point) gud-delete-prompt-marker)
2267                 (set-marker gud-delete-prompt-marker nil)))
2268           (insert-before-markers (gud-marker-filter string))
2269           (setq moving (= (point) (process-mark proc)))
2270           (setq output-after-point (< (point) (process-mark proc)))
2271           ;; Check for a filename-and-line number.
2272           ;; Don't display the specified file
2273           ;; unless (1) point is at or after the position where output appears
2274           ;; and (2) this buffer is on the screen.
2275           (if (and gud-last-frame
2276                    (not output-after-point)
2277                    (get-buffer-window (current-buffer)))
2278               (gud-display-frame)))
2279         (if moving (goto-char (process-mark proc)))))))
2280
2281 (defun gud-proc-died (proc)
2282   ;; Stop displaying an arrow in a source file.
2283   (setq overlay-arrow-position nil)
2284
2285   ;; Kill the dummy process, so that C-x C-c won't worry about it.
2286   (save-excursion
2287     (set-buffer (process-buffer proc))
2288     (kill-process
2289      (get-buffer-process
2290       (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io))))
2291   )
2292
2293 (defun gud-sentinel (proc msg)
2294   (cond ((null (buffer-name (process-buffer proc)))
2295          ;; buffer killed
2296          (gud-proc-died proc)
2297          (set-process-buffer proc nil))
2298         ((memq (process-status proc) '(signal exit))
2299          (gud-proc-died proc)
2300
2301          ;; Fix the mode line.
2302          (setq mode-line-process
2303                (concat ": "
2304                        (symbol-name (process-status proc))))
2305          (let* ((obuf (current-buffer)))
2306            ;; save-excursion isn't the right thing if
2307            ;;  process-buffer is current-buffer
2308            (unwind-protect
2309                (progn
2310                  ;; Write something in *compilation* and hack its mode line,
2311                  (set-buffer (process-buffer proc))
2312                  ;; Force mode line redisplay soon
2313                  (set-buffer-modified-p (buffer-modified-p))
2314                  (if (eobp)
2315                      (insert ?\n mode-name " " msg)
2316                    (save-excursion
2317                      (goto-char (point-max))
2318                      (insert ?\n mode-name " " msg)))
2319                  ;; If buffer and mode line will show that the process
2320                  ;; is dead, we can delete it now.  Otherwise it
2321                  ;; will stay around until M-x list-processes.
2322                  (delete-process proc))
2323              ;; Restore old buffer, but don't restore old point
2324              ;; if obuf is the gud buffer.
2325              (set-buffer obuf))))))
2326
2327 (defun gud-display-frame ()
2328   "Find and obey the last filename-and-line marker from the debugger.
2329 Obeying it means displaying in another window the specified file and line."
2330   (interactive)
2331   (if gud-last-frame
2332    (progn
2333 ;     (gud-set-buffer)
2334      (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
2335      (setq gud-last-last-frame gud-last-frame
2336            gud-last-frame nil))))
2337
2338 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
2339 ;; and that its line LINE is visible.
2340 ;; Put the overlay-arrow on the line LINE in that buffer.
2341 ;; Most of the trickiness in here comes from wanting to preserve the current
2342 ;; region-restriction if that's possible.  We use an explicit display-buffer
2343 ;; to get around the fact that this is called inside a save-excursion.
2344
2345 (defun gud-display-line (true-file line)
2346   (let* ((buffer (gud-find-file true-file))
2347          (window (gud-display-source-buffer buffer))
2348          (pos))
2349     (if (not window)
2350         (error "foo bar baz"))
2351 ;;;    (if (equal buffer (current-buffer))
2352 ;;;     nil
2353 ;;;      (setq buffer-read-only nil))
2354     (save-excursion
2355 ;;;      (setq buffer-read-only t)
2356       (set-buffer buffer)
2357       (save-restriction
2358         (widen)
2359         (goto-line line)
2360         (setq pos (point))
2361         (setq overlay-arrow-string "=>")
2362         (or overlay-arrow-position
2363             (setq overlay-arrow-position (make-marker)))
2364         (set-marker overlay-arrow-position (point) (current-buffer)))
2365       (cond ((or (< pos (point-min)) (> pos (point-max)))
2366              (widen)
2367              (goto-char pos))))
2368     (set-window-point window overlay-arrow-position)))
2369
2370 ;;; The gud-call function must do the right thing whether its invoking
2371 ;;; keystroke is from the GUD buffer itself (via major-mode binding)
2372 ;;; or a C buffer.  In the former case, we want to supply data from
2373 ;;; gud-last-frame.  Here's how we do it:
2374
2375 (defun gud-format-command (str arg)
2376   (let ((insource (not (eq (current-buffer) gud-comint-buffer))))
2377     (if (string-match "\\(.*\\)%f\\(.*\\)" str)
2378         (setq str (concat
2379                    (substring str (match-beginning 1) (match-end 1))
2380                    (file-name-nondirectory (if insource
2381                                                (buffer-file-name)
2382                                              (car gud-last-frame)))
2383                    (substring str (match-beginning 2) (match-end 2)))))
2384     (if (string-match "\\(.*\\)%d\\(.*\\)" str)
2385         (setq str (concat
2386                    (substring str (match-beginning 1) (match-end 1))
2387                    (file-name-directory (if insource
2388                                             (buffer-file-name)
2389                                           (car gud-last-frame)))
2390                    (substring str (match-beginning 2) (match-end 2)))))
2391     (if (string-match "\\(.*\\)%l\\(.*\\)" str)
2392         (setq str (concat
2393                    (substring str (match-beginning 1) (match-end 1))
2394                    (if insource
2395                        (save-excursion
2396                          (beginning-of-line)
2397                          (save-restriction (widen)
2398                                            (1+ (count-lines 1 (point)))))
2399                      (cdr gud-last-frame))
2400                    (substring str (match-beginning 2) (match-end 2)))))
2401     (if (string-match "\\(.*\\)%e\\(.*\\)" str)
2402         (setq str (concat
2403                    (substring str (match-beginning 1) (match-end 1))
2404                    (find-c-expr)
2405                    (substring str (match-beginning 2) (match-end 2)))))
2406     (if (string-match "\\(.*\\)%a\\(.*\\)" str)
2407         (setq str (concat
2408                    (substring str (match-beginning 1) (match-end 1))
2409                    (gud-read-address)
2410                    (substring str (match-beginning 2) (match-end 2)))))
2411     (if (string-match "\\(.*\\)%p\\(.*\\)" str)
2412         (setq str (concat
2413                    (substring str (match-beginning 1) (match-end 1))
2414                    (if arg (int-to-string arg) "")
2415                    (substring str (match-beginning 2) (match-end 2)))))
2416     )
2417   str
2418   )
2419
2420 (defun gud-read-address ()
2421   "Return a string containing the core-address found in the buffer at point."
2422   (save-excursion
2423     (let ((pt (point)) found begin)
2424       (setq found (if (search-backward "0x" (- pt 7) t) (point)))
2425       (cond
2426        (found (forward-char 2)
2427               (buffer-substring found
2428                                 (progn (re-search-forward "[^0-9a-f]")
2429                                        (forward-char -1)
2430                                        (point))))
2431        (t (setq begin (progn (re-search-backward "[^0-9]")
2432                              (forward-char 1)
2433                              (point)))
2434           (forward-char 1)
2435           (re-search-forward "[^0-9]")
2436           (forward-char -1)
2437           (buffer-substring begin (point)))))))
2438
2439 (defun gud-call (fmt &optional arg)
2440   (let ((msg (gud-format-command fmt arg)))
2441     (message "Command: %s" msg)
2442     (sit-for 0)
2443     (gud-basic-call msg)))
2444
2445 (defun gud-basic-call (command)
2446   "Invoke the debugger COMMAND displaying source in other window."
2447   (interactive)
2448   (gud-set-buffer)
2449   (let ((proc (get-buffer-process gud-comint-buffer)))
2450
2451     ;; Arrange for the current prompt to get deleted.
2452     (save-excursion
2453       (set-buffer gud-comint-buffer)
2454       (goto-char (process-mark proc))
2455       (beginning-of-line)
2456       (if (looking-at comint-prompt-regexp)
2457           (set-marker gud-delete-prompt-marker (point)))
2458       (apply comint-input-sender (list proc command)))))
2459
2460 (defun gud-refresh (&optional arg)
2461   "Fix up a possibly garbled display, and redraw the arrow."
2462   (interactive "P")
2463   (recenter arg)
2464   (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
2465   (gud-display-frame))
2466 \f
2467 ;;; Code for parsing expressions out of C code.  The single entry point is
2468 ;;; find-c-expr, which tries to return an lvalue expression from around point.
2469 ;;;
2470 ;;; The rest of this file is a hacked version of gdbsrc.el by
2471 ;;; Debby Ayers <ayers@asc.slb.com>,
2472 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
2473
2474 (defun find-c-expr ()
2475   "Returns the C expr that surrounds point."
2476   (interactive)
2477   (save-excursion
2478     (let ((p) (expr) (test-expr))
2479       (setq p (point))
2480       (setq expr (expr-cur))
2481       (setq test-expr (expr-prev))
2482       (while (expr-compound test-expr expr)
2483         (setq expr (cons (car test-expr) (cdr expr)))
2484         (goto-char (car expr))
2485         (setq test-expr (expr-prev)))
2486       (goto-char p)
2487       (setq test-expr (expr-next))
2488       (while (expr-compound expr test-expr)
2489         (setq expr (cons (car expr) (cdr test-expr)))
2490         (setq test-expr (expr-next))
2491         )
2492       (buffer-substring (car expr) (cdr expr)))))
2493
2494 (defun expr-cur ()
2495   "Returns the expr that point is in; point is set to beginning of expr.
2496 The expr is represented as a cons cell, where the car specifies the point in
2497 the current buffer that marks the beginning of the expr and the cdr specifies
2498 the character after the end of the expr."
2499   (let ((p (point)) (begin) (end))
2500     (expr-backward-sexp)
2501     (setq begin (point))
2502     (expr-forward-sexp)
2503     (setq end (point))
2504     (if (>= p end)
2505         (progn
2506          (setq begin p)
2507          (goto-char p)
2508          (expr-forward-sexp)
2509          (setq end (point))
2510          )
2511       )
2512     (goto-char begin)
2513     (cons begin end)))
2514
2515 (defun expr-backward-sexp ()
2516   "Version of `backward-sexp' that catches errors."
2517   (condition-case nil
2518       (backward-sexp)
2519     (error t)))
2520
2521 (defun expr-forward-sexp ()
2522   "Version of `forward-sexp' that catches errors."
2523   (condition-case nil
2524      (forward-sexp)
2525     (error t)))
2526
2527 (defun expr-prev ()
2528   "Returns the previous expr, point is set to beginning of that expr.
2529 The expr is represented as a cons cell, where the car specifies the point in
2530 the current buffer that marks the beginning of the expr and the cdr specifies
2531 the character after the end of the expr"
2532   (let ((begin) (end))
2533     (expr-backward-sexp)
2534     (setq begin (point))
2535     (expr-forward-sexp)
2536     (setq end (point))
2537     (goto-char begin)
2538     (cons begin end)))
2539
2540 (defun expr-next ()
2541   "Returns the following expr, point is set to beginning of that expr.
2542 The expr is represented as a cons cell, where the car specifies the point in
2543 the current buffer that marks the beginning of the expr and the cdr specifies
2544 the character after the end of the expr."
2545   (let ((begin) (end))
2546     (expr-forward-sexp)
2547     (expr-forward-sexp)
2548     (setq end (point))
2549     (expr-backward-sexp)
2550     (setq begin (point))
2551     (cons begin end)))
2552
2553 (defun expr-compound-sep (span-start span-end)
2554   "Returns '.' for '->' & '.', returns ' ' for white space,
2555 returns '?' for other punctuation."
2556   (let ((result ? )
2557         (syntax))
2558     (while (< span-start span-end)
2559       (setq syntax (char-syntax (char-after span-start)))
2560       (cond
2561        ((= syntax ? ) t)
2562        ((= syntax ?.) (setq syntax (char-after span-start))
2563         (cond
2564          ((= syntax ?.) (setq result ?.))
2565          ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
2566           (setq result ?.)
2567           (setq span-start (+ span-start 1)))
2568          (t (setq span-start span-end)
2569             (setq result ??)))))
2570       (setq span-start (+ span-start 1)))
2571     result))
2572
2573 (defun expr-compound (first second)
2574   "Non-nil if concatenating FIRST and SECOND makes a single C token.
2575 The two exprs are represented as a cons cells, where the car
2576 specifies the point in the current buffer that marks the beginning of the
2577 expr and the cdr specifies the character after the end of the expr.
2578 Link exprs of the form:
2579       Expr -> Expr
2580       Expr . Expr
2581       Expr (Expr)
2582       Expr [Expr]
2583       (Expr) Expr
2584       [Expr] Expr"
2585   (let ((span-start (cdr first))
2586         (span-end (car second))
2587         (syntax))
2588     (setq syntax (expr-compound-sep span-start span-end))
2589     (cond
2590      ((= (car first) (car second)) nil)
2591      ((= (cdr first) (cdr second)) nil)
2592      ((= syntax ?.) t)
2593      ((= syntax ? )
2594          (setq span-start (char-after (- span-start 1)))
2595          (setq span-end (char-after span-end))
2596          (cond
2597           ((= span-start ?) ) t )
2598           ((= span-start ?] ) t )
2599           ((= span-end ?( ) t )
2600           ((= span-end ?[ ) t )
2601           (t nil))
2602          )
2603      (t nil))))
2604
2605 (provide 'gud)
2606
2607 ;;; gud.el ends here