extensions/jssh/xemacs/moz-jssh.el

   1 ;;; moz-jssh.el
   2 ;;; utilities for connecting to a live mozilla jssh server
   3 ;;;
   4 ;;; copyright (c)2003 Alex Fritze <alex@croczilla.com>
   5
   6 (provide 'moz-jssh)
   7 (require 'cl)
   8
   9 (defvar moz-jssh-host "localhost" "*Host that JSSh server is running on")
  10 (defvar moz-jssh-port 9997 "*Port that JSSh service is running on")
  11
  12 ;; ----------------------------------------------------------------------
  13 ;; Functions for evaluating js code
  14
  15 (defun* moz-jssh-eval-internal (command process &key obj)
  16   "Execute js command line 'command' for jssh process 'process'. If the
  17 optional arg :obj is specified, the command will be executed on the
  18 given object. Newlines in 'command' will be replaced with a space and comments will be properly escaped."
  19   (let ((finished nil)
  20         (result "")
  21         (unparsed "")
  22         (parse-reply (function (lambda (str)
  23                                  (cond ((string-match "^\\[\\([^\]]*\\)\\]" str)
  24                                         (let ((l (string-to-number
  25                                                   (substring str
  26                                                              (match-beginning 1)
  27                                                              (match-end 1))))
  28                                               (start (+ 1 (match-end 1))))
  29                                           (cond ((> (+ start l) (length str))
  30                                                  (setq unparsed str))
  31                                                 (t
  32                                                  (setq result
  33                                                        (concat result
  34                                                                (substring str
  35                                                                           start (+ start l))))
  36                                                  (funcall parse-reply (substring str (+ start l)))))))
  37                                        ((string-match "\n> $" str)
  38                                         (setq finished t))
  39                                        (t
  40                                         (setq unparsed str))))))
  41         (null-filter (function (lambda (proc mess) nil)))
  42         (receive-filter (function (lambda (proc mess)
  43                                     (setq mess (concat unparsed mess))
  44                                     (setq unparsed "")
  45                                     (funcall parse-reply mess)))))
  46     (unwind-protect
  47         (progn
  48           ;; set up the session
  49           (set-process-filter process null-filter)
  50           (process-send-string process (concat "__JSSH_protocol__ = getProtocol();"
  51                                                "setProtocol('synchronous');"
  52                                                (if obj (concat obj
  53                                                                ".__JSSH_shell__ = this;"
  54                                                                "setContextObj(" obj ");"))
  55                                                "\n"))
  56           ;; eat prompt
  57           (accept-process-output process)
  58           ;; send the command
  59           ;; XXX our protocol currently requires that there is a single
  60           ;; newline at the end of the command only (have to be careful with
  61           ;; '//'-style comments and '//' in strings):
  62           (let ((commandlist (split-string command "\n")))
  63             (setq commandlist (mapcar (lambda (s)
  64                                         (replace-in-string s "^\\(\\(\\(/[^/]\\)\\|[^\"/]\\|\\(\"[^\"]*\"\\)\\)*\\)\\(//.*\\)$" "\\1 "))
  65                                       commandlist))
  66             (setq command (apply 'concat commandlist)))
  67           ;;(setq result (concat result "Command:\n" command "\n\nResult:\n"))
  68           (set-process-filter process receive-filter)
  69           (process-send-string process (concat command "\n"))
  70           ;; wait for output
  71           (while (not finished) (accept-process-output process))
  72           ;; now restore the session
  73           (set-process-filter process null-filter)
  74           (if obj
  75               (progn
  76                 (process-send-string process "__JSSH_shell__.setContextObj(__JSSH_shell__)\n")
  77                 ;; eat prompt
  78                 (accept-process-output process)))
  79           (process-send-string process (concat "setProtocol(__JSSH_protocol__);"
  80                                                "delete __JSSH_protocol__;"
  81                                                "delete " (if obj obj "this") ".__JSSH_shell__;\n"))
  82           ;; eat prompt
  83           (accept-process-output process))
  84
  85       ;; remove filter, so that future output goes whereever it is supposed to:
  86       (set-process-filter process nil))
  87     result))
  88
  89 (defun* moz-jssh-eval-anonymous (command &rest rest &key &allow-other-keys)
  90   "Evaluate a command in a temporary anonymous Mozilla JavaScript
  91 shell. Optional keyed parameters will be passed to
  92 `moz-jssh-eval-internal'."
  93   (interactive "sCommand: ")
  94   (let ((initialized nil)
  95         (result nil)
  96         (conn (open-network-stream "moz-jssh"
  97                                    (buffer-name)
  98                                    moz-jssh-host moz-jssh-port)))
  99     (set-process-filter conn (function (lambda (proc mess)
 100                                          (if (string-match "\n> $" mess)
 101                                              (setq initialized t)))))
 102     (unwind-protect
 103         (progn
 104           (while (not initialized) (accept-process-output conn))
 105           (setq result (apply 'moz-jssh-eval-internal command conn :allow-other-keys t rest)))
 106       (delete-process conn))
 107     (if (interactive-p)
 108         (if (string-match "\n" result) ; more than one line
 109             (with-output-to-temp-buffer "*moz-jssh-eval-anonymous*"
 110               (princ result))
 111           (message "%s" result))
 112       result)))
 113
 114 (defun get-region-string ()
 115   "Helper to return the current region as a string, or nil otherwise."
 116   (let ((buf (zmacs-region-buffer)))
 117     (if buf
 118         (buffer-substring (mark t buf) (point buf)))))
 119
 120 (defun* moz-jssh-eval (&optional &rest rest &key cmd buffer &allow-other-keys)
 121   "Evaluate the jssh command line given by the active region, the cmd
 122 argument or interactively prompted for. If the optional argument
 123 buffer is given, the command will be executed for the jssh-process
 124 attached to that buffer. If the buffer doesn't have an attached
 125 jssh-process, or the arg doesn't name a valid buffer, then the command
 126 will be executed in a temporary shell.  If the argument buffer is not
 127 given, the command will be executed for the current buffer if that
 128 buffer has an attached jssh-process.  If it hasn't, the command will
 129 be executed in the buffer *moz-jssh* if it exists or in a temporary
 130 shell if there is no buffer called *moz-jssh*. Additional (keyed)
 131 arguments can be given and will be passed to
 132 `moz-jssh-eval-internal'."
 133   (interactive)
 134   (or cmd (setq cmd (get-region-string)))
 135   (if (and (interactive-p) (not cmd))
 136       (setq cmd (read-input "Command: ")))
 137   (let ((result (cond ((and (or (stringp buffer) (bufferp buffer))
 138                             (get-buffer-process buffer)
 139                             (string-match "moz-jssh" (process-name (get-buffer-process buffer))))
 140                        (apply 'moz-jssh-eval-internal
 141                               cmd
 142                               (get-buffer-process buffer)
 143                               :allow-other-keys t rest))
 144                       ((and (not buffer)
 145                             (get-buffer-process (current-buffer))
 146                             (string-match "moz-jssh" (process-name (get-buffer-process (current-buffer)))))
 147                        (apply 'moz-jssh-eval-internal
 148                               cmd
 149                               (get-buffer-process (current-buffer))
 150                               :allow-other-keys t rest))
 151                       ((and (not buffer)
 152                             (get-buffer-process "*moz-jssh*")
 153                             (string-match "moz-jssh" (process-name (get-buffer-process "*moz-jssh*"))))
 154                        (apply 'moz-jssh-eval-internal
 155                               cmd
 156                               (get-buffer-process "*moz-jssh*")
 157                               :allow-other-keys t rest))
 158                       (t
 159                        (apply 'moz-jssh-eval-anonymous
 160                               cmd
 161                               :allow-other-keys t rest)))))
 162     (if (interactive-p)
 163         (if (string-match "\n" result) ; more than one line
 164             (with-output-to-temp-buffer "*moz-jssh-eval*"
 165               (princ result))
 166           (message "%s" result)) result)))
 167
 168
 169 (defvar moz-jssh-buffer-globalobj nil "js object that a call to
 170 `moz-jssh-eval-buffer' will be evaluted on.")
 171
 172 (defun* moz-jssh-eval-buffer (&optional &rest rest &allow-other-keys)
 173 "Evaluate the current buffer in a jssh shell. If the variable
 174 `moz-jssh-buffer-globalobj' is not null and there is a jssh shell
 175 buffer called *moz-jssh*, then this buffer will be used as the
 176 executing shell. Otherwise a temporary shell will be created. The
 177 buffer content will be executed on the object given by
 178 `moz-jssh-buffer-globalobj' or on the shell's global object if
 179 `moz-jssh-buffer-globalobj' is null. Output will be shown in the
 180 buffer *moz-jssh-eval*. Additional (keyed) arguments can be given and
 181 will be passed to `moz-jssh-eval-internal'."
 182   (interactive)
 183   (let ((result (cond ((and (not moz-jssh-buffer-globalobj)
 184                             (get-buffer-process "*moz-jssh*")
 185                             (string-match "moz-jssh" (process-name (get-buffer-process "*moz-jssh*"))))
 186                        (apply 'moz-jssh-eval-internal
 187                               (buffer-string)
 188                               (get-buffer-process "*moz-jssh*")
 189                               :allow-other-keys t rest))
 190                       (t
 191                        (apply 'moz-jssh-eval-anonymous
 192                               (buffer-string)
 193                               :obj moz-jssh-buffer-globalobj
 194                               :allow-other-keys t rest)))))
 195     (if (interactive-p)
 196         (if (string-match "\n" result) ; more than one line
 197             (with-output-to-temp-buffer "*moz-jssh-eval*"
 198               (princ result))
 199           (message "%s" result)) result)))
 200
 201
 202
 203 ;; ----------------------------------------------------------------------
 204 ;; some inspection functions:
 205
 206 (defun* moz-jssh-inspect (obj &rest rest &allow-other-keys)
 207   "Inspect the given object"
 208   (interactive "sObject to inspect: ")
 209   (let ((result (apply 'moz-jssh-eval
 210                        :cmd (concat "inspect(" obj ");")
 211                        :allow-other-keys t rest)))
 212     (if (interactive-p)
 213         (if (string-match "\n" result) ; multi-line result
 214             (with-output-to-temp-buffer "*moz-jssh-inspect*"
 215               (save-excursion
 216                 (set-buffer "*moz-jssh-inspect*")
 217                 (javascript-mode)
 218                 (font-lock-mode))
 219               (princ (concat "inspect(" obj ") :\n" result)))
 220           (message "%s" (concat "inspect(" obj ") -> " result)))
 221       result)))
 222
 223 (defun* moz-jssh-inspect-interface (itf &rest rest &allow-other-keys)
 224   "Shows the IDL definition of the given interface"
 225   (interactive "sInterface name: ")
 226   (let ((result (apply 'moz-jssh-eval
 227                        :cmd (concat "dumpIDL(\"" itf "\");")
 228                        :allow-other-keys t rest)))
 229     (if (interactive-p)
 230         (if (string-match "\n" result) ; multi-line result
 231             (with-output-to-temp-buffer "*moz-jssh-inspect*"
 232               (save-excursion
 233                 (set-buffer "*moz-jssh-inspect*")
 234                 (idl-mode)
 235                 (font-lock-mode))
 236               (princ result))
 237           (message "%s" result))
 238       result)))
 239
 240
 241 ;; ----------------------------------------------------------------------
 242 ;; Shell for interacting with Mozilla through a JavaScript shell
 243 (defun moz-jssh ()
 244   "Connect to a running Mozilla JavaScript shell (jssh) server. "
 245
 246   (interactive)
 247   (require 'comint)
 248
 249   (unless (comint-check-proc "*moz-jssh*")
 250     (set-buffer
 251      (make-comint "moz-jssh" (cons moz-jssh-host moz-jssh-port)))
 252     (moz-jssh-mode))
 253   (pop-to-buffer "*moz-jssh*"))
 254
 255 ;; ----------------------------------------------------------------------
 256 ;; Open a shell for current buffer.
 257 (defun moz-jssh-buffer-shell ()
 258   "Connect to a running Mozilla JavaScript shell (jssh) server.  Same
 259 as `moz-jssh', but honours the variable moz-jssh-buffer-globalobj if
 260 defined."
 261
 262   (interactive)
 263   (require 'comint)
 264
 265   (let* ((procname (concat "moz-jssh"
 266                             (if moz-jssh-buffer-globalobj
 267                                 (concat "-" (buffer-name)))))
 268          (buffername (concat "*" procname "*"))
 269          ;; need to save gobj because it is buffer local & we're going
 270          ;; to switch buffers:
 271          (gobj moz-jssh-buffer-globalobj))
 272     (unless (comint-check-proc buffername)
 273       (set-buffer
 274        (make-comint procname (cons moz-jssh-host moz-jssh-port)))
 275       (moz-jssh-mode)
 276       (if (not gobj)
 277           ()
 278         ;; eat greeting & prompt before sending command. XXX this is
 279         ;; getting a bit dodgy.time to rewrite the protocol.
 280         (accept-process-output (get-buffer-process buffername) 1)
 281         (accept-process-output (get-buffer-process buffername) 1)
 282         (message "%s" (moz-jssh-eval :cmd (concat "pushContext(" gobj ")")))))
 283     (pop-to-buffer buffername)))
 284
 285 ;; ----------------------------------------------------------------------
 286 ;; Major mode for moz-jssh buffers
 287
 288 (defvar moz-jssh-mode-map nil)
 289
 290 (defun moz-jssh-mode-commands (map)
 291   (define-key map [(home)] 'comint-bol)
 292   (define-key map [(control c)(i)] 'moz-jssh-inspect))
 293
 294 (defun moz-jssh-mode ()
 295   "Major mode for interacting with a Mozilla JavaScript shell.
 296 \\{moz-jssh-mode-map}
 297 "
 298   (comint-mode)
 299   (setq comint-prompt-regexp "^> *"
 300         mode-name "moz-jssh"
 301         major-mode 'moz-jssh-mode)
 302   (if moz-jssh-mode-map
 303       nil
 304     (setq moz-jssh-mode-map (copy-keymap comint-mode-map)) ; XXX could inherit instead of copying
 305     (moz-jssh-mode-commands moz-jssh-mode-map))
 306   (use-local-map moz-jssh-mode-map))
 307
 308 ;;----------------------------------------------------------------------
 309 ;; global keybindings
 310
 311 (if (keymapp 'moz-prefix)
 312     ()
 313   (define-prefix-command 'moz-prefix)
 314   (global-set-key [(control c) m] 'moz-prefix))
 315
 316 (global-set-key [(control c) m j] 'moz-jssh)
 317 (global-set-key [(control c) m s] 'moz-jssh-buffer-shell)
 318 (global-set-key [(control c) m e] 'moz-jssh-eval-buffer)