diff lisp/eos/sun-eos-editor.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-editor.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,114 @@
+;;; sun-eos-editor.el --- Implements the XEmacs/SPARCworks editor protocol
+
+;; 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 editor
+
+;;; Commentary:
+
+;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
+
+;;; Code:
+
+(require 'eos-common "sun-eos-common")
+
+;; ===============
+;; Editor protocol
+;;
+;; message is
+;; SPRO_Visit_File CONTEXT_UID filename lineno center==0
+
+(defvar eos::visit-file-pattern)
+(defvar eos::get-src-line-pattern)
+
+(defun eos::editor-startup ()
+  ;; Actions to do at startup time for eos-editor
+  (setq eos::visit-file-pattern
+	(eos::create-visit-file-pattern))
+  (setq eos::get-src-line-pattern
+	(eos::create-get-src-line-pattern))
+  (eos::register-get-src-line-pattern)
+  )
+
+(defun eos::visit-file-callback (msg pat)
+  ;; A callback for a SPRO_Visit_File message
+  ;; really should be discarded in the pattern
+  (let* ((filename
+	  (get-tooltalk-message-attribute msg 'arg_val 1))
+	 (lineno-dot
+	  (read
+	   (get-tooltalk-message-attribute msg 'arg_ival 2)))
+	 )
+    (if (null (eos::find-line filename lineno-dot 'debugger-visit))
+	(message "No frame to select"))
+    (return-tooltalk-message msg)
+    ))
+
+(defun eos::create-visit-file-pattern ()
+  ;; Create Visit File pattern
+  (let* ((pattern-desc '(category TT_HANDLE
+			    scope TT_SESSION
+			    class TT_REQUEST
+			    op "SPRO_Visit_File"
+			    callback eos::visit-file-callback))
+	 (pattern (make-tooltalk-pattern pattern-desc))
+	 )
+    pattern
+    ))
+
+(defun eos::register-visit-file-pattern ()
+  ;; Register Visit File pattern
+  (register-tooltalk-pattern eos::visit-file-pattern))
+
+(defun eos::unregister-visit-file-pattern ()
+  ;; Unregister Visit File pattern
+  (unregister-tooltalk-pattern eos::visit-file-pattern))
+
+;;
+;; ====================
+;;
+;; Auxiliary TT message to get source and lineno.
+;;
+;; message is
+;; SPRO_Get_Src_Line CONTEXT_UID (INOUT filename) (INOUT lineno)
+
+;;
+
+(defun eos::get-src-line-callback (msg pat)
+  ;; A callback for a SPRO_Get_Src_Line message
+  ;; really should be discarded in the pattern
+  (let* ((filename
+	  (buffer-file-name))
+	 (lineno
+	  (format "%d" (eos::line-at (point)))))
+    (set-tooltalk-message-attribute filename msg 'arg_val 1)
+    (set-tooltalk-message-attribute lineno msg 'arg_val 2)
+    (return-tooltalk-message msg)
+    ))
+
+(defun eos::create-get-src-line-pattern ()
+  ;; Create a pattern to get filename and lineno
+  (let* ((pattern-desc '(category TT_HANDLE
+			    scope TT_SESSION
+			    class TT_REQUEST
+			    op "SPRO_Get_Src_Line"
+			    callback eos::get-src-line-callback))
+	 (pattern (make-tooltalk-pattern pattern-desc))
+	 )
+    pattern
+    ))
+
+(defun eos::register-get-src-line-pattern ()
+  ;; Register Get Src Line pattern
+  (register-tooltalk-pattern eos::get-src-line-pattern))
+  
+(defun eos::unregister-get-src-line-pattern ()
+  ;; Unregister Get Src Line pattern
+  (unregister-tooltalk-pattern eos::get-src-line-pattern))
+  
+(provide 'eos-editor)
+
+;;; sun-eos-debugger.el ends here