|
0
|
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
|
