|
0
|
1 ;; Copyright (C) 1995, Sun Microsystems
|
|
|
2 ;;
|
|
|
3 ;; Light Weight Editor Integration for Sparcworks.
|
|
|
4 ;; "Era on Sparcworks" (EOS)
|
|
|
5 ;;
|
|
|
6 ;; Author: Eduardo Pelegri-Llopart
|
|
|
7 ;;
|
|
|
8 ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
|
|
|
9
|
|
|
10 ;; Common routines for EOS
|
|
|
11
|
|
|
12 (defvar eos::version "1.5.2"
|
|
|
13 "Version of Eos")
|
|
|
14
|
|
|
15 (defvar eos::left-margin-width 5
|
|
|
16 "size of left margin")
|
|
|
17
|
|
|
18 (defvar eos::stop-color "red"
|
|
|
19 "foreground color for stop signs")
|
|
|
20 (defvar eos::solid-arrow-color "purple"
|
|
|
21 "foreground color for solid arrow")
|
|
|
22 (defvar eos::hollow-arrow-color "purple"
|
|
|
23 "foreground color for hollow arrow")
|
|
|
24 (defvar eos::sbrowse-arrow-color "blue"
|
|
|
25 "foreground color for browser glyphs")
|
|
|
26
|
|
|
27 (defun eos::recompute-presentation ()
|
|
|
28 (set-face-foreground 'stop-face eos::stop-color)
|
|
|
29 (set-face-foreground 'solid-arrow-face eos::solid-arrow-color)
|
|
|
30 (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color)
|
|
|
31 (set-face-foreground 'sbrowse-arrow-face eos::sbrowse-arrow-color)
|
|
|
32 )
|
|
|
33
|
|
|
34 ;;
|
|
|
35
|
|
|
36 (defvar eos::displayed-initial-message nil
|
|
|
37 "Whether we have shown the initial display message")
|
|
|
38
|
|
|
39 (defconst eos::startup-message-lines
|
|
|
40 '("Please send feedback to eos-comments@cs.uiuc.edu."
|
|
|
41 "The latest Eos news are under SPARCworks->News"
|
|
|
42 "See Options->SPARCworks for configuration and Help->SPARCworks for help"
|
|
|
43 ))
|
|
|
44
|
|
|
45 ;; copied from vm
|
|
|
46
|
|
|
47 (defun eos::display-initial-message ()
|
|
|
48 ;; Display initial Eos message - REMOVED
|
|
|
49 )
|
|
|
50
|
|
|
51 (defun eos-old::display-initial-message ()
|
|
|
52 ;; Display initial Eos message
|
|
|
53 (if (not eos::displayed-initial-message)
|
|
|
54 (let ((lines eos::startup-message-lines))
|
|
|
55 (message "Eos %s, Copyright (C) 1995 Sun MicroSystems"
|
|
|
56 eos::version)
|
|
|
57 (setq eos::displayed-initial-message t)
|
|
|
58 (while (and (sit-for 3) lines)
|
|
|
59 (message (car lines))
|
|
|
60 (setq lines (cdr lines))))
|
|
|
61 (message "")))
|
|
|
62
|
|
|
63 ;; misc
|
|
|
64
|
|
|
65 (defun eos::line-at (pos)
|
|
|
66 ;; At what line is POS
|
|
|
67 (save-restriction
|
|
|
68 (widen)
|
|
|
69 (save-excursion
|
|
|
70 (goto-char pos)
|
|
|
71 (beginning-of-line)
|
|
|
72 (1+ (count-lines 1 (point))))))
|
|
|
73
|
|
|
74 ;; frame-specific enabling
|
|
|
75 ;;
|
|
|
76 ;; will maintain at most one frame to debugger, one to sbrowser
|
|
|
77 ;; annotations have a type, either
|
|
|
78 ;;
|
|
|
79 ;; sbrowser
|
|
|
80 ;; debugger-solid-arrow
|
|
|
81 ;; debugger-holow-arrow
|
|
|
82 ;; debugger-stop
|
|
|
83 ;; debugger-visit
|
|
|
84 ;;
|
|
|
85 ;; adding an annotation of type sbrowser will be only on frame sbrowser
|
|
|
86 ;; adding an annotation of type debugger will be only on frame debugger
|
|
|
87 ;;
|
|
|
88 ;; turn off patterns when there is no frame.
|
|
|
89
|
|
|
90
|
|
|
91 ;;;
|
|
|
92 ;;; Common ToolTalk function
|
|
|
93 ;;;
|
|
|
94
|
|
|
95 (defun make-an-observer (op callback)
|
|
|
96 (let ((pattern-desc
|
|
|
97 (list
|
|
|
98 'category 'TT_OBSERVE
|
|
|
99 'scope 'TT_SESSION
|
|
|
100 'class 'TT_NOTICE
|
|
|
101 'op op
|
|
|
102 'callback callback)))
|
|
|
103 (make-tooltalk-pattern pattern-desc)
|
|
|
104 ))
|
|
|
105
|
|
|
106 ;;;
|
|
|
107 ;;; Frame management
|
|
|
108 ;;;
|
|
|
109
|
|
|
110 (defun eos::log (msg)
|
|
|
111 (if (fboundp 'ut-log-text)
|
|
|
112 (ut-log-text "eos version: %s; %s" eos::version msg)))
|
|
|
113
|
|
|
114 (defvar eos::sbrowser-frame nil)
|
|
|
115 (defvar eos::debugger-frame nil)
|
|
|
116
|
|
|
117 (defun eos::update-specifiers (type old-frame new-frame)
|
|
|
118 ;; Change the database for annotations of TYPE, so that OLD-FRAME is
|
|
|
119 ;; now using the alternate specifier, while NEW-FRAME uses the main one
|
|
|
120 (let* ((device-type (device-type (selected-device)))
|
|
|
121 (g (eos::annotation-get-glyph type device-type))
|
|
|
122 (im (and (glyphp g) (glyph-image g)))
|
|
|
123 (new-instantiator (eos::annotation-get-inst type device-type))
|
|
|
124 (alt-instantiator (eos::annotation-get-inst-alt type device-type))
|
|
|
125 )
|
|
|
126 (if (eq device-type 'x)
|
|
|
127 (progn
|
|
|
128 (if (frame-live-p old-frame)
|
|
|
129 (progn
|
|
|
130 (remove-specifier im old-frame)
|
|
|
131 (add-spec-to-specifier im alt-instantiator old-frame)))
|
|
|
132 (if new-frame
|
|
|
133 (progn
|
|
|
134 (add-spec-to-specifier im new-instantiator new-frame)
|
|
|
135 ))))))
|
|
|
136
|
|
|
137
|
|
|
138 (defun eos::select-sbrowser-frame (frame)
|
|
|
139 (require 'eos-toolbar "sun-eos-toolbar")
|
|
|
140 (let ((toolbar (eos::toolbar-position)))
|
|
|
141 (eos::display-initial-message)
|
|
|
142 ;; logging
|
|
|
143 (if frame
|
|
|
144 (eos::log "selected frame for sbrowser")
|
|
|
145 (eos::log "unselected frame for sbrowser"))
|
|
|
146 ;; TT patterns
|
|
|
147 (cond
|
|
|
148 ((and (null eos::sbrowser-frame) frame)
|
|
|
149 (eos::register-sbrowser-patterns))
|
|
|
150 ((and (null frame) eos::sbrowser-frame)
|
|
|
151 (eos::unregister-sbrowser-patterns)))
|
|
|
152 ;; adjust toolbars
|
|
|
153 (if (frame-live-p eos::sbrowser-frame)
|
|
|
154 (remove-specifier toolbar eos::sbrowser-frame))
|
|
|
155 (if (frame-live-p eos::debugger-frame)
|
|
|
156 (remove-specifier toolbar eos::debugger-frame))
|
|
|
157 ;; then add
|
|
|
158 (cond
|
|
|
159 ((and (frame-live-p eos::debugger-frame) (frame-live-p frame)
|
|
|
160 (equal eos::debugger-frame frame))
|
|
|
161 (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame))
|
|
|
162 ((and (frame-live-p eos::debugger-frame) (frame-live-p frame))
|
|
|
163 (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame)
|
|
|
164 (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame))
|
|
|
165 ((frame-live-p frame)
|
|
|
166 (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame))
|
|
|
167 ((frame-live-p eos::debugger-frame)
|
|
|
168 (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame))
|
|
|
169 )
|
|
|
170 ;; adjust specifiers for glyphs
|
|
|
171 (eos::update-specifiers 'sbrowser eos::sbrowser-frame frame)
|
|
|
172 (if (frame-live-p eos::sbrowser-frame)
|
|
|
173 (progn
|
|
|
174 (remove-specifier use-left-overflow eos::sbrowser-frame)
|
|
|
175 (remove-specifier left-margin-width eos::sbrowser-frame)))
|
|
|
176 (if (frame-live-p frame)
|
|
|
177 (progn
|
|
|
178 (add-spec-to-specifier use-left-overflow t frame)
|
|
|
179 (add-spec-to-specifier left-margin-width eos::left-margin-width frame)
|
|
|
180 (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
|
|
|
181 (if (frame-live-p eos::debugger-frame)
|
|
|
182 (progn
|
|
|
183 (add-spec-to-specifier use-left-overflow t eos::debugger-frame)
|
|
|
184 (add-spec-to-specifier left-margin-width eos::left-margin-width eos::debugger-frame)
|
|
|
185 (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
|
|
|
186 ;;
|
|
|
187 (setq eos::sbrowser-frame frame)
|
|
|
188 (set-menubar-dirty-flag)
|
|
|
189 ))
|
|
|
190
|
|
|
191 (defun eos::select-debugger-frame (frame)
|
|
|
192 (require 'eos-toolbar "sun-eos-toolbar")
|
|
|
193 (let ((toolbar (eos::toolbar-position)))
|
|
|
194 (eos::display-initial-message)
|
|
|
195 (save-excursion
|
|
|
196 (eos::ensure-debugger-buffer)
|
|
|
197 (bury-buffer))
|
|
|
198 ;; logging
|
|
|
199 (if frame
|
|
|
200 (eos::log "selected frame for debugger")
|
|
|
201 (eos::log "unselected frame for debugger"))
|
|
|
202 ;; TT patterns
|
|
|
203 (cond
|
|
|
204 ((and (null eos::debugger-frame) frame)
|
|
|
205 (eos::register-debugger-patterns)
|
|
|
206 (eos::register-visit-file-pattern))
|
|
|
207 ((and (null frame) eos::debugger-frame)
|
|
|
208 (eos::unregister-debugger-patterns)
|
|
|
209 (eos::unregister-visit-file-pattern)))
|
|
|
210 ;; adjust toolbars, remove
|
|
|
211 (if (frame-live-p eos::sbrowser-frame)
|
|
|
212 (remove-specifier toolbar eos::sbrowser-frame))
|
|
|
213 (if (frame-live-p eos::debugger-frame)
|
|
|
214 (remove-specifier toolbar eos::debugger-frame))
|
|
|
215 ;; then add
|
|
|
216 (cond
|
|
|
217 ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame)
|
|
|
218 (equal eos::sbrowser-frame frame))
|
|
|
219 (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame))
|
|
|
220 ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame))
|
|
|
221 (add-spec-to-specifier toolbar eos::debugger-toolbar frame)
|
|
|
222 (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame))
|
|
|
223 ((frame-live-p frame)
|
|
|
224 (add-spec-to-specifier toolbar eos::debugger-toolbar frame))
|
|
|
225 ((frame-live-p eos::sbrowser-frame)
|
|
|
226 (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame))
|
|
|
227 )
|
|
|
228 ;; update glyph specifiers
|
|
|
229 (eos::update-specifiers 'debugger-solid-arrow eos::debugger-frame frame)
|
|
|
230 (eos::update-specifiers 'debugger-hollow-arrow eos::debugger-frame frame)
|
|
|
231 (eos::update-specifiers 'debugger-stop eos::debugger-frame frame)
|
|
|
232 (if (frame-live-p eos::debugger-frame)
|
|
|
233 (progn
|
|
|
234 (remove-specifier use-left-overflow eos::debugger-frame)
|
|
|
235 (remove-specifier left-margin-width eos::debugger-frame)))
|
|
|
236 (if (frame-live-p frame)
|
|
|
237 (progn
|
|
|
238 (add-spec-to-specifier use-left-overflow t frame)
|
|
|
239 (add-spec-to-specifier left-margin-width eos::left-margin-width frame)
|
|
|
240 (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
|
|
|
241 (if (frame-live-p eos::sbrowser-frame)
|
|
|
242 (progn
|
|
|
243 (add-spec-to-specifier use-left-overflow t eos::sbrowser-frame)
|
|
|
244 (add-spec-to-specifier left-margin-width eos::left-margin-width eos::sbrowser-frame)
|
|
|
245 (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
|
|
|
246 ;;
|
|
|
247 (setq eos::debugger-frame frame)
|
|
|
248 (set-menubar-dirty-flag)
|
|
|
249 ))
|
|
|
250
|
|
|
251 ;; HERE use file-truename
|
|
|
252
|
|
|
253 (defun eos::select-frame (type)
|
|
|
254 ;; Select a frame; return nil if should skip
|
|
|
255 (cond ((eq type 'sbrowser)
|
|
|
256 (if (frame-live-p eos::sbrowser-frame)
|
|
|
257 eos::sbrowser-frame
|
|
|
258 (message "selecting destroyed frame; will ignore")
|
|
|
259 (eos::select-sbrowser-frame nil)
|
|
|
260 nil))
|
|
|
261 ((or (eq type 'debugger-solid-arrow)
|
|
|
262 (eq type 'debugger-hollow-arrow)
|
|
|
263 (eq type 'debugger-stop)
|
|
|
264 (eq type 'debugger-visit))
|
|
|
265 (if (frame-live-p eos::debugger-frame)
|
|
|
266 eos::debugger-frame
|
|
|
267 (message "selecting destroyed frame; will ignore")
|
|
|
268 (eos::select-debugger-frame nil)
|
|
|
269 nil))
|
|
|
270 (t (selected-frame))))
|
|
|
271
|
|
|
272 (defun eos::select-window (win)
|
|
|
273 ;; Will select a window if it is not showing neither of eos::debugger-buffer or
|
|
|
274 ;; eos::toolbar-buffer"
|
|
|
275 (let ((name (buffer-name (window-buffer win))))
|
|
|
276 (if (and (>= (length name) 4)
|
|
|
277 (equal (substring name 0 4) "*Eos"))
|
|
|
278 nil
|
|
|
279 (select-window win)
|
|
|
280 (throw 'found t)
|
|
|
281 )))
|
|
|
282
|
|
|
283 (defun eos::find-line (file line type)
|
|
|
284 ;; Show FILE at LINE; returns frame or nil if inappropriate
|
|
|
285 ;; if type is nil
|
|
|
286 (if (eos::null-file file)
|
|
|
287 (selected-frame)
|
|
|
288 (let ((sc (eos::select-frame type))
|
|
|
289 (win (selected-window)))
|
|
|
290 (if (null sc)
|
|
|
291 nil
|
|
|
292 (select-frame sc)
|
|
|
293 (if (catch 'found
|
|
|
294 (eos::select-window (selected-window))
|
|
|
295 (walk-windows 'eos::select-window)
|
|
|
296 nil)
|
|
|
297 nil ; do nothing, already there
|
|
|
298 (select-window win)
|
|
|
299 (split-window-vertically)
|
|
|
300 (other-window 1)
|
|
|
301 )
|
|
|
302 (switch-to-buffer (find-file-noselect file t)) ;; no warn!
|
|
|
303 (if (eq (device-type) 'x) (x-disown-selection))
|
|
|
304 (goto-line line)
|
|
|
305 sc
|
|
|
306 ))))
|
|
|
307
|
|
|
308 (defun eos::null-file (file)
|
|
|
309 ;; returns t if FILE is nil or the empty string
|
|
|
310 (or (null file) (equal file "")))
|
|
|
311
|
|
|
312 ;;;
|
|
|
313 ;;; Annotation handling
|
|
|
314 ;;;
|
|
|
315
|
|
|
316 (defun eos::valid-annotation (annotation)
|
|
|
317 ;; returns t if ANNOTATION is an annotation and its buffer exists
|
|
|
318 (and (annotationp annotation)
|
|
|
319 (bufferp (extent-buffer annotation))
|
|
|
320 (buffer-name (extent-buffer annotation)))
|
|
|
321 )
|
|
|
322
|
|
|
323 (defvar eos::annotation-list nil
|
|
|
324 "list of annotations set")
|
|
|
325
|
|
|
326 (defun eos::add-to-annotation-list (ann type)
|
|
|
327 (if (not (eq type 'debugger-stop))
|
|
|
328 (error "not implemented"))
|
|
|
329 (setq eos::annotation-list (cons ann
|
|
|
330 eos::annotation-list))
|
|
|
331 )
|
|
|
332
|
|
|
333 (defun eos::remove-from-annotation-list (ann type)
|
|
|
334 (if (not (eq type 'debugger-stop))
|
|
|
335 (error "not implemented"))
|
|
|
336 (setq eos::annotation-list (delq ann eos::annotation-list))
|
|
|
337 )
|
|
|
338
|
|
|
339 (defun eos::remove-all-from-annotation-list (type)
|
|
|
340 (if (not (eq type 'debugger-stop))
|
|
|
341 (error "not implemented"))
|
|
|
342 (mapcar (function (lambda (annot)
|
|
|
343 (if (extent-live-p annot)
|
|
|
344 (delete-annotation annot))))
|
|
|
345 eos::annotation-list)
|
|
|
346 (setq eos::annotation-list nil))
|
|
|
347
|
|
|
348 (defun eos::add-annotation (type file line uid)
|
|
|
349 (let ((anot nil)
|
|
|
350 (fr (selected-frame))
|
|
|
351 (win (selected-window))
|
|
|
352 )
|
|
|
353 (if (eos::null-file file)
|
|
|
354 (setq anot nil)
|
|
|
355 (if (null (eos::find-line file line type))
|
|
|
356 (error "No frame to select"))
|
|
|
357 (let* ((device-type (device-type (selected-device)))
|
|
|
358 (graphics (eos::annotation-get-glyph type device-type))
|
|
|
359 (face (eos::annotation-get-face type device-type))
|
|
|
360 )
|
|
98
|
361 (setq anot (make-annotation graphics (point) 'outside-margin))
|
|
0
|
362 (set-annotation-data anot uid)
|
|
|
363 (set-extent-face anot face)
|
|
|
364 (eos::add-to-annotation-list anot type)
|
|
|
365 ))
|
|
|
366 (select-frame fr)
|
|
|
367 (select-window win)
|
|
|
368 anot
|
|
|
369 ))
|
|
|
370
|
|
|
371 (defun eos::compare-uid (extent uid)
|
|
|
372 (and (annotationp extent)
|
|
|
373 (equal (annotation-data extent) uid)
|
|
|
374 extent))
|
|
|
375
|
|
|
376 (defun eos::delete-annotation (type file line uid)
|
|
|
377 ;; ignore file and line, they are here for backward compatibility
|
|
|
378 (let ((anot nil)
|
|
|
379 (alist eos::annotation-list)
|
|
|
380 )
|
|
|
381 (if (not (eq type 'debugger-stop))
|
|
|
382 (error "not implemented"))
|
|
|
383 (while (and alist
|
|
|
384 (not (equal (annotation-data (car alist)) uid)))
|
|
|
385 (setq alist (cdr alist)))
|
|
|
386 (if (null alist)
|
|
|
387 (error "Event UID not found; ignored")
|
|
|
388 (setq anot (car alist))
|
|
|
389 (delete-annotation anot)
|
|
|
390 (eos::remove-from-annotation-list anot type))
|
|
|
391 ))
|
|
|
392
|
|
|
393 ;; probably type should not be given here... (already stored in the annotation-data
|
|
|
394 ;; field) but it is a bit more robust this way.
|
|
|
395
|
|
|
396 (defun eos::make-annotation-visible (annotation file line type)
|
|
|
397 ;; returns nil or moves the ANNOTATION to FILE and LINE; annotation is of TYPE
|
|
|
398 (let ((back nil)
|
|
|
399 (fr (selected-frame))
|
|
|
400 (win (selected-window))
|
|
|
401 )
|
|
|
402 ;; (save-window-excursion
|
|
|
403 (if (not (eos::null-file file))
|
|
|
404 (progn
|
|
|
405 (if (eos::valid-annotation annotation)
|
|
|
406 (detach-extent annotation) ; should operate on annotations
|
|
|
407 )
|
|
|
408 (if (null (eos::find-line file line type))
|
|
|
409 (error "No frame to select"))
|
|
|
410 (let* ((device-type (device-type (selected-device)))
|
|
|
411 (graphics (eos::annotation-get-glyph type device-type))
|
|
|
412 (face (eos::annotation-get-face type device-type))
|
|
|
413 )
|
|
|
414 (if (and (eos::valid-annotation annotation)
|
|
|
415 (extent-detached-p annotation))
|
|
|
416 (progn
|
|
|
417 (setq back (insert-extent annotation (point) (point) t))
|
|
|
418 (set-annotation-glyph back graphics 'whitespace)
|
|
|
419 )
|
|
|
420 (setq back (make-annotation graphics (point) 'whitespace))
|
|
|
421 )
|
|
|
422 (set-annotation-data back type)
|
|
|
423 (set-extent-face back face)
|
|
|
424 )))
|
|
|
425 ;; )
|
|
|
426 (if (not (eq (selected-frame) fr))
|
|
|
427 (select-frame fr))
|
|
|
428 (select-window win)
|
|
|
429 back
|
|
|
430 ))
|
|
|
431
|
|
|
432 (defun eos::make-annotation-invisible (annotation)
|
|
|
433 ;; make this ANNOTATION invisible
|
|
|
434 (if (eos::valid-annotation annotation)
|
|
|
435 (detach-extent annotation) ;; should operate on annotations
|
|
|
436 ))
|
|
|
437
|
|
|
438
|
|
|
439 ;; mapping between annotation types and their screen representations.
|
|
|
440
|
|
|
441 (defvar eos::alist-annotation-glyph nil) ; assoc list of annotation type
|
|
|
442 ; device type, and glyph
|
|
|
443 (defvar eos::alist-annotation-inst nil) ; assoc list of annotation type
|
|
|
444 ; device type, and instantiator
|
|
|
445 (defvar eos::alist-annotation-inst-alt nil) ; alternate assoc list of annotation type
|
|
|
446 ; device type, and instantiator
|
|
|
447
|
|
|
448 (defvar eos::alist-annotation-face nil) ;; assoc list of annotation type,
|
|
|
449 ;; device type and face
|
|
|
450
|
|
|
451 ;; PUBLIC
|
|
|
452
|
|
|
453 ;; TBD! merge both instance lists.
|
|
|
454
|
|
|
455 (defun eos::annotation-set-inst (annotation-type device-type inst inst-alt)
|
|
|
456 "define the instantiator for ANNOTATION-TYPE on DEVICE-TYPE to be
|
|
|
457 INST for the frame enabled for this type and INST-ALT for other frames"
|
|
|
458 (interactive)
|
|
|
459 (setq eos::alist-annotation-inst
|
|
|
460 (cons (cons (cons annotation-type device-type) inst)
|
|
|
461 eos::alist-annotation-inst))
|
|
|
462 (setq eos::alist-annotation-inst-alt
|
|
|
463 (cons (cons (cons annotation-type device-type) inst-alt)
|
|
|
464 eos::alist-annotation-inst-alt)) )
|
|
|
465
|
|
|
466 (defun eos::annotation-set-face (annotation-type device-type face-1 face-2)
|
|
|
467 "define the face for ANNOTATION-TYPE on DEVICE-TYPE to be
|
|
|
468 FACE-1 for the frame enabled for this type and FACE-2 for other frames"
|
|
|
469 (interactive)
|
|
|
470 (setq eos::alist-annotation-face
|
|
|
471 (cons (cons (cons annotation-type device-type) face-1)
|
|
|
472 eos::alist-annotation-face))
|
|
|
473 )
|
|
|
474
|
|
|
475 ;; PRIVATE
|
|
|
476
|
|
|
477 (defun eos::annotation-get-glyph (annotation-type device-type)
|
|
|
478 ;; Get the glyph for ANNOTATION-TYPE on DEVICE-TYPE
|
|
|
479 (interactive)
|
|
|
480 (let ((found (assoc (cons annotation-type device-type)
|
|
|
481 eos::alist-annotation-glyph)))
|
|
|
482 (if found
|
|
|
483 (cdr found)
|
|
|
484 (let ((inst (eos::annotation-get-inst annotation-type device-type))
|
|
|
485 (alt-inst (eos::annotation-get-inst-alt annotation-type device-type))
|
|
|
486 (glyph nil)
|
|
|
487 (frame (selected-frame)))
|
|
|
488 (if (null inst)
|
|
|
489 nil
|
|
|
490 (setq glyph (make-glyph `((global . (nil . ,alt-inst)))))
|
|
|
491 (add-spec-to-specifier (glyph-image glyph) inst frame)
|
|
|
492 (setq eos::alist-annotation-glyph
|
|
|
493 (cons (cons (cons annotation-type device-type) glyph)
|
|
|
494 eos::alist-annotation-glyph))
|
|
|
495 glyph))
|
|
|
496 )))
|
|
|
497
|
|
|
498 (defun eos::annotation-get-inst (annotation-type device-type)
|
|
|
499 ;; Get the primary instantiator for ANNOTATION-TYPE on DEVICE-TYPE
|
|
|
500 (interactive)
|
|
|
501 (let ((found (assoc (cons annotation-type device-type)
|
|
|
502 eos::alist-annotation-inst)))
|
|
|
503 (if found
|
|
|
504 (cdr found)
|
|
|
505 nil)))
|
|
|
506
|
|
|
507 (defun eos::annotation-get-inst-alt (annotation-type device-type)
|
|
|
508 ;; Get the alternate instantiator for ANNOTATION-TYPE on DEVICE-TYPE
|
|
|
509 (interactive)
|
|
|
510 (let ((found (assoc (cons annotation-type device-type)
|
|
|
511 eos::alist-annotation-inst-alt)))
|
|
|
512 (if found
|
|
|
513 (cdr found)
|
|
|
514 nil)))
|
|
|
515
|
|
|
516 (defun eos::annotation-get-face (annotation-type device-type)
|
|
|
517 ;; Get the face for ANNOTATION-TYPE on DEVICE-TYPE
|
|
|
518 (interactive)
|
|
|
519 (let ((found (assoc (cons annotation-type device-type)
|
|
|
520 eos::alist-annotation-face))
|
|
|
521 )
|
|
|
522 (if found
|
|
|
523 (cdr found)
|
|
|
524 nil
|
|
|
525 ))
|
|
|
526 )
|
|
|
527
|
|
|
528
|
|
|
529 (defun eos::common-startup () )
|
|
|
530 ;;
|
|
|
531
|
|
|
532
|
|
|
533 (provide 'eos-common)
|
