start working on splitting browser code into separate file(s)

contrib/slimy/package.lisp

@@ -0,0 +1,46 @@
+(cl:in-package #:cl-user)
+(cl:defpackage #:web-socket-js
+  (:export #:*web-socket
+           #:__swf-location
+           #:__debug
+           #:+web_socket_swf_location+
+           #:+web_socket_debug+))
+(cl:defpackage #:slimy
+  (:use :cl :ps))
+
+#++
+(ps:obfuscate-package '#:slimy)
+#++
+(ps:unobfuscate-package '#:slimy)
+#++
+(ps:obfuscate-package '#:slimy
+  (let ((code-pt-counter #x100)
+        (symbol-map (make-hash-table)))
+    (lambda (symbol)
+      (or (gethash symbol symbol-map)
+          (setf (gethash symbol symbol-map)
+                (make-symbol (string (code-char (incf code-pt-counter)))))))))
+
+;;; this stuff should probably be somewhere else...
+(in-package #:slimy)
+;; wip hack for making functions in objects nicer to deal with
+;; across slime-proxy:
+;; store the function body as a lambda in the specified object
+;; and define a macro so the function/arglist/etc show up in ps,
+;; which expands to a call to the function in the object/
+(defpsmacro defun-wrapped ((&rest scoped-name) lambda-list &body body)
+  (let ((w (gensym)))
+    (print
+     `(progn
+        (defmacro ,(car (last scoped-name)) (&whole ,w ,@lambda-list)
+          `(funcall (ps:@ ,@',scoped-name) ,@(cdr ,w)))
+        (setf (@ ,@scoped-name)
+              (lambda ,lambda-list
+                ,@body))
+        ))))
+;; same thing for variables, member in object + symbol-macro to access it
+(defpsmacro defvar-wrapped ((&rest scoped-name) value)
+  `(progn
+     (define-symbol-macro ,(car (last scoped-name))
+         (ps:@ ,@scoped-name))
+       (setf (@ ,@scoped-name) ,value)))

contrib/slimy/slimy-ui.ps.lisp

@@ -0,0 +1,157 @@
+;;; -*- Mode: LISP; slime-proxy-proxy-connection: t -*-
+(in-package :slimy)
+
+(defvar #:+swank_proxy_ui+ (or #:+swank_proxy_ui+ (create)))
+
+(defun-wrapped (+swank_proxy_ui+ line) (message)
+  (let ((cc ($ "#slime-proxy-console-output")))
+    (chain cc
+           (append (ps-html ((:div :style "white-space:pre-wrap")))))
+    (chain cc (children) (last)
+           (text message)))
+  (let ((cc ($ "#slime-proxy-console-output")))
+    (chain cc
+           (scroll-top (- (chain cc (prop "scrollHeight"))
+                          (chain cc (height)))))))
+
+(defun-wrapped (+swank_proxy_ui+ html-line) (message)
+  (let ((cc ($ "#slime-proxy-console-output")))
+    (chain cc
+           (append (ps-html ((:div :style "white-space:pre-wrap") message)))
+           (scroll-top (- (chain cc (prop "scrollHeight"))
+                          (chain cc (height)))))))
+
+(defvar-wrapped (+swank_proxy_ui+ console-commands) (create))
+
+(defun-wrapped (+swank_proxy_ui+ handle-console-input) (input)
+  ;;default input parser, not very smart... eventually should be configurable
+  (let* ((parts (chain input (split " ")))
+         (cmd (aref console-commands (chain parts (shift)))))
+    (chain ($ "#slime-proxy-console-input-text") (val ""))
+    ;; fixme: decide where this goes or conditionalize it or something
+    (send-message (+ "input: " input))
+    (line (+ "> " input ""))
+    (when cmd
+      (apply cmd parts))))
+
+(defun-wrapped (+swank_proxy_ui+ input-submit-handler) ()
+  (let* ((input (chain ($ "#slime-proxy-console-input-text") (val))))
+    (handle-console-input input))
+  #:false
+)
+(defun-wrapped (+swank_proxy_ui+ init) ()
+  (let ((cc ($ "#slime-proxy-console")))
+    ;; create a div to use for the UI if it doens't already exist
+    (when (= 0 (chain cc (size)))
+      (chain ($ "body")
+             (append (ps-html ((:div :id "slime-proxy-console") "cc"))))
+      (setf cc ($ "#slime-proxy-console")))
+    ;; and configure it TODO: move more of this to separate .css?
+    (chain cc
+           (css (create "position" "fixed"
+                        "bottom" "0"
+                        "left" "1em"
+                        "color" "green"
+                        "border" "green"
+                        "border-style" "double"
+                        "padding" "0.7em"
+                        ;; see http://stackoverflow.com/questions/806000/css-semi-transparent-background-but-not-text for IE versions...
+                        "background" "rgb(0,0,0) transparent"
+                        "background" "rgba(0,0,0,0.9) "
+                        "opacity" "1"
+                        "height" "auto"
+                        ;"max-height" "30em"
+                        "width" "60em"
+                        "overflow" "visible"
+                        "font-family" "monospace"
+                        "font-size" "8pt"))
+           (html
+            (ps-html
+             ((:div :id "slime-proxy-console-output"
+                    :style "overflow:auto; max-height:30em;")
+              (:h2 "..."))
+             ((:div :id "slime-proxy-console-input"
+                    :style "border-top:1px solid green"
+                    :width "auto")
+              ((:span :style "position:absolute;margin:none") "> ")
+              ((:form :id "slime-proxy-console-input-form"
+                      :action "#"
+                      :style "width:auto;margin:0;padding:0;border:0"
+                      :onsubmit (ps-inline (progn (input-submit-handler)
+                                                  (return #:false))))
+               ((:input :type :text
+                        :id "slime-proxy-console-input-text"
+                        :style "text-indent:1.5em;margin:0;width:100%;background:none;color:green;border:0"
+                        :on))))))))
+  nil)
+#++
+(init)
+
+(defun-wrapped (+swank_proxy_ui+ embed) ()
+  (chain ($ "#slime-proxy-console") (css (create "position" "relative"))))
+(defun-wrapped (+swank_proxy_ui+ float) ()
+  (chain ($ "#slime-proxy-console") (css (create "position" "fixed"))))
+(defun-wrapped (+swank_proxy_ui+ clear) ()
+  (chain ($ "#slime-proxy-console-output")
+         (empty)))
+
+
+;;; default console commands
+
+;; todo: useful help message
+(setf (@ console-commands "?") (lambda () (line "halp!"))
+      (@ console-commands "help") (@ console-commands "?"))
+
+(setf (@ console-commands "clear") (lambda () (clear)))
+
+(setf (@ console-commands "look")
+      (lambda ()
+        (line "You are on an infinite, featureless plane. You can go N,E,S,W."))
+      (@ console-commands "l") (@ console-commands "look"))
+(setf (@ console-commands "N") (lambda () (line "You go north."))
+      (@ console-commands "n") (@ console-commands "N"))
+(setf (@ console-commands "S") (lambda () (line "You go south."))
+      (@ console-commands "s") (@ console-commands "S"))
+(setf (@ console-commands "E") (lambda () (line "You go east."))
+      (@ console-commands "e") (@ console-commands "E"))
+(setf (@ console-commands "W") (lambda () (line "You go west."))
+      (@ console-commands "w") (@ console-commands "W"))
+
+(setf (@ console-commands "ls")
+      (lambda ()
+        (line ". ..")
+        (line "It's a UNIX system. I know this!")))
+
+(setf (@ console-commands "(+")
+      (lambda () (line "3")))
+
+
+;;; initialize console once document is loaded
+(chain ($ "document") (ready (lambda ()
+                               ((@ console log) "ready")
+                               ((@ +swank_proxy_ui+ init)))))
+
+#++
+(ps:chain ($ "#hh") (hide "fast"))
+#++
+(ps:chain ($ "#hh") (show "slow"))
+
+#++
+(ps:chain ($ "#hh") (parent) (append "<h1>test2</h1>"))
+#++
+(ps:chain ($ "body") (append "<h1>test3</h1>")
+          (children)
+          (last)
+          (hide)
+          (show "slow")
+          (end) (css (create "border" "0")) (end)
+          (css (create "border" "1px solid green")))
+
+
+#++
+(line "foo23!")
+
+#++
+(chain ($ "#slime-proxy-console") (get 0))
+
+

contrib/slimy/slimy.ps.lisp

@@ -0,0 +1,131 @@
+;;; -*- Mode: LISP; slime-proxy-proxy-connection: t -*-
+(in-package :slimy)
+
+(defvar #:+swank_proxy+ (or #:+swank_proxy+ (create)))
+(defvar #:+swank_proxy_impl+ (or #:+swank_proxy_impl+ (create)))
+
+(setf (@ web-socket-js:*web-socket web-socket-js:__swf-location)
+      "web-socket-js/WebSocketMain.swf"
+      web-socket-js:+web_socket_swf_location+
+      "web-socket-js/WebSocketMain.swf")
+
+(setf (@ web-socket-js:*web-socket web-socket-js:__debug)
+      #:true
+      web-socket-js:+web_socket_debug+
+      #:true)
+
+(defvar-wrapped (+swank_proxy_impl+ ws) (or (@ +swank_proxy_impl+ ws) #:null))
+(defvar-wrapped (+swank_proxy_impl+ count) 0)
+(defvar-wrapped (+swank_proxy_impl+ active) nil)
+(defvar-wrapped (+swank_proxy_impl+ ui) nil)
+
+(defun-wrapped (+swank_proxy_impl+ toplevel-eval) (form)
+  ((@ window eval) form))
+
+(defun-wrapped (+swank_proxy_impl+ output) (message)
+  (when ui
+    (if (= message "")
+        ((@ ui line) "")
+        ((@ ui line) message)))
+  (when (and console (@ console log)
+             (/= message ""))
+    ((@ console log)
+     (+ "slimy: " message)))
+  )
+(defun-wrapped (+swank_proxy_impl+ clear-output) ()
+  (when ui
+    (chain ui (clear))))
+
+(defun-wrapped (+swank_proxy_impl+ format-result) (value)
+  (if (= "object" (typeof value))
+      (try
+       ((@ value to-source))
+       (:catch (e)
+         ((@ #:+json+ #:stringify) value)))
+      ((@ #:+json+ #:stringify) value)))
+
+
+(defun-wrapped (+swank_proxy_impl+ handle-message) (msg)
+  #++(clear-output)
+  #++(output (+ "onmessage:" msg))
+  (try (let ((j ((@ #:+json+ #:parse)
+                 msg)))
+         (cond
+           ((@ j "FORM")
+            (let ((r (toplevel-eval (@ j "FORM"))))
+              (output "")
+              (output (+ "eval [" (@ j "ID")
+                         "]: " (@ j "FORM")))
+              (when active
+                ((@ ws #:send) ((@ #:+json+ #:stringify)
+                                (create "OK" #:true
+                                        "RESULT" r
+                                        "ID" (@ j "ID")))))
+              (output (+ " ->: " (format-result
+                                       r)))))
+           ((@ j "ACTIVATE")
+            (output (+ "@@ activate : " (@ j "ACTIVE")))
+            (setf active (@ j "ACTIVE")))
+           ((@ j "MESSAGE")
+            (output (+ "message: " (@ j "MESSAGE"))))))
+       (:catch (e)
+         (when (@ j "FORM")
+           (when (and console (@ console log))
+             ((@ console log)
+              (+ "eval error: " e)))
+           (when active
+             ((@ ws #:send) (+ ""
+                               ((@ #:+json+ #:stringify)
+                                (create "OK" #:false
+                                        "RESULT" #:null
+                                        "ERROR" e
+                                        "ID" (@ j "ID")))))))))
+  (return))
+
+(defun-wrapped (+swank_proxy+ send-message) (message)
+  (when ws
+    ((@ ws #:send) message)))
+
+(defun-wrapped (+swank_proxy+ close) ()
+  (when ws
+    ((@ ws #:close))))
+
+(defun-wrapped (+swank_proxy+ init) ()
+  (when ws
+    (close))
+  (when (/= (typeof +swank_proxy_ui+) "undefined")
+    ((@ console log) "ui")
+    (setf ui +swank_proxy_ui+))
+  (setf ws (new (#:*web-socket
+                 (+ "ws://" (@ window location hostname) ":12344/swank")))
+        (@ ws #:onopen) (lambda ()
+                          (output "onopen"))
+        (@ ws #:onmessage) (lambda (e)
+                             (handle-message (@ e data)))
+        (@ ws #:onclose) (lambda ()
+                           (output "onclose"))
+        (@ ws #:onerror) (lambda ()
+                           (output "onerror"))))
+
+(when (/= (typeof +swank_proxy_ui+) "undefined")
+  (setf (@ console-commands "activate")
+        (lambda () (output "trying to activate...") (send-message "activate")))
+  (setf (@ console-commands "sync")
+        (lambda () (send-message "sync")))
+  (setf (@ console-commands "kick")
+        (lambda () (send-message "kick me"))))
+
+(init)
+
+#++
+(setf (@ ((@ document get-element-by-id ) "hh") inner-h-t-m-l)
+      "testing123!")
+#++
+(setf (@ ((@ document get-element-by-id ) "hh") inner-h-t-m-l)
+      count1)
+
+#++
+((@ +swank_proxy+ send-message) "sync")
+
+#++
+((@ +swank_proxy+ send-message) "activate")