diff lisp/eos/sun-eos-browser.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/eos/sun-eos-browser.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,162 @@
+;;; sun-eos-browser.el --- Implements the XEmacs/SPARCworks SourceBrowser interface
+
+;; Copyright (C) 1995  Sun Microsystems, Inc.
+
+;; Maintainer:	Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
+;; Author:      Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
+
+;; Keywords:	SPARCworks EOS Era on SPARCworks SBrowser Source Browser
+
+;;; Commentary:
+;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
+
+;;; Code:
+
+(require 'eos-common "sun-eos-common")
+
+;; ================
+;; Browser Protocol
+;; ================
+;;
+;; three notifications
+;;
+;; SPRO_SBENG_START
+;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
+;; SPRO_SBENG_QUIT
+
+(defvar eos::currentMatch-inst "/* XPM */
+static char * file[] = {
+\"14 11 5 1\",
+\" 	s background c #FFFFFFFFFFFF\",
+\".	c #000000000000\",
+\"X	c #0000FFFF0000\",
+\"o	c #000077770000\",
+\"O	c #000044440000\",
+\"              \",
+\"   oo         \",
+\"   oXOo       \",
+\"   oXXXOo     \",
+\"   oXXXXXOo   \",
+\"   oXXXXXXXo. \",
+\"   oXXXXXOo   \",
+\"   oXXXOo     \",
+\"   oXOo       \",
+\"   oo         \",
+\"              \"};")
+
+(defvar eos::currentMatch-inst-alt "/* XPM */
+static char * file[] = {
+\"14 11 5 1\",
+\" 	s background c #FFFFFFFFFFFF\",
+\".	c #000000000000\",
+\"X	c #0000FFFF0000\",
+\"o	c #000077770000\",
+\"O	c #000044440000\",
+\"              \",
+\"   oo         \",
+\"   oXOo       \",
+\"   oXXXOo     \",
+\"   oXXXXXOo   \",
+\"   oXXXXXXXo. \",
+\"   oXXXXXOo   \",
+\"   oXXXOo     \",
+\"   oXOo       \",
+\"   oo      .. \",
+\"           .. \"};")
+
+(defvar sbrowser-pattern-list nil)
+
+
+(defun eos::browser-startup ()
+  ;; Actions to do at startup for eos-browser.el
+  (make-face 'sbrowse-arrow-face)
+
+  (set-face-foreground 'sbrowse-arrow-face
+		       eos::sbrowse-arrow-color)
+  (set-face-background 'sbrowse-arrow-face
+		       (face-background (get-face 'default)))
+
+  (setq sbrowser-pattern-list		; list of browser TT patterns
+	(eos::create-sbrowser-patterns))
+
+  ;; now register glyphs and faces...
+
+  (eos::annotation-set-inst 'sbrowser 'x eos::currentMatch-inst [nothing])
+  (eos::annotation-set-inst 'sbrowser 'tty "|>" [nothing])
+  (eos::annotation-set-face 'sbrowser 'x
+			    (get-face 'sbrowse-arrow-face)
+			    (get-face 'sbrowse-arrow-face))
+  (eos::annotation-set-face 'sbrowser 'tty
+			    (get-face 'highlight)
+			    (get-face 'highlight))
+)
+
+(defvar eos::current-match nil)
+
+(defun eos::spro_sbeng_current_element (msg pat)
+  ;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
+  (let* ((filename
+	  (get-tooltalk-message-attribute msg 'arg_val 1))
+	 (lineno
+	  (read (get-tooltalk-message-attribute msg 'arg_ival 2)))
+	 )
+    (setq eos::current-match
+	  (eos::make-annotation-visible eos::current-match
+					filename
+					lineno
+					'sbrowser))
+    (return-tooltalk-message msg)
+    ))
+
+(defun eos::spro_sbeng_start (msg pat)
+    (eos::make-annotation-invisible eos::current-match)
+    (return-tooltalk-message msg)
+    )
+
+(defun eos::spro_sbeng_quit (msg pat)
+    (eos::make-annotation-invisible eos::current-match)
+    (return-tooltalk-message msg)
+    )
+
+(defun eos::create-sbrowser-patterns ()
+  ;; returns list of patterns
+  (list
+   (make-an-observer "SPRO_SBENG_CURRENT_ELEMENT"
+		     'eos::spro_sbeng_current_element)
+   (make-an-observer "SPRO_SBENG_START"
+		     'eos::spro_sbeng_start)
+   (make-an-observer "SPRO_SBENG_QUIT"
+		     'eos::spro_sbeng_quit)
+   ))
+
+(defun eos::register-sbrowser-patterns ()
+  ;; register all sbrowser patterns
+  (mapcar 'register-tooltalk-pattern sbrowser-pattern-list))
+
+(defun eos::unregister-sbrowser-patterns ()
+  ;; unregister all sbrowser patterns
+  (mapcar 'unregister-tooltalk-pattern sbrowser-pattern-list))
+
+;; Actions to start a sourcebrowser in the background.
+
+(defvar eos::sbrowser-process nil
+  "sbrowser process for the background.  Only one per XEmacs")
+
+(defun eos::start-sbrowser ()
+  ;; Start an "sbrowser -editor" in the background. Will ask for confirmation if
+  ;; XEmacs somehow believes there is already one running
+  (interactive)
+  (if (or (not (processp eos::sbrowser-process))
+	  (not (eq (process-status eos::sbrowser-process) 'run))
+	  (yes-or-no-p
+	   "Warning! XEmacs believes there already is a sbrowser -editor, proceed?"))
+      (progn
+	(setq eos::sbrowser-process
+	      (start-process "*eos sbrowser*" nil "sbrowser" "-editor"))
+	(message "Starting SBrowser subprocess")
+	(eos::select-sbrowser-frame (selected-frame))
+	)))
+
+(provide 'eos-browser) 
+
+;;; sun-eos-browser.el ends here