Mercurial > hg > xemacs-beta

comparison lisp/eos/sun-eos-browser.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-browser.el --- Implements the XEmacs/SPARCworks SourceBrowser interface
2
3 ;; Copyright (C) 1995 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 SBrowser Source Browser
9
10 ;;; Commentary:
11 ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
12
13 ;;; Code:
14
15 (require 'eos-common "sun-eos-common")
16
17 ;; ================
18 ;; Browser Protocol
19 ;; ================
20 ;;
21 ;; three notifications
22 ;;
23 ;; SPRO_SBENG_START
24 ;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
25 ;; SPRO_SBENG_QUIT
26
27 (defvar eos::currentMatch-inst "/* XPM */
28 static char * file[] = {
29 \"14 11 5 1\",
30 \" s background c #FFFFFFFFFFFF\",
31 \". c #000000000000\",
32 \"X c #0000FFFF0000\",
33 \"o c #000077770000\",
34 \"O c #000044440000\",
35 \" \",
36 \" oo \",
37 \" oXOo \",
38 \" oXXXOo \",
39 \" oXXXXXOo \",
40 \" oXXXXXXXo. \",
41 \" oXXXXXOo \",
42 \" oXXXOo \",
43 \" oXOo \",
44 \" oo \",
45 \" \"};")
46
47 (defvar eos::currentMatch-inst-alt "/* XPM */
48 static char * file[] = {
49 \"14 11 5 1\",
50 \" s background c #FFFFFFFFFFFF\",
51 \". c #000000000000\",
52 \"X c #0000FFFF0000\",
53 \"o c #000077770000\",
54 \"O c #000044440000\",
55 \" \",
56 \" oo \",
57 \" oXOo \",
58 \" oXXXOo \",
59 \" oXXXXXOo \",
60 \" oXXXXXXXo. \",
61 \" oXXXXXOo \",
62 \" oXXXOo \",
63 \" oXOo \",
64 \" oo .. \",
65 \" .. \"};")
66
67 (defvar sbrowser-pattern-list nil)
68
69
70 (defun eos::browser-startup ()
71 ;; Actions to do at startup for eos-browser.el
72 (make-face 'sbrowse-arrow-face)
73
74 (set-face-foreground 'sbrowse-arrow-face
75 eos::sbrowse-arrow-color)
76 (set-face-background 'sbrowse-arrow-face
77 (face-background (get-face 'default)))
78
79 (setq sbrowser-pattern-list ; list of browser TT patterns
80 (eos::create-sbrowser-patterns))
81
82 ;; now register glyphs and faces...
83
84 (eos::annotation-set-inst 'sbrowser 'x eos::currentMatch-inst [nothing])
85 (eos::annotation-set-inst 'sbrowser 'tty "|>" [nothing])
86 (eos::annotation-set-face 'sbrowser 'x
87 (get-face 'sbrowse-arrow-face)
88 (get-face 'sbrowse-arrow-face))
89 (eos::annotation-set-face 'sbrowser 'tty
90 (get-face 'highlight)
91 (get-face 'highlight))
92 )
93
94 (defvar eos::current-match nil)
95
96 (defun eos::spro_sbeng_current_element (msg pat)
97 ;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
98 (let* ((filename
99 (get-tooltalk-message-attribute msg 'arg_val 1))
100 (lineno
101 (read (get-tooltalk-message-attribute msg 'arg_ival 2)))
102 )
103 (setq eos::current-match
104 (eos::make-annotation-visible eos::current-match
105 filename
106 lineno
107 'sbrowser))
108 (return-tooltalk-message msg)
109 ))
110
111 (defun eos::spro_sbeng_start (msg pat)
112 (eos::make-annotation-invisible eos::current-match)
113 (return-tooltalk-message msg)
114 )
115
116 (defun eos::spro_sbeng_quit (msg pat)
117 (eos::make-annotation-invisible eos::current-match)
118 (return-tooltalk-message msg)
119 )
120
121 (defun eos::create-sbrowser-patterns ()
122 ;; returns list of patterns
123 (list
124 (make-an-observer "SPRO_SBENG_CURRENT_ELEMENT"
125 'eos::spro_sbeng_current_element)
126 (make-an-observer "SPRO_SBENG_START"
127 'eos::spro_sbeng_start)
128 (make-an-observer "SPRO_SBENG_QUIT"
129 'eos::spro_sbeng_quit)
130 ))
131
132 (defun eos::register-sbrowser-patterns ()
133 ;; register all sbrowser patterns
134 (mapcar 'register-tooltalk-pattern sbrowser-pattern-list))
135
136 (defun eos::unregister-sbrowser-patterns ()
137 ;; unregister all sbrowser patterns
138 (mapcar 'unregister-tooltalk-pattern sbrowser-pattern-list))
139
140 ;; Actions to start a sourcebrowser in the background.
141
142 (defvar eos::sbrowser-process nil
143 "sbrowser process for the background. Only one per XEmacs")
144
145 (defun eos::start-sbrowser ()
146 ;; Start an "sbrowser -editor" in the background. Will ask for confirmation if
147 ;; XEmacs somehow believes there is already one running
148 (interactive)
149 (if (or (not (processp eos::sbrowser-process))
150 (not (eq (process-status eos::sbrowser-process) 'run))
151 (yes-or-no-p
152 "Warning! XEmacs believes there already is a sbrowser -editor, proceed?"))
153 (progn
154 (setq eos::sbrowser-process
155 (start-process "*eos sbrowser*" nil "sbrowser" "-editor"))
156 (message "Starting SBrowser subprocess")
157 (eos::select-sbrowser-frame (selected-frame))
158 )))
159
160 (provide 'eos-browser)
161
162 ;;; sun-eos-browser.el ends here