Mercurial > hg > xemacs-beta

comparison lisp/eos/sun-eos-editor.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-editor.el --- Implements the XEmacs/SPARCworks editor protocol
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 editor
9
10 ;;; Commentary:
11
12 ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
13
14 ;;; Code:
15
16 (require 'eos-common "sun-eos-common")
17
18 ;; ===============
19 ;; Editor protocol
20 ;;
21 ;; message is
22 ;; SPRO_Visit_File CONTEXT_UID filename lineno center==0
23
24 (defvar eos::visit-file-pattern)
25 (defvar eos::get-src-line-pattern)
26
27 (defun eos::editor-startup ()
28 ;; Actions to do at startup time for eos-editor
29 (setq eos::visit-file-pattern
30 (eos::create-visit-file-pattern))
31 (setq eos::get-src-line-pattern
32 (eos::create-get-src-line-pattern))
33 (eos::register-get-src-line-pattern)
34 )
35
36 (defun eos::visit-file-callback (msg pat)
37 ;; A callback for a SPRO_Visit_File message
38 ;; really should be discarded in the pattern
39 (let* ((filename
40 (get-tooltalk-message-attribute msg 'arg_val 1))
41 (lineno-dot
42 (read
43 (get-tooltalk-message-attribute msg 'arg_ival 2)))
44 )
45 (if (null (eos::find-line filename lineno-dot 'debugger-visit))
46 (message "No frame to select"))
47 (return-tooltalk-message msg)
48 ))
49
50 (defun eos::create-visit-file-pattern ()
51 ;; Create Visit File pattern
52 (let* ((pattern-desc '(category TT_HANDLE
53 scope TT_SESSION
54 class TT_REQUEST
55 op "SPRO_Visit_File"
56 callback eos::visit-file-callback))
57 (pattern (make-tooltalk-pattern pattern-desc))
58 )
59 pattern
60 ))
61
62 (defun eos::register-visit-file-pattern ()
63 ;; Register Visit File pattern
64 (register-tooltalk-pattern eos::visit-file-pattern))
65
66 (defun eos::unregister-visit-file-pattern ()
67 ;; Unregister Visit File pattern
68 (unregister-tooltalk-pattern eos::visit-file-pattern))
69
70 ;;
71 ;; ====================
72 ;;
73 ;; Auxiliary TT message to get source and lineno.
74 ;;
75 ;; message is
76 ;; SPRO_Get_Src_Line CONTEXT_UID (INOUT filename) (INOUT lineno)
77
78 ;;
79
80 (defun eos::get-src-line-callback (msg pat)
81 ;; A callback for a SPRO_Get_Src_Line message
82 ;; really should be discarded in the pattern
83 (let* ((filename
84 (buffer-file-name))
85 (lineno
86 (format "%d" (eos::line-at (point)))))
87 (set-tooltalk-message-attribute filename msg 'arg_val 1)
88 (set-tooltalk-message-attribute lineno msg 'arg_val 2)
89 (return-tooltalk-message msg)
90 ))
91
92 (defun eos::create-get-src-line-pattern ()
93 ;; Create a pattern to get filename and lineno
94 (let* ((pattern-desc '(category TT_HANDLE
95 scope TT_SESSION
96 class TT_REQUEST
97 op "SPRO_Get_Src_Line"
98 callback eos::get-src-line-callback))
99 (pattern (make-tooltalk-pattern pattern-desc))
100 )
101 pattern
102 ))
103
104 (defun eos::register-get-src-line-pattern ()
105 ;; Register Get Src Line pattern
106 (register-tooltalk-pattern eos::get-src-line-pattern))
107
108 (defun eos::unregister-get-src-line-pattern ()
109 ;; Unregister Get Src Line pattern
110 (unregister-tooltalk-pattern eos::get-src-line-pattern))
111
112 (provide 'eos-editor)
113
114 ;;; sun-eos-debugger.el ends here