Bug 470455 - test_database_sync_embed_visits.js leaks, r=sdwilsh
[wine-gecko.git] / extensions / jssh / xemacs / moz-jssh.el
blob90201dc9e2425198879ee2fc90d7c5179790fbbc
1 ;;; moz-jssh.el
2 ;;; utilities for connecting to a live mozilla jssh server
3 ;;;
4 ;;; copyright (c)2003 Alex Fritze <alex@croczilla.com>
6 (provide 'moz-jssh)
7 (require 'cl)
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")
12 ;; ----------------------------------------------------------------------
13 ;; Functions for evaluating js code
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))
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))
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))
85 ;; remove filter, so that future output goes whereever it is supposed to:
86 (set-process-filter process nil))
87 result))
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)))
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)))))
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
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))
159 (apply 'moz-jssh-eval-anonymous
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)))
169 (defvar moz-jssh-buffer-globalobj nil "js object that a call to
170 `moz-jssh-eval-buffer' will be evaluted on.")
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))
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)))
203 ;; ----------------------------------------------------------------------
204 ;; some inspection functions:
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)))
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)))
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. "
246 (interactive)
247 (require 'comint)
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*"))
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."
262 (interactive)
263 (require 'comint)
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)
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)))
285 ;; ----------------------------------------------------------------------
286 ;; Major mode for moz-jssh buffers
288 (defvar moz-jssh-mode-map nil)
290 (defun moz-jssh-mode-commands (map)
291 (define-key map [(home)] 'comint-bol)
292 (define-key map [(control c)(i)] 'moz-jssh-inspect))
294 (defun moz-jssh-mode ()
295 "Major mode for interacting with a Mozilla JavaScript shell.
296 \\{moz-jssh-mode-map}
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
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))
308 ;;----------------------------------------------------------------------
309 ;; global keybindings
311 (if (keymapp 'moz-prefix)
313 (define-prefix-command 'moz-prefix)
314 (global-set-key [(control c) m] 'moz-prefix))
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)