Mercurial > hg > xemacs-beta

comparison lisp/eos/sun-eos-debugger-extra.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
2
3 ;; Copyright (C) Sun Microsystems, Inc.
4
5 ;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
6 ;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
7
8 ;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx
9
10 ;;; Commentary:
11 ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
12
13 ;;; Code:
14
15 ;; debugger buffer
16
17 (require 'eos-common "sun-eos-common")
18 (require 'eos-debugger "sun-eos-debugger")
19 (require 'eos-menubar "sun-eos-menubar")
20
21 (defvar eos::debugger-buffer "*Eos Debugger Log*"
22 "name of buffer where to log debugger activity; see eos::use-debugger-buffer")
23 (defvar eos::dbx-buffer nil)
24 (defvar eos::key-mode 'none "Style of key mode interaction for Eos")
25
26 (defun eos::ensure-debugger-buffer ()
27 ;; will ensure a debugger buffer, with the proper major mode
28 (let ((buf (get-buffer eos::debugger-buffer)))
29 (if buf
30 (switch-to-buffer buf)
31 (setq buf (get-buffer-create eos::debugger-buffer))
32 (set-buffer buf)
33 (eos::debugger-mode)
34 (toggle-read-only -1) ; writeable
35 (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold))
36 (toggle-read-only 1) ; read-only
37 )))
38
39 (defun eos::synchronize-debugger-buffer ()
40 ;; ensure all views of this buffer are at the end
41 (eos::ensure-debugger-buffer)
42 (let ((x (point-max)))
43 (goto-char x)
44 (mapcar (function
45 (lambda (win)
46 (set-window-point win x)))
47 (get-buffer-window-list eos::debugger-buffer))
48 ))
49
50 (defvar eos::debugger-mode-map nil)
51
52 (if eos::debugger-mode-map
53 nil
54 (progn
55 (setq eos::debugger-mode-map (make-keymap))
56 (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map)
57 (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd)
58 (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd)
59 (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd)
60 ))
61
62 (defun eos::debugger-mode ()
63 (interactive)
64 "local mode"
65 (kill-all-local-variables)
66 (setq major-mode 'eos::debugger-mode)
67 (setq mode-name "eos::debugger")
68 (setq truncate-lines t)
69 (set-syntax-table emacs-lisp-mode-syntax-table)
70 (use-local-map eos::debugger-mode-map))
71
72
73 ;; Handling of command lists
74
75 (defvar eos::current-command nil "Current command navigated; as an extent")
76 (defvar eos::last-command nil "last command sent to debugger, as an extent")
77
78 (defun eos::debugger-previous-cmd ()
79 ;; present the previous command
80 (interactive)
81 (save-excursion
82 (let ((xt nil))
83 (if (null eos::current-command)
84 (setq xt eos::last-command)
85 (setq xt (extent-property
86 eos::current-command
87 'previous-command)))
88 (if xt
89 (progn
90 (eos::debugger-delete-last-cmd-line)
91 (goto-char (point-max))
92 (insert (buffer-substring
93 (extent-start-position xt)
94 (1- (extent-end-position xt)) ; remove <CR>
95 ))
96 (setq eos::current-command xt))
97 (error "no previous command")
98 ))
99 ))
100
101 (defun eos::debugger-next-cmd ()
102 ;; present the next command
103 (interactive)
104 (save-excursion
105 (let ((xt nil))
106 (if (null eos::current-command)
107 (error "no next command")
108 (setq xt (extent-property
109 eos::current-command
110 'next-command)))
111 (eos::debugger-delete-last-cmd-line)
112 (if xt
113 (progn
114 (goto-char (point-max))
115 (insert (buffer-substring
116 (extent-start-position xt)
117 (1- (extent-end-position xt)) ; remove <CR>
118 ))
119 (setq eos::current-command xt))
120 (setq eos::current-command nil)
121 ))
122 ))
123
124 (defun eos::debugger-delete-last-cmd-line ()
125 ;; delete the last command line, not yet inputed, returns that cmd line
126 (goto-char (point-max))
127 (let ((e (point)))
128 (beginning-of-line)
129 (let* ((xt (extent-at (point)))
130 (p (extent-end-position xt))
131 (str (buffer-substring p e))
132 )
133 (delete-region p e)
134 str
135 )))
136
137 (defun eos::debugger-send-cmd ()
138 ;; send the message in the current line
139 (interactive)
140 (end-of-line)
141 (let ((e (point)))
142 (beginning-of-line)
143 (let* ((xt (extent-at (point)))
144 (p (extent-end-position xt))
145 (str (buffer-substring p e))
146 )
147 (delete-region p e)
148 (eos::send-spider-current-do-msg (concat str "\n"))
149 (goto-char (point-max))
150 (setq eos::current-command nil)
151 )))
152
153 ;; client
154 ;;
155
156 (defun get-buffer-window-list (buffer)
157 ;; like get-buffer-window except that will generate a list of windows
158 ;; instead of just the first one"
159 (let* ((buf (get-buffer buffer))
160 (win1 (next-window nil 'foo t t))
161 (win win1)
162 (first t)
163 (ret nil)
164 )
165 (if (null buf)
166 nil
167 (while (or
168 (and first win)
169 (not (or first (equal win win1)))
170 )
171 (setq first nil)
172 (if (equal
173 buf
174 (window-buffer win))
175 (setq ret (cons win ret)))
176 (setq win (next-window win t t t))
177 )
178 ret)))
179
180 (defun eos::dbx-process ()
181 ;; Returns nil, or the corresponding process where to insert
182 (let ((pl (process-list))
183 (found-proc nil)
184 )
185 (while (and pl (null found-proc))
186 (let* ((proc (car pl))
187 (name (process-name proc))
188 )
189 (if (and (>= (length name) 3)
190 (equal (substring name 0 3) "Eos"))
191 (setq found-proc proc)
192 (setq pl (cdr pl))
193 )
194 ))
195 found-proc
196 ))
197
198 (defun eos::insert-echo (process string)
199 (if (null process)
200 nil
201 (save-excursion
202 (set-buffer (process-buffer process))
203 (goto-char (point-max))
204 ;; (let ((beg (point)))
205 ;; (insert-before-markers string))
206 (insert-before-markers string)
207 (if (process-mark process)
208 (set-marker (process-mark process) (point-max))))
209 (if (eq (process-buffer process)
210 (current-buffer))
211 (goto-char (point-max)))
212 ))
213
214
215 (defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command)
216 ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE.
217 ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one
218 ;; using 'previous-command and 'next-command properties
219 (save-window-excursion
220 (let ((fr (selected-frame))
221 (buf (current-buffer))
222 (xt nil))
223 (eos::ensure-debugger-buffer)
224 (toggle-read-only -1) ; not read-only
225 (eos::insert-echo (eos::dbx-process) msg)
226 (setq xt (eos::insert-string-as-extent msg rdonly face))
227 (if previous-command
228 (progn
229 (set-extent-property xt 'previous-command previous-command)
230 (set-extent-property previous-command 'next-command xt)
231 ))
232 (toggle-read-only 1) ; now read-only
233 (switch-to-buffer buf)
234 (select-frame fr)
235 xt
236 ))
237 )
238
239 (defun eos::insert-string-as-extent (msg rdonly face)
240 ;; insert MSG as a extent with RDONLY and FACE. Returns the extent
241 (let ((here nil)
242 (xt nil))
243 (goto-char (point-max))
244 (setq here (point))
245 (insert msg)
246 (setq xt (make-extent here (point) nil))
247 (if rdonly
248 (progn
249 (set-extent-property xt 'read-only t)
250 (set-extent-property xt 'duplicable nil)
251 ))
252 (set-extent-face xt face)
253 (eos::synchronize-debugger-buffer)
254 xt
255 ))
256
257
258 (require 'comint)
259
260 (defvar eos::dbx-program "dbx")
261 (defvar eos::dbx-switches (list "-editor"))
262
263 (defun eos::expand-file-name (file)
264 ;; expand file name depending on first character
265 (cond
266 ((null file)
267 nil)
268 ((eq (elt file 0) ?~)
269 (expand-file-name file))
270 ((eq (elt file 0) ?$)
271 (substitute-in-file-name file))
272 (t file)))
273
274 (defun eos::read-dbx-request (program switches)
275 ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this
276 ;; and then will read the result and split it into program and switches.
277 (let* ((prompt
278 (concat program " " (mapconcat 'identity switches " ")))
279 (ret (read-from-minibuffer "Run dbx as: " prompt))
280 (ret2 (split-string ret " ")))
281 ;; some testing
282 (cons (car ret2) (cdr ret2))
283 ))
284
285 (defun eos::dbx ()
286 ;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*.
287 ;; If buffer exists but dbx process is not running, make new dbx.
288 ;; If buffer exists and dbx process is running,
289 ;; just switch to buffer `*Eos Dbx*'.
290 (let ((buffer "*Eos Dbx*")
291 (buffer-name "Eos Dbx")
292 (input nil))
293 (cond ((not (comint-check-proc buffer))
294 (setq input (eos::read-dbx-request eos::dbx-program
295 eos::dbx-switches))
296 (setq eos::dbx-program (car input))
297 (setq eos::dbx-switches (cdr input))
298 (message "Starting Dbx subprocess")
299 (setq buffer
300 (set-buffer
301 (apply 'make-comint
302 buffer-name
303 (eos::expand-file-name eos::dbx-program)
304 nil
305 (mapcar 'eos::expand-file-name eos::dbx-switches))))
306 (comint-mode)
307 (if (and (eq (device-type (frame-device (selected-frame))) 'tty)
308 (eq eos::key-mode 'none)
309 (yes-or-no-p
310 "Do you want the prefix map activated?"))
311 (eos::set-key-mode 'prefix))
312 (setq eos::dbx-or-debugger 'dbx)
313 (setq eos::dbx-buffer (current-buffer))
314 (make-local-variable 'kill-buffer-hook)
315 (setq kill-buffer-hook
316 (list (function (lambda ()
317 (cond
318 ((null (eos::dbx-process)) t)
319 ((not (eq (process-status (eos::dbx-process)) 'run)) t)
320 ((yes-or-no-p
321 "Warning! Killing this buffer will kill a dbx process, proceed? ")
322 (eos::internal-clear-annotations t t t t))
323 (t (error "kill-buffer aborted!")))
324 ))))
325 )
326 (t
327 (message "Reusing existing dbx buffer and dbx process")))
328 (switch-to-buffer buffer)
329 ))
330
331
332 ;; Actions to start a debugger in the background.
333
334 (defvar eos::debugger-process nil
335 "Debugger process for the background. Only one per XEmacs")
336
337 (defvar eos::dbx-or-debugger nil)
338
339 (defun eos::start-debugger ()
340 "Start an \"debugger -editor\" in the background. Will ask for confirmation if
341 XEmacs somehow believes there is already one running"
342 (interactive)
343 (if (and (or (not (processp eos::debugger-process))
344 (not (eq (process-status eos::debugger-process) 'run))
345 (yes-or-no-p
346 "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
347 (or (not (eos::dbx-process))
348 (not (eq (process-status (eos::dbx-process)) 'run))
349 (yes-or-no-p
350 "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
351 (progn
352 (setq eos::debugger-process
353 (start-process "*eos debugger*" nil "debugger" "-editor"))
354 (message "Starting Debugger subprocess")
355 (eos::select-debugger-frame (selected-frame))
356 (setq eos::dbx-or-debugger 'debugger)
357 )))
358
359 ;; Ditto for dbx.
360
361 (defun eos::start-dbx ()
362 "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if
363 XEmacs somehow believes there is already one running"
364 (interactive)
365 (if (and (or (not (processp eos::debugger-process))
366 (not (eq (process-status eos::debugger-process) 'run))
367 (yes-or-no-p
368 "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
369 (or (not (eos::dbx-process))
370 (not (eq (process-status (eos::dbx-process)) 'run))
371 (yes-or-no-p
372 "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
373 (progn
374 (eos::select-debugger-frame (selected-frame))
375 (eos::dbx)
376 )))
377
378
379 ;;
380 ;; Communication commands
381 ;;
382
383 (defun eos::spider-do-callback (msg pat)
384 ;; Callback after processing a spider_do request
385 (eos::insert-on-debugger-buffer
386 (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2))
387 t
388 (get-face 'bold))
389 (destroy-tooltalk-message msg)
390 )
391
392 (defvar eos::last-command-was-print nil "(eos:: internal)")
393
394 (defun eos::spro_spider_output (msg pat)
395 ;; For spider output
396 (let ((s (get-tooltalk-message-attribute msg 'arg_val 1))
397 (err (get-tooltalk-message-attribute msg 'arg_val 2))
398 )
399 (message (format "%s" s))
400 (eos::insert-on-debugger-buffer (format "%s" s)
401 t
402 (get-face 'default))
403 (if (and err (not (string-equal err "")))
404 (eos::insert-on-debugger-buffer
405 (insert (format "STDERR> %s" err))
406 t
407 (get-face 'default))
408 )
409 (destroy-tooltalk-message msg)))
410
411 (defun eos::spro_spider_output-common (msg pat)
412 ;; For spider output
413 (if eos::last-command-was-print
414 (eos::spro_spider_print_output msg pat)
415 (eos::spro_spider_output msg pat)))
416
417 (defmacro eos::spider-tt-args (cmd spider-id clique-id)
418 (` (list
419 'class TT_REQUEST
420 'address TT_HANDLER
421 'scope TT_SESSION
422 'handler (, spider-id)
423 'op "SPRO_SPIDER_DO"
424 'callback 'eos::spider-do-callback
425 'args (list
426 (list 'TT_IN (, clique-id) "Context_ID")
427 (list 'TT_IN (, cmd) "string")
428 (list 'TT_OUT))
429 )))
430
431 (defun eos::send-spider-do-msg (cmd spider-id clique-id)
432 ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID
433 (let ((msg (make-tooltalk-message
434 (eos::spider-tt-args cmd spider-id clique-id))))
435 (setq eos::last-command
436 (eos::insert-on-debugger-buffer
437 cmd
438 t
439 (get-face 'italic)
440 eos::last-command))
441 (setq eos::current-command eos::last-command)
442 (send-tooltalk-message msg)
443 (destroy-tooltalk-message msg)
444 ))
445
446 (defvar eos::no-connection-box
447 '("XEmacs does not know the ID of a debugger to connect to.
448 You may need to reissue a debug or attach command from the debugger.
449 Consult the introduction to Eos (Help->SPARCworks...) for more details."
450 ["Dismiss" (message "Command aborted") t]))
451
452 (defun eos::send-spider-current-do-msg (cmd)
453 ;; Send CMD to the current dbx engine using the current debugger clique;
454 ;;The cmd ends in a new-line.
455 (if (null eos::current-debugger-clique-id)
456 (popup-dialog-box eos::no-connection-box)
457 (eos::send-spider-do-msg cmd
458 eos::current-dbx-proc-id
459 eos::current-debugger-clique-id)))
460
461 (defun eos::dbx-cmd (arg)
462 "Send CMD to the current dbx engine using the current debugger clique;
463 The cmd does not end in a new-line; a new-line will be added"
464 (interactive "sDbx cmd: ")
465 (eos::send-spider-current-do-msg (concat arg "\n")))
466
467
468 ;;
469 ;; Extra patterns
470
471 (defvar eos::dbx-extra-pattern-list nil)
472
473 (defun eos::debugger-extra-startup ()
474 ;; Actions to do at startup for eos-debugger-extra.el
475 (setq eos::dbx-extra-pattern-list ; list of extra TT patterns
476 (eos::create-debugger-extra-patterns))
477 (eos::ensure-available-print-frame)
478 (eos::define-prefix-map) ; initialize keymap
479 )
480
481 (defun eos::create-debugger-extra-patterns ()
482 ;; returns a list of patterns
483 (list
484 (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common)
485 ))
486
487 (defun eos::register-debugger-extra-patterns ()
488 ;; register additional dbx patterns
489 (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list))
490
491 (defun eos::unregister-debugger-extra-patterns ()
492 ;; unregister additional dbx patterns
493 (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list))
494
495 ;;
496 ;; Common commands
497 ;;
498
499
500 (defun eos::type () (interactive)
501 (if (eq eos::dbx-or-debugger 'debugger)
502 (call-interactively 'eos::dbx-cmd)
503 (if (buffer-live-p eos::dbx-buffer)
504 (switch-to-buffer eos::dbx-buffer)
505 (message "no dbx subprocess buffer known"))))
506
507 (defun eos::run () (interactive) (eos::dbx-cmd "run"))
508 (defun eos::fix () (interactive) (eos::dbx-cmd "fix"))
509 (defun eos::build () (interactive) (eos::dbx-cmd "make"))
510
511 (defun eos::cont () (interactive) (eos::dbx-cmd "cont"))
512 (defun eos::cont-and-dismiss () (interactive)
513 (eos::dismiss-print-frame) (eos::cont))
514 (defun eos::clear-all () (interactive) (eos::dbx-cmd "clear"))
515 (defun eos::next () (interactive) (eos::dbx-cmd "next"))
516 (defun eos::next-and-dismiss () (interactive)
517 (eos::dismiss-print-frame) (eos::next))
518 (defun eos::step () (interactive) (eos::dbx-cmd "step"))
519 (defun eos::step-and-dismiss () (interactive)
520 (eos::dismiss-print-frame) (eos::step))
521 (defun eos::step-up () (interactive) (eos::dbx-cmd "step up"))
522
523 (defun eos::up () (interactive) (eos::dbx-cmd "up" ))
524 (defun eos::down () (interactive) (eos::dbx-cmd "down"))
525 (defun eos::pop () (interactive) (eos::dbx-cmd "pop"))
526
527
528 (defun eos::stop-at ()
529 (interactive)
530 (let ((name (buffer-file-name)))
531 (if (null name) (error "Buffer has no associated file"))
532 (eos::dbx-cmd
533 (format "stop at \"%s\":%d" name (eos::line-at (point))))
534 ))
535
536 (defun eos::clear-at ()
537 (interactive)
538 (let ((name (buffer-file-name)))
539 (if (null name) (error "Buffer has no associated file"))
540 (eos::dbx-cmd
541 (format "clear \"%s\":%d" name (eos::line-at (point))))
542 ))
543
544 (defun eos::stop-in ()
545 (interactive)
546 (eos::dbx-cmd
547 (format "stop in %s"
548 (if (eq 'x (device-type (selected-device)))
549 (x-get-selection)
550 (buffer-substring (point) (mark)))
551 ))
552 (setq zmacs-region-stays t))
553
554 (defun eos::func ()
555 (interactive)
556 (eos::dbx-cmd
557 (format "func %s"
558 (if (eq 'x (device-type (selected-device)))
559 (x-get-selection)
560 (buffer-substring (point) (mark)))
561 ))
562 (setq zmacs-region-stays t))
563
564 (defun eos::cont-to ()
565 (interactive)
566 (let ((name (buffer-file-name)))
567 (if (null name) (error "Buffer has no associated file"))
568 (eos::dbx-cmd
569 (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point))))
570 ))
571
572 (defun eos::print-normal ()
573 (interactive)
574 (eos::dbx-cmd
575 (format "print %s"
576 (if (eq 'x (device-type (selected-device)))
577 (x-get-selection)
578 (buffer-substring (point) (mark)))
579 ))
580 (setq zmacs-region-stays t))
581
582 (defun eos::print*-normal ()
583 (interactive)
584 (eos::dbx-cmd
585 (format "print *(%s)"
586 (if (eq 'x (device-type (selected-device)))
587 (x-get-selection)
588 (buffer-substring (point) (mark)))
589 ))
590 (setq zmacs-region-stays t))
591
592 ;; specialization for print commands
593
594 (defun eos::send-spider-print-msg (expr)
595 ;; Print EXPR using separate frame
596 (setq eos::last-command-was-print t)
597 (eos::dbx-cmd (format "print %s" expr)))
598
599 (defun eos::send-spider-print*-msg (expr)
600 ;; Send *EXPR using separate frame
601 (setq eos::last-command-was-print t)
602 (eos::dbx-cmd (format "print *(%s)" expr)))
603
604 (defun eos::print () (interactive)
605 (eos::send-spider-print-msg
606 (if (eq 'x (device-type (selected-device)))
607 (x-get-selection)
608 (buffer-substring (point) (mark)))
609 )
610 (setq zmacs-region-stays t))
611
612 (defun eos::print* () (interactive)
613 (eos::send-spider-print*-msg
614 (if (eq 'x (device-type (selected-device)))
615 (x-get-selection)
616 (buffer-substring (point) (mark)))
617 )
618 (setq zmacs-region-stays t))
619
620
621 ;;
622 ;;
623 ;; Print on separate frame
624
625
626 (defun eos::buffer-line-size (buffer)
627 (interactive)
628 (or (bufferp buffer)
629 (setq buffer (current-buffer)))
630 (save-excursion
631 (switch-to-buffer buffer)
632 (eos::line-at (point-max))))
633
634 ;;
635 ;; Handling of a collection of print frames
636 ;; (currently only one)
637
638 (defvar eos::print-frame nil "Frame for prints")
639 (defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints")
640
641 (defun eos::new-available-print-frame()
642 ;; returns an available print frame
643 ;; currently just returns the one frame
644 (require 'eos-toolbar "sun-eos-toolbar")
645 (let ((scr (selected-frame))
646 (buf (current-buffer)))
647
648 ;; create frames
649 (if (and
650 (frame-live-p eos::print-frame)
651 (or (not (frame-live-p eos::debugger-frame))
652 (not (eq eos::print-frame
653 eos::debugger-frame))))
654 (progn
655 (make-frame-visible eos::print-frame)
656 eos::print-frame)
657 (setq eos::print-frame (make-frame))
658 ;; no modeline visible...
659 (set-face-background 'modeline
660 (face-background (get-face 'default))
661 eos::print-frame)
662 (set-face-foreground 'modeline
663 (face-background (get-face 'default))
664 eos::print-frame)
665 ;; there is redundancy below.
666 (select-frame eos::print-frame)
667 (switch-to-buffer eos::print-buffer)
668 (set-buffer-menubar nil)
669 (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame))
670 (add-spec-to-specifier has-modeline-p nil (selected-frame))
671 (select-frame scr)
672 (switch-to-buffer buf)
673 eos::print-frame
674 )))
675
676 ;; set delete-frame-hook and check for this frame... then do
677
678
679
680 (defun eos::ensure-available-print-frame ()
681 ;; ensures that there is at least one available print frame
682 t)
683
684 (defun eos::show-print-frame ()
685 (interactive)
686 (setq eos::print-frame (eos::new-available-print-frame))
687 (select-frame eos::print-frame)
688 (switch-to-buffer eos::print-buffer)
689 (set-frame-height eos::print-frame
690 (+ 1 (eos::buffer-line-size eos::print-buffer)))
691 (goto-char (point-min))
692 )
693
694 (defun eos::dismiss-print-frame ()
695 (interactive)
696 (if (frame-live-p eos::print-frame)
697 (progn
698 (make-frame-invisible eos::print-frame)
699 (select-frame (car (visible-frame-list))))))
700 ;;
701 ;; print output
702 ;;
703
704 (defun eos::spro_spider_print_output (msg pat)
705 ;; For spider print output (switched with spro_spider_output
706 (let ((buf (current-buffer))
707 (scr (selected-frame)))
708 (save-excursion ; does not work in callbacks?
709 (switch-to-buffer eos::print-buffer)
710 (delete-region (point-min) (point-max))
711 (goto-char (point-max))
712 (insert (format "%s" (get-tooltalk-message-attribute msg
713 'arg_val 1)))
714 (let ((err (get-tooltalk-message-attribute msg
715 'arg_val 2)))
716 (if (and err (not (string-equal err "")))
717 (insert (format "STDERR> %s" err))))
718 (eos::show-print-frame)
719 (select-frame scr)
720 (switch-to-buffer buf)
721 )
722 (destroy-tooltalk-message msg)
723 (setq eos::last-command-was-print nil)
724 ))
725
726
727 ;; User interface
728
729 (defvar eos::prefix-map (make-keymap))
730
731 (defun eos::define-prefix-map ()
732
733 (define-key eos::prefix-map "%" 'eos::dbx-cmd)
734 (define-key eos::prefix-map "r" 'eos::run)
735 (define-key eos::prefix-map "f" 'eos::fix)
736
737 (define-key eos::prefix-map "p" 'eos::print)
738 (define-key eos::prefix-map "\C-p" 'eos::print*)
739
740 (define-key eos::prefix-map "c" 'eos::cont)
741 (define-key eos::prefix-map "b" 'eos::stop-at)
742 (define-key eos::prefix-map "\C-b" 'eos::clear-at)
743
744 (define-key eos::prefix-map "n" 'eos::next)
745 (define-key eos::prefix-map "s" 'eos::step)
746 (define-key eos::prefix-map "\C-s" 'eos::step-up)
747
748 (define-key eos::prefix-map "u" 'eos::up)
749 (define-key eos::prefix-map "d" 'eos::down)
750
751 )
752
753 (defun eos::set-key-mode (mode)
754 ;; Set the key MODE to either 'none, 'prefix, or 'function
755 (setq eos::key-mode mode)
756 (cond
757 ((eq eos::key-mode 'none)
758 (define-key global-map "\C-cd" nil)
759 (eos::remove-function-keys)
760 (add-submenu nil (append '("SPARCworks") eos::short-menu))
761 )
762 ((eq eos::key-mode 'prefix)
763 (define-key global-map "\C-cd" eos::prefix-map)
764 (eos::remove-function-keys)
765 (add-submenu nil (append '("SPARCworks") eos::long-menu))
766 )
767 ((eq eos::key-mode 'function)
768 (define-key global-map "\C-cd" nil)
769 (eos::add-function-keys)
770 (add-submenu nil (append '("SPARCworks") eos::long-menu))
771 )
772 (t
773 (error "unimplemented")
774 )))
775
776 (defun eos::add-function-keys ()
777 (interactive)
778
779 ;;
780 (global-set-key [f6] 'eos::dbx-cmd)
781 (global-set-key [(control f6)] 'eos::run)
782 (global-set-key [(shift f6)] 'eos::fix)
783 ;;
784 (global-set-key [f7] 'eos::print)
785 (global-set-key [(control f7)] 'eos::print*)
786 (global-set-key [(shift f7)] 'eos::dismiss-print-frame)
787 ;;
788 (global-set-key [f8] 'eos::cont)
789 (global-set-key [(control f8)] 'eos::stop-at)
790 (global-set-key [(shift f8)] 'eos::clear-at)
791 ;;
792 (global-set-key [f9] 'eos::next)
793 (global-set-key [(control f9)] 'eos::step)
794 (global-set-key [(shift f9)] 'eos::step-up)
795 ;;
796 )
797
798 (defun eos::remove-function-keys ()
799 (interactive)
800
801 ;;
802 (global-set-key [f6] nil)
803 (global-set-key [(control f6)] nil)
804 (global-set-key [(shift f6)] nil)
805 ;;
806 (global-set-key [f7] nil)
807 (global-set-key [(control f7)] nil)
808 (global-set-key [(shift f7)] nil)
809 ;;
810 (global-set-key [f8] nil)
811 (global-set-key [(control f8)] nil)
812 (global-set-key [(shift f8)] nil)
813 ;;
814 (global-set-key [f9] nil)
815 (global-set-key [(control f9)] nil)
816 (global-set-key [(shift f9)] nil)
817 ;;
818 )
819
820 ;; Provides popup access
821
822 (defvar eos::popup-mode nil)
823 (defvar eos::saved-global-popup-menu nil)
824
825 (defun eos::toggle-popup-menu ()
826 ;; Toggle whether to use or not popup menus for SPARCworks
827 (interactive)
828 (if eos::popup-mode
829 (setq global-popup-menu eos::saved-global-popup-menu)
830 (eos::push-popup-menu))
831 (setq eos::popup-mode (null eos::popup-mode))
832 )
833
834 (defun eos::push-popup-menu ()
835 (setq eos::saved-global-popup-menu global-popup-menu)
836 (setq global-popup-menu
837 (append
838 '("SPARCworks Command"
839 ["Stop At" eos::stop-at t]
840 ["Clear At" eos::clear-at t]
841 ["Stop In" eos::stop-in t]
842 ["Cont To" eos::cont-to t]
843 ["Print" eos::print t]
844 ["Print*" eos::print* t]
845 "---"
846 ["Read a Dbx Command" eos::dbx-cmd t]
847 "---")
848 (list
849 eos::saved-global-popup-menu))
850 ))
851
852 (provide 'eos-debugger)
853
854 ;;; sun-eos-debugger.el ends here