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 <[email protected]>
  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; see the file COPYING.  If not, write to
  37 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  38
  39 ;;; Commentary:
  40
  41 ;; The ancestral gdb.el was by W. Schelter <[email protected]>
  42 ;; It was later rewritten by rms.  Some ideas were due to Masanobu.
  43 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <[email protected]>
  44 ;; The overloading code was then rewritten by Barry Warsaw <[email protected]>,
  45 ;; who also hacked the mode to use comint.el.  Shane Hartman <[email protected]>
  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
 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   (let ((instance (cons 'gdb-instance proc)))
 187     (save-excursion
 188       (set-buffer (process-buffer proc))
 189       (if (not (equal gdb-buffer-instance instance))
 190           (progn
 191             (mapcar 'make-variable-buffer-local gdb-instance-variables)
 192             (setq gdb-buffer-instance instance) ; These are both...
 193             (setq gdb-buffer-type 'gud)))) ; ...instance variables
 194     instance))
 195
 196 (defun gdb-instance-process (inst) (cdr inst))
 197
 198 (defvar gdb-instance-variables '()
 199   "A list of variables that are local to the gud buffer associated
 200 with a gdb instance.")
 201
 202 (defmacro def-gdb-variable
 203   (name accessor setter &optional default doc)
 204   (`
 205    (progn
 206      (defvar (, name) (, default) (, (or doc "undocumented")))
 207      (if (not (memq '(, name) gdb-instance-variables))
 208          (setq gdb-instance-variables
 209                (cons '(, name) gdb-instance-variables)))
 210      (, (and accessor
 211              (`
 212               (defun (, accessor) (instance)
 213                 (let
 214                     ((buffer (gdb-get-instance-buffer instance 'gud)))
 215                   (and buffer
 216                        (save-excursion
 217                          (set-buffer buffer)
 218                          (, name))))))))
 219      (, (and setter
 220              (`
 221               (defun (, setter) (instance val)
 222                 (let
 223                     ((buffer (gdb-get-instance-buffer instance 'gud)))
 224                   (and buffer
 225                        (save-excursion
 226                          (set-buffer buffer)
 227                          (setq (, name) val)))))))))))
 228
 229 (defmacro def-gdb-var (root-symbol &optional default doc)
 230   (let* ((root (symbol-name root-symbol))
 231          (accessor (intern (concat "gdb-instance-" root)))
 232          (setter (intern (concat "set-gdb-instance-" root)))
 233          (var-name (intern (concat "gdb-" root))))
 234     (` (def-gdb-variable
 235          (, var-name) (, accessor) (, setter)
 236          (, default) (, doc)))))
 237
 238 (def-gdb-var buffer-instance nil
 239   "In an instance buffer, the buffer's instance.")
 240
 241 (def-gdb-var buffer-type nil
 242   "One of the symbols bound in gdb-instance-buffer-rules")
 243
 244 (def-gdb-var burst ""
 245   "A string of characters from gdb that have not yet been processed.")
 246
 247 (def-gdb-var input-queue ()
 248   "A list of high priority gdb command objects.")
 249
 250 (def-gdb-var idle-input-queue ()
 251   "A list of low priority gdb command objects.")
 252
 253 (def-gdb-var prompting nil
 254   "True when gdb is idle with no pending input.")
 255
 256 (def-gdb-var output-sink 'user
 257   "The disposition of the output of the current gdb command.")
 258
 259 (def-gdb-var current-item nil
 260   "The most recent command item sent to gdb.")
 261
 262 (def-gdb-var pending-triggers '()
 263   "A list of trigger functions that have run later than their output
 264 handlers.")
 265
 266 (defun in-gdb-instance-context (instance form)
 267   "Funcall `form' in the gud buffer of `instance'"
 268   (save-excursion
 269     (set-buffer (gdb-get-instance-buffer instance 'gud))
 270     (funcall form)))
 271
 272 ;; end of instance vars
 273
 274 ;;
 275 ;; finding instances
 276 ;;
 277
 278 (defun gdb-proc->instance (proc)
 279   (save-excursion
 280     (set-buffer (process-buffer proc))
 281     gdb-buffer-instance))
 282
 283 (defun gdb-mru-instance-buffer ()
 284   "Return the most recently used (non-auxiliary) gdb gud buffer."
 285   (save-excursion
 286     (gdb-goto-first-gdb-instance (buffer-list))))
 287
 288 (defun gdb-goto-first-gdb-instance (blist)
 289   "Use gdb-mru-instance-buffer -- not this."
 290   (and blist
 291        (progn
 292          (set-buffer (car blist))
 293          (or (and gdb-buffer-instance
 294                   (eq gdb-buffer-type 'gud)
 295                   (car blist))
 296              (gdb-goto-first-gdb-instance (cdr blist))))))
 297
 298 (defun buffer-gdb-instance (buf)
 299   (save-excursion
 300     (set-buffer buf)
 301     gdb-buffer-instance))
 302
 303 (defun gdb-needed-default-instance ()
 304   "Return the most recently used gdb instance or signal an error."
 305   (let ((buffer (gdb-mru-instance-buffer)))
 306     (or (and buffer (buffer-gdb-instance buffer))
 307         (error "No instance of gdb found."))))
 308
 309 (defun gdb-instance-target-string (instance)
 310   "The apparent name of the program being debugged by a gdb instance.
 311 For sure this the root string used in smashing together the gud
 312 buffer's name, even if that doesn't happen to be the name of a
 313 program."
 314   (in-gdb-instance-context
 315    instance
 316    (function (lambda () gud-target-name))))
 317
 318 ;; More than one buffer can be associated with a gdb instance.
 319 ;;
 320 ;; Each buffer has a TYPE -- an atom that identifies the function
 321 ;; of that particular buffer.
 322 ;;
 323 ;; The usual gud interaction buffer is given the type `gud' and
 324 ;; is constructed specially.
 325 ;;
 326 ;; Others are constructed by gdb-get-create-instance-buffer and
 327 ;; named according to the rules set forth here:
 328 ;;
 329
 330 (defvar gdb-instance-buffer-rules-assoc
 331   '((gud error)                         ; gud buffers construct specially
 332     (gdb-partial-output-buffer
 333      gdb-partial-output-name
 334      )
 335     (gdb-registers-buffer
 336      gdb-registers-buffer-name)
 337     (gdb-breakpoints-buffer
 338      gdb-breakpoints-buffer-name
 339      gud-breakpoints-mode)
 340     (gdb-frames-buffer
 341      gdb-frames-buffer-name)))
 342
 343
 344 ;;
 345 ;; gdb communications
 346 ;;
 347
 348 ;; input: things sent to gdb
 349 ;;
 350 ;; Each instance has a high and low priority
 351 ;; input queue.  Low priority input is sent only
 352 ;; when the high priority queue is idle.
 353 ;;
 354 ;; The queues are lists.  Each element is either
 355 ;; a string (indicating user or user-like input)
 356 ;; or a list of the form:
 357 ;;
 358 ;;    (INPUT-STRING  HANDLER-FN)
 359 ;;
 360 ;;
 361 ;; The handler function will be called from the
 362 ;; partial-output buffer when the command completes.
 363 ;;
 364 ;; These lists are consumed tail first.
 365 ;;
 366
 367 (defun gdb-send (proc string)
 368   "A comint send filter for gdb.
 369 This filter may simply queue output for a later time."
 370   (let ((instance (gdb-proc->instance proc)))
 371     (gdb-instance-enqueue-input instance (concat string "\n"))))
 372
 373 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
 374 ;; is a query, or other non-top-level prompt.  To guarantee stuff will get
 375 ;; sent to the top-level prompt, currently it must be put in the idle queue.
 376 (defun gdb-instance-enqueue-input (instance item)
 377   "Enqueue an input item (a string or a list) for a gdb instance."
 378   (if (gdb-instance-prompting instance)
 379       (progn
 380         (gdb-send-item instance item)
 381         (set-gdb-instance-prompting instance nil))
 382     (set-gdb-instance-input-queue
 383      instance
 384      (cons item (gdb-instance-input-queue instance)))))
 385
 386 (defun gdb-instance-dequeue-input (instance)
 387   (let ((queue (gdb-instance-input-queue instance)))
 388     (and queue
 389        (if (not (cdr queue))
 390            (let ((answer (car queue)))
 391              (set-gdb-instance-input-queue instance '())
 392              answer)
 393          (gdb-take-last-elt queue)))))
 394
 395 (defun gdb-instance-enqueue-idle-input (instance item)
 396   "Enqueue idle input (a string or a list) for a gdb instance."
 397   (if (gdb-instance-prompting instance)
 398       (progn
 399         (gdb-send-item instance item)
 400         (set-gdb-instance-prompting instance nil))
 401     (set-gdb-instance-idle-input-queue
 402      instance
 403      (cons item (gdb-instance-idle-input-queue instance)))))
 404
 405 (defun gdb-instance-dequeue-idle-input (instance)
 406   (let ((queue (gdb-instance-idle-input-queue instance)))
 407     (and queue
 408        (if (not (cdr queue))
 409            (let ((answer (car queue)))
 410              (set-gdb-instance-idle-input-queue instance '())
 411              answer)
 412          (gdb-take-last-elt queue)))))
 413
 414 (defun gdb-take-last-elt (l)
 415   "Don't use this in general."
 416   (if (cdr (cdr l))
 417       (gdb-take-last-elt (cdr l))
 418     (let ((answer (car (cdr l))))
 419       (setcdr l '())
 420       answer)))
 421
 422
 423 ;;
 424 ;; output -- things gdb prints to emacs
 425 ;;
 426 ;; GDB output is a stream interrupted by annotations.
 427 ;; Annotations can be recognized by their beginning
 428 ;; with \C-j\C-z\C-z<tag><opt>\C-j
 429 ;;
 430 ;; The tag is a string obeying symbol syntax.
 431 ;;
 432 ;; The optional part `<opt>' can be either the empty string
 433 ;; or a space followed by more data relating to the annotation.
 434 ;; For example, the SOURCE annotation is followed by a filename,
 435 ;; line number and various useless goo.  This data must not include
 436 ;; any newlines.
 437 ;;
 438
 439
 440 (defun gud-gdb-marker-filter (string)
 441   "A gud marker filter for gdb."
 442   ;; Bogons don't tell us the process except through scoping crud.
 443   (let ((instance (gdb-proc->instance proc)))
 444     (gdb-output-burst instance string)))
 445
 446 (defvar gdb-annotation-rules
 447   '(("frames-invalid" gdb-invalidate-frames)
 448     ("breakpoints-invalid" gdb-invalidate-breakpoints)
 449     ("pre-prompt" gdb-pre-prompt)
 450     ("prompt" gdb-prompt)
 451     ("commands" gdb-subprompt)
 452     ("overload-choice" gdb-subprompt)
 453     ("query" gdb-subprompt)
 454     ("prompt-for-continue" gdb-subprompt)
 455     ("post-prompt" gdb-post-prompt)
 456     ("source" gdb-source)
 457     )
 458   "An assoc mapping annotation tags to functions which process them.")
 459
 460
 461 (defun gdb-ignore-annotation (instance args)
 462   nil)
 463
 464 (defconst gdb-source-spec-regexp
 465   "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*")
 466
 467 (defun gdb-source (instance args)
 468   "Do not use this except as an annotation handler."
 469   (string-match gdb-source-spec-regexp args)
 470   ;; Extract the frame position from the marker.
 471   (setq gud-last-frame
 472         (cons
 473          (substring args (match-beginning 1) (match-end 1))
 474          (string-to-int (substring args
 475                                    (match-beginning 2)
 476                                    (match-end 2))))))
 477
 478 (defun gdb-prompt (instance ignored)
 479   "An annotation handler for `prompt'.
 480 This sends the next command (if any) to gdb."
 481   (let ((sink (gdb-instance-output-sink instance)))
 482     (cond
 483      ((eq sink 'user) t)
 484      ((eq sink 'post-emacs)
 485       (set-gdb-instance-output-sink instance 'user))
 486      ((or (eq sink 'emacs)
 487           (eq sink 'pre-emacs))
 488       (set-gdb-instance-output-sink instance 'user)
 489       (error "Phase error in gdb-prompt (got %s)" sink))
 490      (t (set-gdb-instance-output-sink instance 'user))))
 491   (let ((highest (gdb-instance-dequeue-input instance)))
 492     (if highest
 493         (gdb-send-item instance highest)
 494       (let ((lowest (gdb-instance-dequeue-idle-input instance)))
 495         (if lowest
 496             (gdb-send-item instance lowest)
 497           (set-gdb-instance-prompting instance t))))))
 498
 499 (defun gdb-subprompt (instance ignored)
 500   "An annotation handler for non-top-level prompts."
 501   (let ((highest (gdb-instance-dequeue-input instance)))
 502     (if highest
 503         (gdb-send-item instance highest)
 504       (set-gdb-instance-prompting instance t))))
 505
 506 (defun gdb-send-item (instance item)
 507   (set-gdb-instance-current-item instance item)
 508   (if (stringp item)
 509       (progn
 510         (set-gdb-instance-output-sink instance 'user)
 511         (process-send-string (gdb-instance-process instance)
 512                              item))
 513     (progn
 514       (gdb-clear-partial-output instance)
 515       (set-gdb-instance-output-sink instance 'pre-emacs)
 516       (process-send-string (gdb-instance-process instance)
 517                            (car item)))))
 518
 519 (defun gdb-pre-prompt (instance ignored)
 520   "An annotation handler for `pre-prompt'.
 521 This terminates the collection of output from a previous
 522 command if that happens to be in effect."
 523   (let ((sink (gdb-instance-output-sink instance)))
 524     (cond
 525      ((eq sink 'user) t)
 526      ((eq sink 'emacs)
 527       (set-gdb-instance-output-sink instance 'post-emacs)
 528       (let ((handler
 529              (car (cdr (gdb-instance-current-item instance)))))
 530         (save-excursion
 531           (set-buffer (gdb-get-create-instance-buffer
 532                        instance 'gdb-partial-output-buffer))
 533           (funcall handler))))
 534      ((eq sink 'pre-emacs)
 535       (set-gdb-instance-output-sink instance 'user)
 536       (error "Output sink phase error 1."))
 537      ((eq sink 'post-emacs)
 538       (set-gdb-instance-output-sink instance 'user)
 539       (error "Output sink phase error 2.")))))
 540
 541 (defun gdb-post-prompt (instance ignored)
 542   "An annotation handler for `post-prompt'.
 543 This begins the collection of output from the current
 544 command if that happens to be appropriate."
 545   (gdb-invalidate-registers instance ignored)
 546   (let ((sink (gdb-instance-output-sink instance)))
 547     (cond
 548      ((eq sink 'user) t)
 549      ((eq sink 'pre-emacs)
 550       (set-gdb-instance-output-sink instance 'emacs))
 551
 552      ((eq sink 'emacs)
 553       (set-gdb-instance-output-sink instance 'user)
 554       (error "Output sink phase error 3."))
 555
 556      ((eq sink 'post-emacs)
 557       (set-gdb-instance-output-sink instance 'user)
 558       (error "Output sink phase error 3.")))))
 559
 560
 561 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
 562   (`
 563    (defun (, name) (instance ignored)
 564      (if (and ((, demand-predicate) instance)
 565               (not (member '(, name)
 566                            (gdb-instance-pending-triggers instance))))
 567          (progn
 568            (gdb-instance-enqueue-idle-input
 569             instance
 570             (list (, gdb-command) '(, output-handler)))
 571            (set-gdb-instance-pending-triggers
 572             instance
 573             (cons '(, name)
 574                   (gdb-instance-pending-triggers instance))))))))
 575
 576 (defmacro def-gdb-auto-update-handler (name trigger buf-key)
 577   (`
 578    (defun (, name) ()
 579      (set-gdb-instance-pending-triggers
 580       instance
 581       (delq '(, trigger)
 582             (gdb-instance-pending-triggers instance)))
 583      (let ((buf (gdb-get-instance-buffer instance
 584                                           '(, buf-key))))
 585        (and buf
 586             (save-excursion
 587               (set-buffer buf)
 588               (let ((p (point)))
 589                 (kill-region (point-min) (point-max))
 590                 (insert-buffer (gdb-get-create-instance-buffer
 591                                 instance
 592                                 'gdb-partial-output-buffer))
 593                 (goto-char p))))))))
 594
 595 (defmacro def-gdb-auto-updated-buffer
 596   (buffer-key trigger-name gdb-command output-handler-name)
 597   (`
 598    (progn
 599      (def-gdb-auto-update-trigger (, trigger-name)
 600        ;; The demand predicate:
 601        (lambda (instance)
 602          (gdb-get-instance-buffer instance '(, buffer-key)))
 603        (, gdb-command)
 604        (, output-handler-name))
 605      (def-gdb-auto-update-handler (, output-handler-name)
 606        (, trigger-name) (, buffer-key)))))
 607
 608
 609
 610 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
 611   ;; This defines the auto update rule for buffers of type
 612   ;; `gdb-breakpoints-buffer'.
 613   ;;
 614   ;; It defines a function to serve as the annotation handler that
 615   ;; handles the `foo-invalidated' message.  That function is called:
 616   gdb-invalidate-breakpoints
 617
 618   ;; To update the buffer, this command is sent to gdb.
 619   "server info breakpoints\n"
 620
 621   ;; This also defines a function to be the handler for the output
 622   ;; from the command above.  That function will copy the output into
 623   ;; the appropriately typed buffer.  That function will be called:
 624   gdb-info-breakpoints-handler)
 625
 626 (def-gdb-auto-updated-buffer gdb-frames-buffer
 627   gdb-invalidate-frames
 628   "server where\n"
 629   gdb-info-frames-handler)
 630
 631
 632 (def-gdb-auto-updated-buffer gdb-registers-buffer
 633   gdb-invalidate-registers
 634   "server info registers\n"
 635   gdb-info-registers-handler)
 636
 637 ;;
 638 ;; At any given time, output from gdb is being directed
 639 ;; one of three places.  By default, it goes into the gdb
 640 ;; interaction buffer.  For commands executed on behalf
 641 ;; of emacs, it goes into a scratch buffer (not `the').
 642 ;; Finally, some gdb output is simply thrown away; for example,
 643 ;; the prompt that follows output from a command executed
 644 ;; for emacs.
 645 ;;
 646
 647 (defvar gdb-output-sink 'user
 648   "An buffer-local indication of how output from an inferior gdb
 649 should be directed.  Legit values are:
 650
 651     USER -- the output should be appended to the gud
 652             buffer.
 653
 654     PRE-EMACS -- throw away output preceding output for emacs.
 655     EMACS -- redirect output to the partial-output buffer.
 656     POST-EMACS -- throw away output following output for emacs.")
 657
 658 (defun gdb-output-burst (instance string)
 659   "Handle a burst of output from a gdb instance.
 660 This function is (indirectly) used as a gud-marker-filter.
 661 It must return output (if any) to be insterted in the gud
 662 buffer."
 663
 664   (save-match-data
 665     (let (
 666           ;; Recall the left over burst from last time
 667           (burst (concat (gdb-instance-burst instance) string))
 668           ;; Start accumulating output for the gud buffer
 669           (output ""))
 670
 671       ;; Process all the complete markers in this chunk.
 672
 673       (while (string-match "\n\032\032\\(.*\\)\n" burst)
 674         (let ((annotation (substring burst
 675                                      (match-beginning 1)
 676                                      (match-end 1))))
 677
 678           ;; Stuff prior to the match is just ordinary output.
 679           ;; It is either concatenated to OUTPUT or directed
 680           ;; elsewhere.
 681           (setq output
 682                 (gdb-concat-output
 683                  instance
 684                  output
 685                  (substring burst 0 (match-beginning 0))))
 686
 687           ;; Take that stuff off the burst.
 688           (setq burst (substring burst (match-end 0)))
 689
 690           ;; Parse the tag from the annotation, and maybe its arguments.
 691           (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
 692           (let* ((annotation-type (substring annotation
 693                                              (match-beginning 1)
 694                                              (match-end 1)))
 695                  (annotation-arguments (substring annotation
 696                                                   (match-beginning 2)
 697                                                   (match-end 2)))
 698                  (annotation-rule (assoc annotation-type
 699                                          gdb-annotation-rules)))
 700             ;; Call the handler for this annotation.
 701             (if annotation-rule
 702                 (funcall (car (cdr annotation-rule))
 703                          instance
 704                          annotation-arguments)
 705               ;; Else the annotation is not recognized.  Ignore it silently,
 706               ;; so that GDB can add new annotations without causing
 707               ;; us to blow up.
 708               ))))
 709
 710
 711       ;; Does the remaining text end in a partial line?
 712       ;; If it does, then keep part of the burst until we get more.
 713       (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
 714                         burst)
 715           (progn
 716             ;; Everything before the potential marker start can be output.
 717             (setq output
 718                   (gdb-concat-output
 719                    instance
 720                    output
 721                    (substring burst 0 (match-beginning 0))))
 722
 723             ;; Everything after, we save, to combine with later input.
 724             (setq burst (substring burst (match-beginning 0))))
 725
 726         ;; In case we know the burst contains no partial annotations:
 727         (progn
 728           (setq output (gdb-concat-output instance output burst))
 729           (setq burst "")))
 730
 731       ;; Save the remaining burst for the next call to this function.
 732       (set-gdb-instance-burst instance burst)
 733       output)))
 734
 735 (defun gdb-concat-output (instance so-far new)
 736   (let ((sink (gdb-instance-output-sink instance)))
 737     (cond
 738      ((eq sink 'user) (concat so-far new))
 739      ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
 740      ((eq sink 'emacs)
 741       (gdb-append-to-partial-output instance new)
 742       so-far)
 743      (t (error "Bogon output sink %d" sink)))))
 744
 745 (defun gdb-append-to-partial-output (instance string)
 746   (save-excursion
 747     (set-buffer
 748      (gdb-get-create-instance-buffer
 749       instance 'gdb-partial-output-buffer))
 750     (goto-char (point-max))
 751     (insert string)))
 752
 753 (defun gdb-clear-partial-output (instance)
 754   (save-excursion
 755     (set-buffer
 756      (gdb-get-create-instance-buffer
 757       instance 'gdb-partial-output-buffer))
 758     (kill-region (point-min) (point-max))))
 759
 760 ;;
 761 ;; Instance Buffers.
 762 ;;
 763 ;; These are buffers that display output from gdb (or other
 764 ;; information) that we want to filter out from the general gdb
 765 ;; interaction buffer.  (e.g. the backtrace buffer).
 766 ;;
 767 ;; The general pattern is that each kind of buffer is associated
 768 ;; with a rule to refresh its contents.  The rule includes one
 769 ;; function to call when it is noticed that the buffer is out of
 770 ;; date.  Typically, that will queue up an idle command for gdb.
 771 ;;
 772 ;; Every type of instance buffer is identified by some atom
 773 ;; such as gdb-frames-buffer.  An instance and one of these
 774 ;; atoms uniquely identifies a particular instance buffer.
 775 ;;
 776
 777 (defun gdb-get-instance-buffer (instance key)
 778   "Return the instance buffer for `instance' tagged with type `key'.
 779 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
 780   (save-excursion
 781     (gdb-look-for-tagged-buffer instance key (buffer-list))))
 782
 783 (defun gdb-get-create-instance-buffer (instance key)
 784   "Create a new gdb instance buffer of the type specified by `key'.
 785 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
 786   (or (gdb-get-instance-buffer instance key)
 787       (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
 788              (name (funcall (gdb-rules-name-maker rules) instance))
 789              (new (get-buffer-create name)))
 790         (save-excursion
 791           (set-buffer new)
 792           (make-variable-buffer-local 'gdb-buffer-type)
 793           (setq gdb-buffer-type key)
 794           (make-variable-buffer-local 'gdb-buffer-instance)
 795           (setq gdb-buffer-instance instance)
 796           (if (cdr (cdr rules))
 797               (funcall (car (cdr (cdr rules)))))
 798           new))))
 799
 800 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
 801
 802 (defun gdb-look-for-tagged-buffer (instance key bufs)
 803   (let ((retval nil))
 804     (while (and (not retval) bufs)
 805       (set-buffer (car bufs))
 806       (if (and (eq gdb-buffer-instance instance)
 807                (eq gdb-buffer-type key))
 808           (setq retval (car bufs)))
 809       (setq bufs (cdr bufs))
 810       )
 811     retval))
 812
 813 (defun gdb-instance-buffer-p (buf)
 814   (save-excursion
 815     (set-buffer buf)
 816     (and gdb-buffer-type
 817          (not (eq gdb-buffer-type 'gud)))))
 818
 819 ;;
 820 ;; partial-output buffers
 821 ;;
 822 ;; These accumulate output from a command executed on
 823 ;; behalf of emacs (rather than the user).  When the
 824 ;; output is complete, the hooks bound to `gdb-command-complete-hooks'
 825 ;; are called (and then cleared).  Usually these hooks are not
 826 ;; set directly but rather implicitly according to the
 827 ;; instance-buffer rules.
 828 ;;
 829
 830 (defun gdb-partial-output-name (instance)
 831   (concat "*partial-output-"
 832           (gdb-instance-target-string instance)
 833           "*"))
 834
 835 ;;
 836 ;; Backtrace buffers
 837 ;;
 838
 839 (defun gdb-frames-buffer-name (instance)
 840   (save-excursion
 841     (set-buffer (process-buffer (gdb-instance-process instance)))
 842     (concat "*stack frames of "
 843             (gdb-instance-target-string instance) "*")))
 844
 845 (defun gud-display-frames-buffer (instance)
 846   (interactive (list (gdb-needed-default-instance)))
 847   (gud-display-buffer
 848    (gdb-get-create-instance-buffer instance
 849                                     'gdb-frames-buffer)))
 850
 851 ;;
 852 ;; Breakpoint buffers
 853 ;;
 854
 855 (defun gdb-breakpoints-buffer-name (instance)
 856   (save-excursion
 857     (set-buffer (process-buffer (gdb-instance-process instance)))
 858     (concat "*breakpoints of " (gdb-instance-target-string instance) "*")))
 859
 860 (defun gud-display-breakpoints-buffer (instance)
 861   (interactive (list (gdb-needed-default-instance)))
 862   (gud-display-buffer
 863    (gdb-get-create-instance-buffer instance
 864                                     'gdb-breakpoints-buffer)))
 865
 866
 867 (defun gud-toggle-bp-this-line ()
 868   (interactive)
 869   (save-excursion
 870     (beginning-of-line 1)
 871     (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
 872         (error "Not recognized as breakpoint line (demo foo).")
 873       (gdb-instance-enqueue-idle-input
 874        gdb-buffer-instance
 875        (list
 876         (concat
 877          (if (eq ?y (char-after (match-beginning 2)))
 878              "server disable "
 879            "server enable ")
 880          (buffer-substring (match-beginning 0)
 881                            (match-end 1))
 882          "\n")
 883         '(lambda () nil)))
 884       )))
 885
 886 (defun gud-delete-bp-this-line ()
 887   (interactive)
 888   (save-excursion
 889     (beginning-of-line 1)
 890     (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
 891         (error "Not recognized as breakpoint line (demo foo).")
 892       (gdb-instance-enqueue-idle-input
 893        gdb-buffer-instance
 894        (list
 895         (concat
 896          "server delete "
 897          (buffer-substring (match-beginning 0)
 898                            (match-end 1))
 899          "\n")
 900         '(lambda () nil)))
 901       )))
 902
 903 (defvar gud-breakpoints-mode-map nil)
 904
 905 (defun gud-breakpoints-mode ()
 906   "Major mode for gud breakpoints.
 907
 908 \\{gud-breakpoints-mode-map}"
 909   (setq major-mode 'gud-breakpoints-mode)
 910   (setq mode-name "Breakpoints")
 911   (use-local-map gud-breakpoints-mode-map))
 912
 913 (if gud-breakpoints-mode-map
 914     nil
 915   (setq gud-breakpoints-mode-map (make-sparse-keymap))
 916   (define-key gud-breakpoints-mode-map " " 'gud-toggle-bp-this-line)
 917   (define-key gud-breakpoints-mode-map "d" 'gud-delete-bp-this-line))
 918
 919 ;;
 920 ;; Registers buffers
 921 ;;
 922
 923 (defun gdb-registers-buffer-name (instance)
 924   (save-excursion
 925     (set-buffer (process-buffer (gdb-instance-process instance)))
 926     (concat "*registers of " (gdb-instance-target-string instance) "*")))
 927
 928 (defun gud-display-registers-buffer (instance)
 929   (interactive (list (gdb-needed-default-instance)))
 930   (gud-display-buffer
 931    (gdb-get-create-instance-buffer instance
 932                                     'gdb-registers-buffer)))
 933
 934 \f
 935 ;;; FIXME: This should only return true for buffers in the current instance
 936 (defun gud-protected-buffer-p (buffer)
 937   "Is BUFFER a buffer which we want to leave displayed?"
 938   (save-excursion
 939     (set-buffer buffer)
 940     (or (eq gdb-buffer-type 'gdb-registers-buffer)
 941         (eq gdb-buffer-type 'gdb-breakpoints-buffer)
 942         (eq gdb-buffer-type 'gdb-frames-buffer)
 943         (eq gdb-buffer-type 'gud))))
 944 ;;;
 945 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
 946 ;;; to do the right thing.  Seeing as there is no way for Lisp code to
 947 ;;; get at the use_time field of a window, I'm not sure there exists a
 948 ;;; more elegant solution without writing C code.
 949
 950 (defun gud-display-buffer (buf)
 951   (let ((must-split nil))
 952     (unwind-protect
 953         (progn
 954           (walk-windows
 955            '(lambda (win)
 956               (if (gud-protected-buffer-p (window-buffer win))
 957                   (set-window-dedicated-p win t)
 958                 )))
 959           ;; This is more or less just the same as display-buffer; the
 960           ;; big difference is that we split the largest window rather
 961           ;; than the lru window.  Various settings and hair which
 962           ;; display-buffer has are omitted, for simplicity.
 963           (if (not (get-buffer-window buf nil))
 964               (let ((window (get-lru-window nil)))
 965                 (if window
 966                     (set-window-buffer window buf)
 967                   (setq must-split t)
 968                   )))
 969         )
 970     (walk-windows
 971      '(lambda (win)
 972         (if (gud-protected-buffer-p (window-buffer win))
 973             (set-window-dedicated-p win nil)
 974           )))
 975     )
 976     (if must-split
 977         (set-window-buffer (split-window (get-largest-window)) buf))
 978     ))
 979 \f
 980 (defun gud-gdb-find-file (f)
 981   (find-file-noselect f))
 982
 983 ;;;###autoload
 984 (defun gdb (command-line)
 985   "Run gdb on program FILE in buffer *gud-FILE*.
 986 The directory containing FILE becomes the initial working directory
 987 and source-file directory for your debugger."
 988   (interactive
 989    (list (read-from-minibuffer "Run gdb (like this): "
 990                                (if (consp gud-gdb-history)
 991                                    (car gud-gdb-history)
 992                                  "gdb ")
 993                                nil nil
 994                                '(gud-gdb-history . 1))))
 995   (gud-overload-functions
 996    '((gud-massage-args . gud-gdb-massage-args)
 997      (gud-marker-filter . gud-gdb-marker-filter)
 998      (gud-find-file . gud-gdb-find-file)
 999      ))
1000
1001   (gud-common-init command-line)
1002
1003   (gud-def gud-break  "break %f:%l"  "\C-b" "Set breakpoint at current line.")
1004   (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
1005   (gud-def gud-remove "clear %l"     "\C-d" "Remove breakpoint at current line")
1006   (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
1007   (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
1008   (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
1009   (gud-def gud-cont   "cont"         "\C-r" "Continue with display.")
1010   (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
1011   (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
1012   (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
1013   (gud-def gud-print  "print %e"     "\C-p" "Evaluate C expression at point.")
1014
1015   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
1016   (setq comint-input-sender 'gdb-send)
1017   (run-hooks 'gdb-mode-hook)
1018   (make-gdb-instance (get-buffer-process (current-buffer)))
1019   )
1020
1021 \f
1022 ;; ======================================================================
1023 ;; sdb functions
1024
1025 ;;; History of argument lists passed to sdb.
1026 (defvar gud-sdb-history nil)
1027
1028 (defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
1029   "If nil, we're on a System V Release 4 and don't need the tags hack.")
1030
1031 (defvar gud-sdb-lastfile nil)
1032
1033 (defun gud-sdb-massage-args (file args)
1034   (cons file args))
1035
1036 (defun gud-sdb-marker-filter (string)
1037   (cond
1038    ;; System V Release 3.2 uses this format
1039    ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
1040                     string)
1041     (setq gud-last-frame
1042           (cons
1043            (substring string (match-beginning 2) (match-end 2))
1044            (string-to-int
1045             (substring string (match-beginning 3) (match-end 3))))))
1046    ;; System V Release 4.0
1047    ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
1048                        string)
1049     (setq gud-sdb-lastfile
1050           (substring string (match-beginning 2) (match-end 2))))
1051    ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
1052          (setq gud-last-frame
1053                (cons
1054                 gud-sdb-lastfile
1055                 (string-to-int
1056                  (substring string (match-beginning 1) (match-end 1))))))
1057    (t
1058     (setq gud-sdb-lastfile nil)))
1059   string)
1060
1061 (defun gud-sdb-find-file (f)
1062   (if gud-sdb-needs-tags
1063       (find-tag-noselect f)
1064     (find-file-noselect f)))
1065
1066 ;;;###autoload
1067 (defun sdb (command-line)
1068   "Run sdb on program FILE in buffer *gud-FILE*.
1069 The directory containing FILE becomes the initial working directory
1070 and source-file directory for your debugger."
1071   (interactive
1072    (list (read-from-minibuffer "Run sdb (like this): "
1073                                (if (consp gud-sdb-history)
1074                                    (car gud-sdb-history)
1075                                  "sdb ")
1076                                nil nil
1077                                '(gud-sdb-history . 1))))
1078   (if (and gud-sdb-needs-tags
1079            (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))))
1080       (error "The sdb support requires a valid tags table to work."))
1081   (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args)
1082                             (gud-marker-filter . gud-sdb-marker-filter)
1083                             (gud-find-file . gud-sdb-find-file)
1084                             ))
1085
1086   (gud-common-init command-line)
1087
1088   (gud-def gud-break  "%l b" "\C-b"   "Set breakpoint at current line.")
1089   (gud-def gud-tbreak "%l c" "\C-t"   "Set temporary breakpoint at current line.")
1090   (gud-def gud-remove "%l d" "\C-d"   "Remove breakpoint at current line")
1091   (gud-def gud-step   "s %p" "\C-s"   "Step one source line with display.")
1092   (gud-def gud-stepi  "i %p" "\C-i"   "Step one instruction with display.")
1093   (gud-def gud-next   "S %p" "\C-n"   "Step one line (skip functions).")
1094   (gud-def gud-cont   "c"    "\C-r"   "Continue with display.")
1095   (gud-def gud-print  "%e/"  "\C-p"   "Evaluate C expression at point.")
1096
1097   (setq comint-prompt-regexp  "\\(^\\|\n\\)\\*")
1098   (run-hooks 'sdb-mode-hook)
1099   )
1100 \f
1101 ;; ======================================================================
1102 ;; dbx functions
1103
1104 ;;; History of argument lists passed to dbx.
1105 (defvar gud-dbx-history nil)
1106
1107 (defun gud-dbx-massage-args (file args)
1108   (cons file args))
1109
1110 (defun gud-dbx-marker-filter (string)
1111   (if (or (string-match
1112          "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
1113          string)
1114         (string-match
1115          "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
1116          string))
1117       (setq gud-last-frame
1118             (cons
1119              (substring string (match-beginning 2) (match-end 2))
1120              (string-to-int
1121               (substring string (match-beginning 1) (match-end 1))))))
1122   string)
1123
1124 (defun gud-dbx-find-file (f)
1125   (find-file-noselect f))
1126
1127 ;;;###autoload
1128 (defun dbx (command-line)
1129   "Run dbx on program FILE in buffer *gud-FILE*.
1130 The directory containing FILE becomes the initial working directory
1131 and source-file directory for your debugger."
1132   (interactive
1133    (list (read-from-minibuffer "Run dbx (like this): "
1134                                (if (consp gud-dbx-history)
1135                                    (car gud-dbx-history)
1136                                  "dbx ")
1137                                nil nil
1138                                '(gud-dbx-history . 1))))
1139   (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args)
1140                             (gud-marker-filter . gud-dbx-marker-filter)
1141                             (gud-find-file . gud-dbx-find-file)
1142                             ))
1143
1144   (gud-common-init command-line)
1145
1146   (gud-def gud-break  "file \"%d%f\"\nstop at %l"
1147                                   "\C-b" "Set breakpoint at current line.")
1148 ;;  (gud-def gud-break  "stop at \"%f\":%l"
1149 ;;                                "\C-b" "Set breakpoint at current line.")
1150   (gud-def gud-remove "clear %l"  "\C-d" "Remove breakpoint at current line")
1151   (gud-def gud-step   "step %p"   "\C-s" "Step one line with display.")
1152   (gud-def gud-stepi  "stepi %p"  "\C-i" "Step one instruction with display.")
1153   (gud-def gud-next   "next %p"   "\C-n" "Step one line (skip functions).")
1154   (gud-def gud-cont   "cont"      "\C-r" "Continue with display.")
1155   (gud-def gud-up     "up %p"     "<" "Up (numeric arg) stack frames.")
1156   (gud-def gud-down   "down %p"   ">" "Down (numeric arg) stack frames.")
1157   (gud-def gud-print  "print %e"  "\C-p" "Evaluate C expression at point.")
1158
1159   (setq comint-prompt-regexp  "^[^)]*dbx) *")
1160   (run-hooks 'dbx-mode-hook)
1161   )
1162 \f
1163 ;; ======================================================================
1164 ;; xdb (HP PARISC debugger) functions
1165
1166 ;;; History of argument lists passed to xdb.
1167 (defvar gud-xdb-history nil)
1168
1169 (defvar gud-xdb-directories nil
1170   "*A list of directories that xdb should search for source code.
1171 If nil, only source files in the program directory
1172 will be known to xdb.
1173
1174 The file names should be absolute, or relative to the directory
1175 containing the executable being debugged.")
1176
1177 (defun gud-xdb-massage-args (file args)
1178   (nconc (let ((directories gud-xdb-directories)
1179                (result nil))
1180            (while directories
1181              (setq result (cons (car directories) (cons "-d" result)))
1182              (setq directories (cdr directories)))
1183            (nreverse (cons file result)))
1184          args))
1185
1186 (defun gud-xdb-file-name (f)
1187   "Transform a relative pathname to a full pathname in xdb mode"
1188   (let ((result nil))
1189     (if (file-exists-p f)
1190         (setq result (expand-file-name f))
1191       (let ((directories gud-xdb-directories))
1192         (while directories
1193           (let ((path (concat (car directories) "/" f)))
1194             (if (file-exists-p path)
1195                 (setq result (expand-file-name path)
1196                       directories nil)))
1197           (setq directories (cdr directories)))))
1198     result))
1199
1200 ;; xdb does not print the lines all at once, so we have to accumulate them
1201 (defvar gud-xdb-accumulation "")
1202
1203 (defun gud-xdb-marker-filter (string)
1204   (let (result)
1205     (if (or (string-match comint-prompt-regexp string)
1206             (string-match ".*\012" string))
1207         (setq result (concat gud-xdb-accumulation string)
1208               gud-xdb-accumulation "")
1209       (setq gud-xdb-accumulation (concat gud-xdb-accumulation string)))
1210     (if result
1211         (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result)
1212                 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
1213                               result))
1214             (let ((line (string-to-int
1215                          (substring result (match-beginning 2) (match-end 2))))
1216                   (file (gud-xdb-file-name
1217                          (substring result (match-beginning 1) (match-end 1)))))
1218               (if file
1219                   (setq gud-last-frame (cons file line))))))
1220     (or result "")))
1221
1222 (defun gud-xdb-find-file (f)
1223   (let ((realf (gud-xdb-file-name f)))
1224     (if realf (find-file-noselect realf))))
1225
1226 ;;;###autoload
1227 (defun xdb (command-line)
1228   "Run xdb on program FILE in buffer *gud-FILE*.
1229 The directory containing FILE becomes the initial working directory
1230 and source-file directory for your debugger.
1231
1232 You can set the variable 'gud-xdb-directories' to a list of program source
1233 directories if your program contains sources from more than one directory."
1234   (interactive
1235    (list (read-from-minibuffer "Run xdb (like this): "
1236                                (if (consp gud-xdb-history)
1237                                    (car gud-xdb-history)
1238                                  "xdb ")
1239                                nil nil
1240                                '(gud-xdb-history . 1))))
1241   (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args)
1242                             (gud-marker-filter . gud-xdb-marker-filter)
1243                             (gud-find-file . gud-xdb-find-file)))
1244
1245   (gud-common-init command-line)
1246
1247   (gud-def gud-break  "b %f:%l"    "\C-b" "Set breakpoint at current line.")
1248   (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
1249            "Set temporary breakpoint at current line.")
1250   (gud-def gud-remove "db"         "\C-d" "Remove breakpoint at current line")
1251   (gud-def gud-step   "s %p"       "\C-s" "Step one line with display.")
1252   (gud-def gud-next   "S %p"       "\C-n" "Step one line (skip functions).")
1253   (gud-def gud-cont   "c"          "\C-r" "Continue with display.")
1254   (gud-def gud-up     "up %p"      "<"    "Up (numeric arg) stack frames.")
1255   (gud-def gud-down   "down %p"    ">"    "Down (numeric arg) stack frames.")
1256   (gud-def gud-finish "bu\\t"      "\C-f" "Finish executing current function.")
1257   (gud-def gud-print  "p %e"       "\C-p" "Evaluate C expression at point.")
1258
1259   (setq comint-prompt-regexp  "^>")
1260   (make-local-variable 'gud-xdb-accumulation)
1261   (setq gud-xdb-accumulation "")
1262   (run-hooks 'xdb-mode-hook))
1263 \f
1264 ;; ======================================================================
1265 ;; perldb functions
1266
1267 ;;; History of argument lists passed to perldb.
1268 (defvar gud-perldb-history nil)
1269
1270 (defun gud-perldb-massage-args (file args)
1271   (cons "-d" (cons file (cons "-emacs" args))))
1272
1273 ;; There's no guarantee that Emacs will hand the filter the entire
1274 ;; marker at once; it could be broken up across several strings.  We
1275 ;; might even receive a big chunk with several markers in it.  If we
1276 ;; receive a chunk of text which looks like it might contain the
1277 ;; beginning of a marker, we save it here between calls to the
1278 ;; filter.
1279 (defvar gud-perldb-marker-acc "")
1280
1281 (defun gud-perldb-marker-filter (string)
1282   (save-match-data
1283     (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string))
1284     (let ((output ""))
1285
1286       ;; Process all the complete markers in this chunk.
1287       (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
1288                            gud-perldb-marker-acc)
1289         (setq
1290
1291          ;; Extract the frame position from the marker.
1292          gud-last-frame
1293          (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1))
1294                (string-to-int (substring gud-perldb-marker-acc
1295                                          (match-beginning 2)
1296                                          (match-end 2))))
1297
1298          ;; Append any text before the marker to the output we're going
1299          ;; to return - we don't include the marker in this text.
1300          output (concat output
1301                         (substring gud-perldb-marker-acc 0 (match-beginning 0)))
1302
1303          ;; Set the accumulator to the remaining text.
1304          gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0))))
1305
1306       ;; Does the remaining text look like it might end with the
1307       ;; beginning of another marker?  If it does, then keep it in
1308       ;; gud-perldb-marker-acc until we receive the rest of it.  Since we
1309       ;; know the full marker regexp above failed, it's pretty simple to
1310       ;; test for marker starts.
1311       (if (string-match "^\032.*\\'" gud-perldb-marker-acc)
1312           (progn
1313             ;; Everything before the potential marker start can be output.
1314             (setq output (concat output (substring gud-perldb-marker-acc
1315                                                    0 (match-beginning 0))))
1316
1317             ;; Everything after, we save, to combine with later input.
1318             (setq gud-perldb-marker-acc
1319                   (substring gud-perldb-marker-acc (match-beginning 0))))
1320
1321         (setq output (concat output gud-perldb-marker-acc)
1322               gud-perldb-marker-acc ""))
1323
1324       output)))
1325
1326 (defun gud-perldb-find-file (f)
1327   (find-file-noselect f))
1328
1329 ;;;###autoload
1330 (defun perldb (command-line)
1331   "Run perldb on program FILE in buffer *gud-FILE*.
1332 The directory containing FILE becomes the initial working directory
1333 and source-file directory for your debugger."
1334   (interactive
1335    (list (read-from-minibuffer "Run perldb (like this): "
1336                                (if (consp gud-perldb-history)
1337                                    (car gud-perldb-history)
1338                                  "perl ")
1339                                nil nil
1340                                '(gud-perldb-history . 1))))
1341   (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
1342                             (gud-marker-filter . gud-perldb-marker-filter)
1343                             (gud-find-file . gud-perldb-find-file)
1344                             ))
1345
1346   (gud-common-init command-line)
1347
1348   (gud-def gud-break  "b %l"         "\C-b" "Set breakpoint at current line.")
1349   (gud-def gud-remove "d %l"         "\C-d" "Remove breakpoint at current line")
1350   (gud-def gud-step   "s"            "\C-s" "Step one source line with display.")
1351   (gud-def gud-next   "n"            "\C-n" "Step one line (skip functions).")
1352   (gud-def gud-cont   "c"            "\C-r" "Continue with display.")
1353 ;  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
1354 ;  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
1355 ;  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
1356   (gud-def gud-print  "%e"           "\C-p" "Evaluate perl expression at point.")
1357
1358   (setq comint-prompt-regexp "^  DB<[0-9]+> ")
1359   (run-hooks 'perldb-mode-hook)
1360   )
1361
1362 ;;
1363 ;; End of debugger-specific information
1364 ;;
1365
1366 \f
1367 ;;; When we send a command to the debugger via gud-call, it's annoying
1368 ;;; to see the command and the new prompt inserted into the debugger's
1369 ;;; buffer; we have other ways of knowing the command has completed.
1370 ;;;
1371 ;;; If the buffer looks like this:
1372 ;;; --------------------
1373 ;;; (gdb) set args foo bar
1374 ;;; (gdb) -!-
1375 ;;; --------------------
1376 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a
1377 ;;; source file to set a breakpoint, we want the buffer to end up like
1378 ;;; this:
1379 ;;; --------------------
1380 ;;; (gdb) set args foo bar
1381 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
1382 ;;; (gdb) -!-
1383 ;;; --------------------
1384 ;;; Essentially, the old prompt is deleted, and the command's output
1385 ;;; and the new prompt take its place.
1386 ;;;
1387 ;;; Not echoing the command is easy enough; you send it directly using
1388 ;;; process-send-string, and it never enters the buffer.  However,
1389 ;;; getting rid of the old prompt is trickier; you don't want to do it
1390 ;;; when you send the command, since that will result in an annoying
1391 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs
1392 ;;; waits for a response from the debugger, and the new prompt is
1393 ;;; inserted.  Instead, we'll wait until we actually get some output
1394 ;;; from the subprocess before we delete the prompt.  If the command
1395 ;;; produced no output other than a new prompt, that prompt will most
1396 ;;; likely be in the first chunk of output received, so we will delete
1397 ;;; the prompt and then replace it with an identical one.  If the
1398 ;;; command produces output, the prompt is moving anyway, so the
1399 ;;; flicker won't be annoying.
1400 ;;;
1401 ;;; So - when we want to delete the prompt upon receipt of the next
1402 ;;; chunk of debugger output, we position gud-delete-prompt-marker at
1403 ;;; the start of the prompt; the process filter will notice this, and
1404 ;;; delete all text between it and the process output marker.  If
1405 ;;; gud-delete-prompt-marker points nowhere, we leave the current
1406 ;;; prompt alone.
1407 (defvar gud-delete-prompt-marker nil)
1408
1409 \f
1410 (defvar gdbish-comint-mode-map (copy-keymap comint-mode-map))
1411 (define-key gdbish-comint-mode-map "\C-c\M-\C-r" 'gud-display-registers-buffer)
1412 (define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-frames-buffer)
1413 (define-key gdbish-comint-mode-map "\C-c\M-\C-b" 'gud-display-breakpoints-buffer)
1414
1415 (defun gud-mode ()
1416   "Major mode for interacting with an inferior debugger process.
1417
1418    You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
1419 or M-x xdb.  Each entry point finishes by executing a hook; `gdb-mode-hook',
1420 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively.
1421
1422 After startup, the following commands are available in both the GUD
1423 interaction buffer and any source buffer GUD visits due to a breakpoint stop
1424 or step operation:
1425
1426 \\[gud-break] sets a breakpoint at the current file and line.  In the
1427 GUD buffer, the current file and line are those of the last breakpoint or
1428 step.  In a source buffer, they are the buffer's file and current line.
1429
1430 \\[gud-remove] removes breakpoints on the current file and line.
1431
1432 \\[gud-refresh] displays in the source window the last line referred to
1433 in the gud buffer.
1434
1435 \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
1436 step-one-line (not entering function calls), and step-one-instruction
1437 and then update the source window with the current file and position.
1438 \\[gud-cont] continues execution.
1439
1440 \\[gud-print] tries to find the largest C lvalue or function-call expression
1441 around point, and sends it to the debugger for value display.
1442
1443 The above commands are common to all supported debuggers except xdb which
1444 does not support stepping instructions.
1445
1446 Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
1447 except that the breakpoint is temporary; that is, it is removed when
1448 execution stops on it.
1449
1450 Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
1451 frame.  \\[gud-down] drops back down through one.
1452
1453 If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
1454 the current function and stops.
1455
1456 All the keystrokes above are accessible in the GUD buffer
1457 with the prefix C-c, and in all buffers through the prefix C-x C-a.
1458
1459 All pre-defined functions for which the concept make sense repeat
1460 themselves the appropriate number of times if you give a prefix
1461 argument.
1462
1463 You may use the `gud-def' macro in the initialization hook to define other
1464 commands.
1465
1466 Other commands for interacting with the debugger process are inherited from
1467 comint mode, which see."
1468   (interactive)
1469   (comint-mode)
1470   (setq major-mode 'gud-mode)
1471   (setq mode-name "Debugger")
1472   (setq mode-line-process '(": %s"))
1473   (use-local-map (copy-keymap gdbish-comint-mode-map))
1474   (make-local-variable 'gud-last-frame)
1475   (setq gud-last-frame nil)
1476   (make-local-variable 'comint-prompt-regexp)
1477   (make-local-variable 'gud-delete-prompt-marker)
1478   (setq gud-delete-prompt-marker (make-marker))
1479   (run-hooks 'gud-mode-hook)
1480 )
1481
1482 (defvar gud-comint-buffer nil)
1483
1484 ;; Chop STRING into words separated by SPC or TAB and return a list of them.
1485 (defun gud-chop-words (string)
1486   (let ((i 0) (beg 0)
1487         (len (length string))
1488         (words nil))
1489     (while (< i len)
1490       (if (memq (aref string i) '(?\t ? ))
1491           (progn
1492             (setq words (cons (substring string beg i) words)
1493                   beg (1+ i))
1494             (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
1495               (setq beg (1+ beg)))
1496             (setq i (1+ beg)))
1497         (setq i (1+ i))))
1498     (if (< beg len)
1499         (setq words (cons (substring string beg) words)))
1500     (nreverse words)))
1501
1502 (defvar gud-target-name "--unknown--"
1503   "The apparent name of the program being debugged in a gud buffer.
1504 For sure this the root string used in smashing together the gud
1505 buffer's name, even if that doesn't happen to be the name of a
1506 program.")
1507
1508 ;; Perform initializations common to all debuggers.
1509 (defun gud-common-init (command-line)
1510   (let* ((words (gud-chop-words command-line))
1511          (program (car words))
1512          (file-word (let ((w (cdr words)))
1513                       (while (and w (= ?- (aref (car w) 0)))
1514                         (setq w (cdr w)))
1515                       (car w)))
1516          (args (delq file-word (cdr words)))
1517          (file (expand-file-name file-word))
1518          (filepart (file-name-nondirectory file))
1519          (buffer-name (concat "*gud-" filepart "*")))
1520     (switch-to-buffer buffer-name)
1521     (setq default-directory (file-name-directory file))
1522     (or (bolp) (newline))
1523     (insert "Current directory is " default-directory "\n")
1524     (apply 'make-comint (concat "gud-" filepart) program nil
1525            (gud-massage-args file args))
1526     (gud-mode)
1527     (make-variable-buffer-local 'gud-target-name)
1528     (setq gud-target-name filepart))
1529   (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
1530   (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
1531   (gud-set-buffer)
1532   )
1533
1534 (defun gud-set-buffer ()
1535   (cond ((eq major-mode 'gud-mode)
1536         (setq gud-comint-buffer (current-buffer)))))
1537
1538 ;; These functions are responsible for inserting output from your debugger
1539 ;; into the buffer.  The hard work is done by the method that is
1540 ;; the value of gud-marker-filter.
1541
1542 (defun gud-filter (proc string)
1543   ;; Here's where the actual buffer insertion is done
1544   (let ((inhibit-quit t))
1545     (save-excursion
1546       (set-buffer (process-buffer proc))
1547       (let (moving output-after-point)
1548         (save-excursion
1549           (goto-char (process-mark proc))
1550           ;; If we have been so requested, delete the debugger prompt.
1551           (if (marker-buffer gud-delete-prompt-marker)
1552               (progn
1553                 (delete-region (point) gud-delete-prompt-marker)
1554                 (set-marker gud-delete-prompt-marker nil)))
1555           (insert-before-markers (gud-marker-filter string))
1556           (setq moving (= (point) (process-mark proc)))
1557           (setq output-after-point (< (point) (process-mark proc)))
1558           ;; Check for a filename-and-line number.
1559           ;; Don't display the specified file
1560           ;; unless (1) point is at or after the position where output appears
1561           ;; and (2) this buffer is on the screen.
1562           (if (and gud-last-frame
1563                    (not output-after-point)
1564                    (get-buffer-window (current-buffer)))
1565               (gud-display-frame)))
1566         (if moving (goto-char (process-mark proc)))))))
1567
1568 (defun gud-sentinel (proc msg)
1569   (cond ((null (buffer-name (process-buffer proc)))
1570          ;; buffer killed
1571          ;; Stop displaying an arrow in a source file.
1572          (setq overlay-arrow-position nil)
1573          (set-process-buffer proc nil))
1574         ((memq (process-status proc) '(signal exit))
1575          ;; Stop displaying an arrow in a source file.
1576          (setq overlay-arrow-position nil)
1577          ;; Fix the mode line.
1578          (setq mode-line-process
1579                (concat ": "
1580                        (symbol-name (process-status proc))))
1581          (let* ((obuf (current-buffer)))
1582            ;; save-excursion isn't the right thing if
1583            ;;  process-buffer is current-buffer
1584            (unwind-protect
1585                (progn
1586                  ;; Write something in *compilation* and hack its mode line,
1587                  (set-buffer (process-buffer proc))
1588                  ;; Force mode line redisplay soon
1589                  (set-buffer-modified-p (buffer-modified-p))
1590                  (if (eobp)
1591                      (insert ?\n mode-name " " msg)
1592                    (save-excursion
1593                      (goto-char (point-max))
1594                      (insert ?\n mode-name " " msg)))
1595                  ;; If buffer and mode line will show that the process
1596                  ;; is dead, we can delete it now.  Otherwise it
1597                  ;; will stay around until M-x list-processes.
1598                  (delete-process proc))
1599              ;; Restore old buffer, but don't restore old point
1600              ;; if obuf is the gud buffer.
1601              (set-buffer obuf))))))
1602
1603 (defun gud-display-frame ()
1604   "Find and obey the last filename-and-line marker from the debugger.
1605 Obeying it means displaying in another window the specified file and line."
1606   (interactive)
1607   (if gud-last-frame
1608    (progn
1609      (gud-set-buffer)
1610      (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
1611      (setq gud-last-last-frame gud-last-frame
1612            gud-last-frame nil))))
1613
1614 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
1615 ;; and that its line LINE is visible.
1616 ;; Put the overlay-arrow on the line LINE in that buffer.
1617 ;; Most of the trickiness in here comes from wanting to preserve the current
1618 ;; region-restriction if that's possible.  We use an explicit display-buffer
1619 ;; to get around the fact that this is called inside a save-excursion.
1620
1621 (defun gud-display-line (true-file line)
1622   (let* ((buffer (gud-find-file true-file))
1623          (window (gud-display-buffer buffer))
1624          (pos))
1625 ;;;    (if (equal buffer (current-buffer))
1626 ;;;     nil
1627 ;;;      (setq buffer-read-only nil))
1628     (save-excursion
1629 ;;;      (setq buffer-read-only t)
1630       (set-buffer buffer)
1631       (save-restriction
1632         (widen)
1633         (goto-line line)
1634         (setq pos (point))
1635         (setq overlay-arrow-string "=>")
1636         (or overlay-arrow-position
1637             (setq overlay-arrow-position (make-marker)))
1638         (set-marker overlay-arrow-position (point) (current-buffer)))
1639       (cond ((or (< pos (point-min)) (> pos (point-max)))
1640              (widen)
1641              (goto-char pos))))
1642     (set-window-point window overlay-arrow-position)))
1643
1644 ;;; The gud-call function must do the right thing whether its invoking
1645 ;;; keystroke is from the GUD buffer itself (via major-mode binding)
1646 ;;; or a C buffer.  In the former case, we want to supply data from
1647 ;;; gud-last-frame.  Here's how we do it:
1648
1649 (defun gud-format-command (str arg)
1650   (let ((insource (not (eq (current-buffer) gud-comint-buffer))))
1651     (if (string-match "\\(.*\\)%f\\(.*\\)" str)
1652         (setq str (concat
1653                    (substring str (match-beginning 1) (match-end 1))
1654                    (file-name-nondirectory (if insource
1655                                                (buffer-file-name)
1656                                              (car gud-last-frame)))
1657                    (substring str (match-beginning 2) (match-end 2)))))
1658     (if (string-match "\\(.*\\)%d\\(.*\\)" str)
1659         (setq str (concat
1660                    (substring str (match-beginning 1) (match-end 1))
1661                    (file-name-directory (if insource
1662                                             (buffer-file-name)
1663                                           (car gud-last-frame)))
1664                    (substring str (match-beginning 2) (match-end 2)))))
1665     (if (string-match "\\(.*\\)%l\\(.*\\)" str)
1666         (setq str (concat
1667                    (substring str (match-beginning 1) (match-end 1))
1668                    (if insource
1669                        (save-excursion
1670                          (beginning-of-line)
1671                          (save-restriction (widen)
1672                                            (1+ (count-lines 1 (point)))))
1673                      (cdr gud-last-frame))
1674                    (substring str (match-beginning 2) (match-end 2)))))
1675     (if (string-match "\\(.*\\)%e\\(.*\\)" str)
1676         (setq str (concat
1677                    (substring str (match-beginning 1) (match-end 1))
1678                    (find-c-expr)
1679                    (substring str (match-beginning 2) (match-end 2)))))
1680     (if (string-match "\\(.*\\)%a\\(.*\\)" str)
1681         (setq str (concat
1682                    (substring str (match-beginning 1) (match-end 1))
1683                    (gud-read-address)
1684                    (substring str (match-beginning 2) (match-end 2)))))
1685     (if (string-match "\\(.*\\)%p\\(.*\\)" str)
1686         (setq str (concat
1687                    (substring str (match-beginning 1) (match-end 1))
1688                    (if arg (int-to-string arg) "")
1689                    (substring str (match-beginning 2) (match-end 2)))))
1690     )
1691   str
1692   )
1693
1694 (defun gud-read-address ()
1695   "Return a string containing the core-address found in the buffer at point."
1696   (save-excursion
1697     (let ((pt (point)) found begin)
1698       (setq found (if (search-backward "0x" (- pt 7) t) (point)))
1699       (cond
1700        (found (forward-char 2)
1701               (buffer-substring found
1702                                 (progn (re-search-forward "[^0-9a-f]")
1703                                        (forward-char -1)
1704                                        (point))))
1705        (t (setq begin (progn (re-search-backward "[^0-9]")
1706                              (forward-char 1)
1707                              (point)))
1708           (forward-char 1)
1709           (re-search-forward "[^0-9]")
1710           (forward-char -1)
1711           (buffer-substring begin (point)))))))
1712
1713 (defun gud-call (fmt &optional arg)
1714   (let ((msg (gud-format-command fmt arg)))
1715     (message "Command: %s" msg)
1716     (sit-for 0)
1717     (gud-basic-call msg)))
1718
1719 (defun gud-basic-call (command)
1720   "Invoke the debugger COMMAND displaying source in other window."
1721   (interactive)
1722   (gud-set-buffer)
1723   (let ((command (concat command "\n"))
1724         (proc (get-buffer-process gud-comint-buffer)))
1725
1726     ;; Arrange for the current prompt to get deleted.
1727     (save-excursion
1728       (set-buffer gud-comint-buffer)
1729       (goto-char (process-mark proc))
1730       (beginning-of-line)
1731       (if (looking-at comint-prompt-regexp)
1732           (set-marker gud-delete-prompt-marker (point))))
1733     (process-send-string proc command)))
1734
1735 (defun gud-refresh (&optional arg)
1736   "Fix up a possibly garbled display, and redraw the arrow."
1737   (interactive "P")
1738   (recenter arg)
1739   (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
1740   (gud-display-frame))
1741 \f
1742 ;;; Code for parsing expressions out of C code.  The single entry point is
1743 ;;; find-c-expr, which tries to return an lvalue expression from around point.
1744 ;;;
1745 ;;; The rest of this file is a hacked version of gdbsrc.el by
1746 ;;; Debby Ayers <[email protected]>,
1747 ;;; Rich Schaefer <[email protected]> Schlumberger, Austin, Tx.
1748
1749 (defun find-c-expr ()
1750   "Returns the C expr that surrounds point."
1751   (interactive)
1752   (save-excursion
1753     (let ((p) (expr) (test-expr))
1754       (setq p (point))
1755       (setq expr (expr-cur))
1756       (setq test-expr (expr-prev))
1757       (while (expr-compound test-expr expr)
1758         (setq expr (cons (car test-expr) (cdr expr)))
1759         (goto-char (car expr))
1760         (setq test-expr (expr-prev)))
1761       (goto-char p)
1762       (setq test-expr (expr-next))
1763       (while (expr-compound expr test-expr)
1764         (setq expr (cons (car expr) (cdr test-expr)))
1765         (setq test-expr (expr-next))
1766         )
1767       (buffer-substring (car expr) (cdr expr)))))
1768
1769 (defun expr-cur ()
1770   "Returns the expr that point is in; point is set to beginning of expr.
1771 The expr is represented as a cons cell, where the car specifies the point in
1772 the current buffer that marks the beginning of the expr and the cdr specifies
1773 the character after the end of the expr."
1774   (let ((p (point)) (begin) (end))
1775     (expr-backward-sexp)
1776     (setq begin (point))
1777     (expr-forward-sexp)
1778     (setq end (point))
1779     (if (>= p end)
1780         (progn
1781          (setq begin p)
1782          (goto-char p)
1783          (expr-forward-sexp)
1784          (setq end (point))
1785          )
1786       )
1787     (goto-char begin)
1788     (cons begin end)))
1789
1790 (defun expr-backward-sexp ()
1791   "Version of `backward-sexp' that catches errors."
1792   (condition-case nil
1793       (backward-sexp)
1794     (error t)))
1795
1796 (defun expr-forward-sexp ()
1797   "Version of `forward-sexp' that catches errors."
1798   (condition-case nil
1799      (forward-sexp)
1800     (error t)))
1801
1802 (defun expr-prev ()
1803   "Returns the previous expr, point is set to beginning of that expr.
1804 The expr is represented as a cons cell, where the car specifies the point in
1805 the current buffer that marks the beginning of the expr and the cdr specifies
1806 the character after the end of the expr"
1807   (let ((begin) (end))
1808     (expr-backward-sexp)
1809     (setq begin (point))
1810     (expr-forward-sexp)
1811     (setq end (point))
1812     (goto-char begin)
1813     (cons begin end)))
1814
1815 (defun expr-next ()
1816   "Returns the following expr, point is set to beginning of that expr.
1817 The expr is represented as a cons cell, where the car specifies the point in
1818 the current buffer that marks the beginning of the expr and the cdr specifies
1819 the character after the end of the expr."
1820   (let ((begin) (end))
1821     (expr-forward-sexp)
1822     (expr-forward-sexp)
1823     (setq end (point))
1824     (expr-backward-sexp)
1825     (setq begin (point))
1826     (cons begin end)))
1827
1828 (defun expr-compound-sep (span-start span-end)
1829   "Returns '.' for '->' & '.', returns ' ' for white space,
1830 returns '?' for other punctuation."
1831   (let ((result ? )
1832         (syntax))
1833     (while (< span-start span-end)
1834       (setq syntax (char-syntax (char-after span-start)))
1835       (cond
1836        ((= syntax ? ) t)
1837        ((= syntax ?.) (setq syntax (char-after span-start))
1838         (cond
1839          ((= syntax ?.) (setq result ?.))
1840          ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
1841           (setq result ?.)
1842           (setq span-start (+ span-start 1)))
1843          (t (setq span-start span-end)
1844             (setq result ??)))))
1845       (setq span-start (+ span-start 1)))
1846     result))
1847
1848 (defun expr-compound (first second)
1849   "Non-nil if concatenating FIRST and SECOND makes a single C token.
1850 The two exprs are represented as a cons cells, where the car
1851 specifies the point in the current buffer that marks the beginning of the
1852 expr and the cdr specifies the character after the end of the expr.
1853 Link exprs of the form:
1854       Expr -> Expr
1855       Expr . Expr
1856       Expr (Expr)
1857       Expr [Expr]
1858       (Expr) Expr
1859       [Expr] Expr"
1860   (let ((span-start (cdr first))
1861         (span-end (car second))
1862         (syntax))
1863     (setq syntax (expr-compound-sep span-start span-end))
1864     (cond
1865      ((= (car first) (car second)) nil)
1866      ((= (cdr first) (cdr second)) nil)
1867      ((= syntax ?.) t)
1868      ((= syntax ? )
1869          (setq span-start (char-after (- span-start 1)))
1870          (setq span-end (char-after span-end))
1871          (cond
1872           ((= span-start ?) ) t )
1873           ((= span-start ?] ) t )
1874           ((= span-end ?( ) t )
1875           ((= span-end ?[ ) t )
1876           (t nil))
1877          )
1878      (t nil))))
1879
1880 (provide 'gud)
1881
1882 ;;; gud.el ends here