cgit.sxemacs.org Git - packages/blob - xemacs-packages/Sun/sun-eos-editor.el

   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