sdcc/debugger/mcs51/sdcdb.el

   1 ;;; sdcdb.el --- run sdcdb under Emacs
   2
   3 ;; Author: W. Schelter, University of Texas
   4 ;;     wfs@rascal.ics.utexas.edu
   5 ;; Rewritten by rms.
   6 ;; Keywords: c, unix, tools, debugging
   7
   8 ;; Some ideas are due to Masanobu.
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; Description of SDCDB interface:
  32
  33 ;; A facility is provided for the simultaneous display of the source code
  34 ;; in one window, while using sdcdb to step through a function in the
  35 ;; other.  A small arrow in the source window, indicates the current
  36 ;; line.
  37
  38 ;; Starting up:
  39
  40 ;; In order to use this facility, invoke the command SDCDB to obtain a
  41 ;; shell window with the appropriate command bindings.  You will be asked
  42 ;; for the name of a file to run.  Sdcdb will be invoked on this file, in a
  43 ;; window named *sdcdb-foo* if the file is foo.
  44
  45 ;; M-s steps by one line, and redisplays the source file and line.
  46
  47 ;; You may easily create additional commands and bindings to interact
  48 ;; with the display.  For example to put the sdcdb command next on \M-n
  49 ;; (def-sdcdb next "\M-n")
  50
  51 ;; This causes the emacs command sdcdb-next to be defined, and runs
  52 ;; sdcdb-display-frame after the command.
  53
  54 ;; sdcdb-display-frame is the basic display function.  It tries to display
  55 ;; in the other window, the file and line corresponding to the current
  56 ;; position in the sdcdb window.  For example after a sdcdb-step, it would
  57 ;; display the line corresponding to the position for the last step.  Or
  58 ;; if you have done a backtrace in the sdcdb buffer, and move the cursor
  59 ;; into one of the frames, it would display the position corresponding to
  60 ;; that frame.
  61
  62 ;; sdcdb-display-frame is invoked automatically when a filename-and-line-number
  63 ;; appears in the output.
  64
  65 ;;; Code:
  66
  67 (require 'comint)
  68 (require 'shell)
  69
  70 (condition-case nil
  71     (if (featurep 'toolbar)
  72         (require 'eos-toolbar "sun-eos-toolbar"))
  73   (error nil))
  74
  75 (defvar sdcdb-last-frame)
  76 (defvar sdcdb-delete-prompt-marker)
  77 (defvar sdcdb-filter-accumulator)
  78 (defvar sdcdb-last-frame-displayed-p)
  79 (defvar sdcdb-arrow-extent nil)
  80 (or (fboundp 'make-glyph) (fset 'make-glyph 'identity)) ; work w/ pre beta v12
  81 (defvar sdcdb-arrow-glyph (make-glyph "=>"))
  82
  83 (make-face 'sdcdb-arrow-face)
  84 (or (face-differs-from-default-p 'sdcdb-arrow-face)
  85    ;; Usually has a better default value than highlight does
  86    (copy-face 'isearch 'sdcdb-arrow-face))
  87
  88 ;; Hooks can side-effect extent arg to change extent properties
  89 (defvar sdcdb-arrow-extent-hooks '())
  90
  91 (defvar sdcdb-prompt-pattern "^>\\|^(.*sdcdb[+]?) *\\|^---Type <return> to.*--- *"
  92   "A regexp to recognize the prompt for sdcdb or sdcdb+.")
  93
  94 (defvar sdcdb-mode-map nil
  95   "Keymap for sdcdb-mode.")
  96
  97 (defvar sdcdb-toolbar nil)
  98
  99 (if sdcdb-mode-map
 100    nil
 101   (setq sdcdb-mode-map (make-sparse-keymap))
 102   (set-keymap-name sdcdb-mode-map 'sdcdb-mode-map)
 103   (set-keymap-parents sdcdb-mode-map (list comint-mode-map))
 104   (define-key sdcdb-mode-map "\C-l" 'sdcdb-refresh)
 105   (define-key sdcdb-mode-map "\C-c\C-c" 'sdcdb-control-c-subjob)
 106   (define-key sdcdb-mode-map "\t" 'comint-dynamic-complete)
 107   (define-key sdcdb-mode-map "\M-?" 'comint-dynamic-list-completions))
 108
 109 (define-key ctl-x-map " " 'sdcdb-break)
 110 (define-key ctl-x-map "&" 'send-sdcdb-command)
 111
 112 ;;Of course you may use `def-sdcdb' with any other sdcdb command, including
 113 ;;user defined ones.
 114
 115 (defmacro def-sdcdb (name key &optional doc &rest forms)
 116   (let* ((fun (intern (format "sdcdb-%s" name)))
 117          (cstr (list 'if '(not (= 1 arg))
 118                      (list 'format "%s %s" name 'arg)
 119                      name)))
 120     (list 'progn
 121           (nconc (list 'defun fun '(arg)
 122                        (or doc "")
 123                        '(interactive "p")
 124                        (list 'sdcdb-call cstr))
 125                  forms)
 126           (and key (list 'define-key 'sdcdb-mode-map key  (list 'quote fun))))))
 127
 128 (def-sdcdb "step"   "\M-s" "Step one source line with display"
 129   (sdcdb-delete-arrow-extent))
 130 (def-sdcdb "stepi"  "\M-i" "Step one instruction with display"
 131   (sdcdb-delete-arrow-extent))
 132 (def-sdcdb "finish" "\C-c\C-f" "Finish executing current function"
 133   (sdcdb-delete-arrow-extent))
 134 (def-sdcdb "run" nil "Run the current program"
 135   (sdcdb-delete-arrow-extent))
 136
 137 ;;"next" and "cont" were bound to M-n and M-c in Emacs 18, but these are
 138 ;;poor choices, since M-n is used for history navigation and M-c is
 139 ;;capitalize-word.  These are defined without key bindings so that users
 140 ;;may choose their own bindings.
 141 (def-sdcdb "next"   "\C-c\C-n" "Step one source line (skip functions)"
 142   (sdcdb-delete-arrow-extent))
 143 (def-sdcdb "cont"   "\C-c\M-c" "Proceed with the program"
 144   (sdcdb-delete-arrow-extent))
 145
 146 (def-sdcdb "up"     "\C-c<" "Go up N stack frames (numeric arg) with display")
 147 (def-sdcdb "down"   "\C-c>" "Go down N stack frames (numeric arg) with display")
 148
 149 (defvar sdcdb-display-mode nil
 150   "Minor mode for sdcdb frame display")
 151 (or (assq 'sdcdb-display-mode minor-mode-alist)
 152     (setq minor-mode-alist
 153           (purecopy
 154            (append minor-mode-alist
 155                    '((sdcdb-display-mode " Frame"))))))
 156 \f
 157 (defun sdcdb-display-mode (&optional arg)
 158   "Toggle SDCDB Frame display mode
 159 With arg, turn display mode on if and only if arg is positive.
 160 In the display minor mode, source file are displayed in another
 161 window for repective \\[sdcdb-display-frame] commands."
 162   (interactive "P")
 163   (setq sdcdb-display-mode (if (null arg)
 164                              (not sdcdb-display-mode)
 165                            (> (prefix-numeric-value arg) 0))))
 166
 167 ;; Using cc-mode's syntax table is broken.
 168 (defvar sdcdb-mode-syntax-table nil
 169   "Syntax table for SDCDB mode.")
 170
 171 ;; This is adapted from CC Mode 5.11.
 172 (unless sdcdb-mode-syntax-table
 173   (setq sdcdb-mode-syntax-table (make-syntax-table))
 174   ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
 175   (modify-syntax-entry ?_  "_" sdcdb-mode-syntax-table)
 176   (modify-syntax-entry ?\\ "\\" sdcdb-mode-syntax-table)
 177   (modify-syntax-entry ?+  "." sdcdb-mode-syntax-table)
 178   (modify-syntax-entry ?-  "." sdcdb-mode-syntax-table)
 179   (modify-syntax-entry ?=  "." sdcdb-mode-syntax-table)
 180   (modify-syntax-entry ?%  "." sdcdb-mode-syntax-table)
 181   (modify-syntax-entry ?<  "." sdcdb-mode-syntax-table)
 182   (modify-syntax-entry ?>  "." sdcdb-mode-syntax-table)
 183   (modify-syntax-entry ?&  "." sdcdb-mode-syntax-table)
 184   (modify-syntax-entry ?|  "." sdcdb-mode-syntax-table)
 185   (modify-syntax-entry ?\' "\"" sdcdb-mode-syntax-table)
 186   ;; add extra comment syntax
 187   (modify-syntax-entry ?/  ". 14"  sdcdb-mode-syntax-table)
 188   (modify-syntax-entry ?*  ". 23"  sdcdb-mode-syntax-table))
 189
 190 \f
 191 (defun sdcdb-mode ()
 192   "Major mode for interacting with an inferior Sdcdb process.
 193 The following commands are available:
 194
 195 \\{sdcdb-mode-map}
 196
 197 \\[sdcdb-display-frame] displays in the other window
 198 the last line referred to in the sdcdb buffer. See also
 199 \\[sdcdb-display-mode].
 200
 201 \\[sdcdb-step],\\[sdcdb-next], and \\[sdcdb-nexti] in the sdcdb window,
 202 call sdcdb to step,next or nexti and then update the other window
 203 with the current file and position.
 204
 205 If you are in a source file, you may select a point to break
 206 at, by doing \\[sdcdb-break].
 207
 208 Commands:
 209 Many commands are inherited from comint mode.
 210 Additionally we have:
 211
 212 \\[sdcdb-display-frame] display frames file in other window
 213 \\[sdcdb-step] advance one line in program
 214 \\[send-sdcdb-command] used for special printing of an arg at the current point.
 215 C-x SPACE sets break point at current line."
 216   (interactive)
 217   (comint-mode)
 218   (use-local-map sdcdb-mode-map)
 219   (set-syntax-table sdcdb-mode-syntax-table)
 220   (make-local-variable 'sdcdb-last-frame-displayed-p)
 221   (make-local-variable 'sdcdb-last-frame)
 222   (make-local-variable 'sdcdb-delete-prompt-marker)
 223   (make-local-variable 'sdcdb-display-mode)
 224   (make-local-variable' sdcdb-filter-accumulator)
 225   (setq sdcdb-last-frame nil
 226         sdcdb-delete-prompt-marker nil
 227         sdcdb-filter-accumulator nil
 228         sdcdb-display-mode t
 229         major-mode 'sdcdb-mode
 230         mode-name "Inferior SDCDB"
 231         comint-prompt-regexp sdcdb-prompt-pattern
 232         sdcdb-last-frame-displayed-p t)
 233   (set (make-local-variable 'shell-dirtrackp) t)
 234   ;;(make-local-variable 'sdcdb-arrow-extent)
 235   (and (extentp sdcdb-arrow-extent)
 236        (delete-extent sdcdb-arrow-extent))
 237   (setq sdcdb-arrow-extent nil)
 238   ;; XEmacs change:
 239   (make-local-hook 'kill-buffer-hook)
 240   (add-hook 'kill-buffer-hook 'sdcdb-delete-arrow-extent nil t)
 241   (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
 242   (run-hooks 'sdcdb-mode-hook))
 243
 244 (defun sdcdb-delete-arrow-extent ()
 245   (let ((inhibit-quit t))
 246     (if sdcdb-arrow-extent
 247         (delete-extent sdcdb-arrow-extent))
 248     (setq sdcdb-arrow-extent nil)))
 249
 250 (defvar current-sdcdb-buffer nil)
 251
 252 ;;;###autoload
 253 (defvar sdcdb-command-name "sdcdb"
 254   "Pathname for executing sdcdb.")
 255
 256 ;;;###autoload
 257 (defun sdcdb (path &optional corefile)
 258   "Run sdcdb on program FILE in buffer *sdcdb-FILE*.
 259 The directory containing FILE becomes the initial working directory
 260 and source-file directory for SDCDB.  If you wish to change this, use
 261 the SDCDB commands `cd DIR' and `directory'."
 262   (interactive "FRun sdcdb on file: ")
 263   (setq path (file-truename (expand-file-name path)))
 264   (let ((file (file-name-nondirectory path)))
 265     (switch-to-buffer (concat "*sdcdb-" file "*"))
 266     (setq default-directory (file-name-directory path))
 267     (or (bolp) (newline))
 268     (insert "Current directory is " default-directory "\n")
 269     (apply 'make-comint
 270            (concat "sdcdb-" file)
 271            (substitute-in-file-name sdcdb-command-name)
 272            nil
 273            "-fullname"
 274            "-cd" default-directory
 275            file
 276            (and corefile (list corefile)))
 277     (set-process-filter (get-buffer-process (current-buffer)) 'sdcdb-filter)
 278     (set-process-sentinel (get-buffer-process (current-buffer)) 'sdcdb-sentinel)
 279     ;; XEmacs change: turn on sdcdb mode after setting up the proc filters
 280     ;; for the benefit of shell-font.el
 281     (sdcdb-mode)
 282     (sdcdb-set-buffer)))
 283
 284 ;;;###autoload
 285 (defun sdcdb-with-core (file corefile)
 286   "Debug a program using a corefile."
 287   (interactive "fProgram to debug: \nfCore file to use: ")
 288   (sdcdb file corefile))
 289
 290 (defun sdcdb-set-buffer ()
 291   (cond ((eq major-mode 'sdcdb-mode)
 292          (setq current-sdcdb-buffer (current-buffer))
 293          (if (featurep 'eos-toolbar)
 294              (set-specifier default-toolbar (cons (current-buffer)
 295                                                   sdcdb-toolbar))))))
 296
 297 \f
 298 ;; This function is responsible for inserting output from SDCDB
 299 ;; into the buffer.
 300 ;; Aside from inserting the text, it notices and deletes
 301 ;; each filename-and-line-number;
 302 ;; that SDCDB prints to identify the selected frame.
 303 ;; It records the filename and line number, and maybe displays that file.
 304 (defun sdcdb-filter (proc string)
 305   (let ((inhibit-quit t))
 306     (save-current-buffer
 307      (set-buffer (process-buffer proc))
 308      (if sdcdb-filter-accumulator
 309          (sdcdb-filter-accumulate-marker
 310           proc (concat sdcdb-filter-accumulator string))
 311        (sdcdb-filter-scan-input proc string)))))
 312
 313 (defun sdcdb-filter-accumulate-marker (proc string)
 314   (setq sdcdb-filter-accumulator nil)
 315   (if (> (length string) 1)
 316       (if (= (aref string 1) ?\032)
 317           (let ((end (string-match "\n" string)))
 318             (if end
 319                 (progn
 320                   (let* ((first-colon (string-match ":" string 2))
 321                          (second-colon
 322                           (string-match ":" string (1+ first-colon))))
 323                     (setq sdcdb-last-frame
 324                           (cons (substring string 2 first-colon)
 325                                 (string-to-int
 326                                  (substring string (1+ first-colon)
 327                                             second-colon)))))
 328                   (setq sdcdb-last-frame-displayed-p nil)
 329                   (sdcdb-filter-scan-input proc
 330                                          (substring string (1+ end))))
 331               (setq sdcdb-filter-accumulator string)))
 332         (sdcdb-filter-insert proc "\032")
 333         (sdcdb-filter-scan-input proc (substring string 1)))
 334     (setq sdcdb-filter-accumulator string)))
 335
 336 (defun sdcdb-filter-scan-input (proc string)
 337   (if (equal string "")
 338       (setq sdcdb-filter-accumulator nil)
 339     (let ((start (string-match "\032" string)))
 340       (if start
 341           (progn (sdcdb-filter-insert proc (substring string 0 start))
 342                  (sdcdb-filter-accumulate-marker proc
 343                                                (substring string start)))
 344         (sdcdb-filter-insert proc string)))))
 345
 346 (defun sdcdb-filter-insert (proc string)
 347   (let ((moving (= (point) (process-mark proc)))
 348         (output-after-point (< (point) (process-mark proc))))
 349     (save-excursion
 350       ;; Insert the text, moving the process-marker.
 351       (goto-char (process-mark proc))
 352       (insert-before-markers string)
 353       (set-marker (process-mark proc) (point))
 354       (sdcdb-maybe-delete-prompt)
 355       ;; Check for a filename-and-line number.
 356       (sdcdb-display-frame
 357        ;; Don't display the specified file
 358        ;; unless (1) point is at or after the position where output appears
 359        ;; and (2) this buffer is on the screen.
 360        (or output-after-point
 361            (not (get-buffer-window (current-buffer))))
 362        ;; Display a file only when a new filename-and-line-number appears.
 363        t))
 364     (if moving (goto-char (process-mark proc))))
 365
 366   (let (s)
 367     (if (and (should-use-dialog-box-p)
 368              (setq s (or (string-match " (y or n) *\\'" string)
 369                          (string-match " (yes or no) *\\'" string))))
 370         (sdcdb-mouse-prompt-hack (substring string 0 s) (current-buffer))))
 371   )
 372
 373 (defun sdcdb-mouse-prompt-hack (prompt buffer)
 374   (popup-dialog-box
 375    (list prompt
 376          (vector "Yes"    (list 'sdcdb-mouse-prompt-hack-answer 't   buffer) t)
 377          (vector "No"     (list 'sdcdb-mouse-prompt-hack-answer 'nil buffer) t)
 378          nil
 379          (vector "Cancel" (list 'sdcdb-mouse-prompt-hack-answer 'nil buffer) t)
 380          )))
 381
 382 (defun sdcdb-mouse-prompt-hack-answer (answer buffer)
 383   (let ((b (current-buffer)))
 384     (unwind-protect
 385         (progn
 386           (set-buffer buffer)
 387           (goto-char (process-mark (get-buffer-process buffer)))
 388           (delete-region (point) (point-max))
 389           (insert (if answer "yes" "no"))
 390           (comint-send-input))
 391       (set-buffer b))))
 392
 393 (defun sdcdb-sentinel (proc msg)
 394   (cond ((null (buffer-name (process-buffer proc)))
 395          ;; buffer killed
 396          ;; Stop displaying an arrow in a source file.
 397          ;(setq overlay-arrow-position nil) -- done by kill-buffer-hook
 398          (set-process-buffer proc nil))
 399         ((memq (process-status proc) '(signal exit))
 400          ;; Stop displaying an arrow in a source file.
 401          (sdcdb-delete-arrow-extent)
 402          ;; Fix the mode line.
 403          (setq modeline-process
 404                (concat ": sdcdb " (symbol-name (process-status proc))))
 405          (let* ((obuf (current-buffer)))
 406            ;; save-excursion isn't the right thing if
 407            ;;  process-buffer is current-buffer
 408            (unwind-protect
 409                (progn
 410                  ;; Write something in *compilation* and hack its mode line,
 411                  (set-buffer (process-buffer proc))
 412                  ;; Force mode line redisplay soon
 413                  (set-buffer-modified-p (buffer-modified-p))
 414                  (if (eobp)
 415                      (insert ?\n mode-name " " msg)
 416                    (save-excursion
 417                      (goto-char (point-max))
 418                      (insert ?\n mode-name " " msg)))
 419                  ;; If buffer and mode line will show that the process
 420                  ;; is dead, we can delete it now.  Otherwise it
 421                  ;; will stay around until M-x list-processes.
 422                  (delete-process proc))
 423              ;; Restore old buffer, but don't restore old point
 424              ;; if obuf is the sdcdb buffer.
 425              (set-buffer obuf))))))
 426
 427
 428 (defun sdcdb-refresh (&optional arg)
 429   "Fix up a possibly garbled display, and redraw the arrow."
 430   (interactive "P")
 431   (recenter arg)
 432   (sdcdb-display-frame))
 433
 434 (defun sdcdb-display-frame (&optional nodisplay noauto)
 435   "Find, obey and delete the last filename-and-line marker from SDCDB.
 436 The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
 437 Obeying it means displaying in another window the specified file and line."
 438   (interactive)
 439   (sdcdb-set-buffer)
 440   (and sdcdb-last-frame (not nodisplay)
 441        sdcdb-display-mode
 442        (or (not sdcdb-last-frame-displayed-p) (not noauto))
 443        (progn (sdcdb-display-line (car sdcdb-last-frame) (cdr sdcdb-last-frame))
 444               (setq sdcdb-last-frame-displayed-p t))))
 445
 446 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
 447 ;; and that its line LINE is visible.
 448 ;; Put the overlay-arrow on the line LINE in that buffer.
 449
 450 (defun sdcdb-display-line (true-file line &optional select-method)
 451   ;; FILE to display
 452   ;; LINE number to highlight and make visible
 453   ;; SELECT-METHOD 'source, 'debugger, or 'none.  (default is 'debugger)
 454   (and (null select-method) (setq select-method 'debugger))
 455   (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
 456          (pop-up-windows t)
 457          (source-buffer (find-file-noselect true-file))
 458          (source-window (display-buffer source-buffer))
 459          (debugger-window (get-buffer-window current-sdcdb-buffer))
 460          (extent sdcdb-arrow-extent)
 461          pos)
 462     ;; XEmacs change: make sure we find a window displaying the source file
 463     ;; even if we are already sitting in it when a breakpoint is hit.
 464     ;; Otherwise the t argument to display-buffer will prevent it from being
 465     ;; displayed.
 466     (save-excursion
 467       (cond ((eq select-method 'debugger)
 468              ;; might not already be displayed
 469              (setq debugger-window (display-buffer current-sdcdb-buffer))
 470              (select-window debugger-window))
 471             ((eq select-method 'source)
 472              (select-window source-window))))
 473     (and extent
 474          (not (eq (extent-object extent) source-buffer))
 475          (setq extent (delete-extent extent)))
 476     (or extent
 477         (progn
 478           (setq extent (make-extent 1 1 source-buffer))
 479           (set-extent-face extent 'sdcdb-arrow-face)
 480           (set-extent-begin-glyph extent sdcdb-arrow-glyph)
 481           (set-extent-begin-glyph-layout extent 'whitespace)
 482           (set-extent-priority extent 2000)
 483           (setq sdcdb-arrow-extent extent)))
 484     (save-current-buffer
 485       (set-buffer source-buffer)
 486       (save-restriction
 487         (widen)
 488         (goto-line line)
 489         (set-window-point source-window (point))
 490         (setq pos (point))
 491         (end-of-line)
 492         (set-extent-endpoints extent pos (point))
 493         (run-hook-with-args 'sdcdb-arrow-extent-hooks extent))
 494       (cond ((or (< pos (point-min)) (> pos (point-max)))
 495              (widen)
 496              (goto-char pos))))
 497     ;; Added by Stig.  It caused lots of problems for several users
 498     ;; and since its purpose is unclear it is getting commented out.
 499     ;;(and debugger-window
 500     ;; (set-window-point debugger-window pos))
 501     ))
 502 \f
 503 (defun sdcdb-call (command)
 504   "Invoke sdcdb COMMAND displaying source in other window."
 505   (interactive)
 506   (goto-char (point-max))
 507   ;; Record info on the last prompt in the buffer and its position.
 508   ;; This is used in  sdcdb-maybe-delete-prompt
 509   ;; to prevent multiple prompts from accumulating.
 510   (save-excursion
 511     (goto-char (process-mark (get-buffer-process current-sdcdb-buffer)))
 512     (let ((pt (point)))
 513       (beginning-of-line)
 514       (setq sdcdb-delete-prompt-marker
 515             (if (= (point) pt)
 516                 nil
 517               (list (point-marker) (- pt (point))
 518                     (buffer-substring (point) pt))))))
 519   (sdcdb-set-buffer)
 520   (process-send-string (get-buffer-process current-sdcdb-buffer)
 521                (concat command "\n")))
 522
 523 (defun sdcdb-maybe-delete-prompt ()
 524   (if sdcdb-delete-prompt-marker
 525       ;; Get the string that we used as the prompt before.
 526       (let ((prompt (nth 2 sdcdb-delete-prompt-marker))
 527             (length (nth 1 sdcdb-delete-prompt-marker)))
 528         ;; Position after it.
 529         (goto-char (+ (car sdcdb-delete-prompt-marker) length))
 530         ;; Delete any duplicates of it which follow right after.
 531         (while (and (<= (+ (point) length) (point-max))
 532                     (string= prompt
 533                              (buffer-substring (point) (+ (point) length))))
 534           (delete-region (point) (+ (point) length)))
 535         ;; If that didn't take us to where output is arriving,
 536         ;; we have encountered something other than a prompt,
 537         ;; so stop trying to delete any more prompts.
 538         (if (not (= (point)
 539                     (process-mark (get-buffer-process current-sdcdb-buffer))))
 540             (progn
 541               (set-marker (car sdcdb-delete-prompt-marker) nil)
 542               (setq sdcdb-delete-prompt-marker nil))))))
 543
 544 (defun sdcdb-break (temp)
 545   "Set SDCDB breakpoint at this source line.  With ARG set temporary breakpoint."
 546   (interactive "P")
 547   (let* ((file-name (file-name-nondirectory buffer-file-name))
 548          (line (save-restriction
 549                  (widen)
 550                  (beginning-of-line)
 551                  (1+ (count-lines 1 (point)))))
 552          (cmd (concat (if temp "tbreak " "break ") file-name ":"
 553                       (int-to-string line))))
 554     (set-buffer current-sdcdb-buffer)
 555     (goto-char (process-mark (get-buffer-process current-sdcdb-buffer)))
 556     (delete-region (point) (point-max))
 557     (insert cmd)
 558     (comint-send-input)
 559     ;;(process-send-string (get-buffer-process current-sdcdb-buffer) cmd)
 560     ))
 561
 562 (defun sdcdb-clear ()
 563   "Set SDCDB breakpoint at this source line."
 564   (interactive)
 565   (let* ((file-name (file-name-nondirectory buffer-file-name))
 566          (line (save-restriction
 567                  (widen)
 568                  (beginning-of-line)
 569                  (1+ (count-lines 1 (point)))))
 570          (cmd (concat "clear " file-name ":"
 571                       (int-to-string line))))
 572     (set-buffer current-sdcdb-buffer)
 573     (goto-char (process-mark (get-buffer-process current-sdcdb-buffer)))
 574     (delete-region (point) (point-max))
 575     (insert cmd)
 576     (comint-send-input)
 577     ;;(process-send-string (get-buffer-process current-sdcdb-buffer) cmd)
 578     ))
 579
 580 (defun sdcdb-read-address()
 581   "Return a string containing the core-address found in the buffer at point."
 582   (save-excursion
 583    (let ((pt (point)) found begin)
 584      (setq found (if (search-backward "0x" (- pt 7) t)(point)))
 585      (cond (found (forward-char 2)
 586                   (buffer-substring found
 587                                     (progn (re-search-forward "[^0-9a-f]")
 588                                            (forward-char -1)
 589                                            (point))))
 590            (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
 591                                  (point)))
 592               (forward-char 1)
 593               (re-search-forward "[^0-9]")
 594               (forward-char -1)
 595               (buffer-substring begin (point)))))))
 596
 597
 598 (defvar sdcdb-commands nil
 599   "List of strings or functions used by send-sdcdb-command.
 600 It is for customization by you.")
 601
 602 (defun send-sdcdb-command (arg)
 603
 604   "This command reads the number where the cursor is positioned.  It
 605  then inserts this ADDR at the end of the sdcdb buffer.  A numeric arg
 606  selects the ARG'th member COMMAND of the list sdcdb-print-command.  If
 607  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
 608  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
 609  is a possible string to be a member of sdcdb-commands.  "
 610
 611
 612   (interactive "P")
 613   (let (comm addr)
 614     (if arg (setq comm (nth arg sdcdb-commands)))
 615     (setq addr (sdcdb-read-address))
 616     (if (eq (current-buffer) current-sdcdb-buffer)
 617         (set-mark (point)))
 618     (cond (comm
 619            (setq comm
 620                  (if (stringp comm) (format comm addr) (funcall comm addr))))
 621           (t (setq comm addr)))
 622     (switch-to-buffer current-sdcdb-buffer)
 623     (goto-char (point-max))
 624     (insert comm)))
 625
 626 (fset 'sdcdb-control-c-subjob 'comint-interrupt-subjob)
 627
 628 ;(defun sdcdb-control-c-subjob ()
 629 ;  "Send a Control-C to the subprocess."
 630 ;  (interactive)
 631 ;  (process-send-string (get-buffer-process (current-buffer))
 632 ;                      "\C-c"))
 633
 634 (defun sdcdb-toolbar-break ()
 635   (interactive)
 636   (save-excursion
 637     (message (car sdcdb-last-frame))
 638     (set-buffer (find-file-noselect (car sdcdb-last-frame)))
 639     (sdcdb-break nil)))
 640
 641 (defun sdcdb-toolbar-clear ()
 642   (interactive)
 643   (save-excursion
 644     (message (car sdcdb-last-frame))
 645     (set-buffer (find-file-noselect (car sdcdb-last-frame)))
 646     (sdcdb-clear)))
 647
 648 (provide 'sdcdb)
 649
 650 ;;; sdcdb.el ends here