ongoing

cl-json_0.4.0/src/objects.lisp

@@ -195,7 +195,7 @@ allocated and added to the *CLASS-REGISTRY*."
                       (append superclasses (list 'fluid-object)))))
          (extant-class-etc
           (member superclasses *class-registry*
-                  :test #'equal :key #'class-direct-superclasses))
+                  :test #'equal :key #'mop:class-direct-superclasses))
          (extant-class (car extant-class-etc))
          (updated-class
           (ensure-fluid-class-with-slots

layout.lisp

@@ -22,17 +22,25 @@
   allow-shrink-x allow-shrink-y
   allow-stretch-x allow-stretch-y)
 
-(export! visible collapsed)
+
+
 (defun visible (self)
   (equal (visibility self) "visible"))
 
+(defun hidden (self)
+  (equal (visibility self) "hidden"))
+
 (defun collapsed (self)
   (equal (visibility self) "excluded"))
 
-(defmacro cfg (f)
-  (let ((x (gensym)))
-    `(b-when ,x (,f self)
-       (list (cons ,(intern f :keyword) ,x)))))
+(defun vis/not (b)
+  (if b "visible" "hidden"))
+
+(defmacro vis/collapsed (b)
+  (if b "visible" "excluded"))
+
+(export! visible collapsed hidden vis/not vis/collapsed)
+
 
 (defmethod qx-configurations append ((self qx-layout-item))
   (nconc

qooxlisp.lisp

@@ -14,45 +14,11 @@
 
 (defun dfail (&rest x) (apply 'error x))
 
-(export! qx-callback-js qx-callback-json make-qx-instance) ;;>>> maybe not once start-up inherits
+(defparameter *session-ct* 0)
 
-(defun qx-callback-js (req ent)
-  (with-js-response (req ent) 
-    (with-integrity ()
-      (b-if session (b-if sessId (parse-integer (req-val req "sessId") :junk-allowed t)
-                      (gethash sessId *qx-sessions*)
-                      (warn "Invalid sessId parameter ~s in callback req: ~a" (req-val req "sessId")
-                        (list (req-val req "opcode") (req-val req "oid"))))
-        (b-if self (b-if oid (parse-integer (req-val req "oid") :junk-allowed t)
-                     (gethash oid (dictionary session))
-                     (warn "Invalid oid parameter ~s in callback req: ~a" (req-val req "oid")
-                       (list (req-val req "sessId")(req-val req "opcode"))))
-          (let ((opcode (qxl-sym (req-val req "opcode"))))
-            ;(mprt :callback opcode :self self :req (request-raw-request req))
-            (b-if cb (funcall opcode self)
-              (funcall cb self req)
-              (dwarn "Widget ~a oid ~a in session ~a has no handler for ~a callback " self (oid self) (session-id session) opcode)))
-          (dwarn "Widget not found for oid ~a in session ~a for ~a callback" (oid self) (session-id session) (req-val req "opcode")))
-        (dwarn "Unknown session ID ~a in callback: ~a" (req-val req "sessId") 
-          (list (req-val req "opcode") (req-val req "oid")))))))
+(defvar *web-session*)
 
-(export! gethtml)
-
-(defun qx-callback-json (req ent)
-  (with-integrity ()
-    (with-json-response (req ent)
-      (b-if session (b-if sessId (parse-integer (req-val req "sessId") :junk-allowed t)
-                      (gethash sessId *qx-sessions*)
-                      (warn "Invalid sessId parameter ~s in callback req: ~a" (req-val req "sessId")
-                        (list (req-val req "opcode") (req-val req "oid"))))
-        (b-if self (b-if oid (parse-integer (req-val req "oid") :junk-allowed t)
-                     (gethash oid (dictionary session))
-                     (warn "Invalid oid parameter ~s in callback req: ~a" (req-val req "oid")
-                       (list (req-val req "sessId")(req-val req "opcode"))))
-          (funcall (qxl-sym (req-val req "opcode")) self req)
-          (dwarn "Widget not found for oid ~a in session ~a for ~a callback" (oid self) (session-id session) (req-val req "opcode")))
-        (dwarn "Unknown session ID ~a in callback: ~a" (req-val req "sessId") 
-          (list (req-val req "opcode") (req-val req "oid")))))))
+(defparameter *qx-sessions* (make-hash-table))
 
 (defun qx-reset ()
   (cells-reset 'qxl-user-queue-handler)

qooxlisp.lpr

@@ -15,8 +15,8 @@
                  (make-instance 'module :name "control.lisp"))
   :projects (list (make-instance 'project-module :name "../cells/cells" :show-modules
                                  nil)
-                  (make-instance 'project-module :name "../cl-json/cl-json" :show-modules
-                                 nil))
+                  (make-instance 'project-module :name "cl-json_0.4.0/cl-json"
+                                 :show-modules nil))
   :libraries nil
   :editable-files (list "qooxlisp.asd")
   :distributed-files nil

qx-utils.lisp

@@ -10,6 +10,27 @@
 
 (in-package :qxl)
 
+(defconstant +qx-alt-key-mask+ 4)
+(defconstant +qx-shift-key-mask+ 1)
+(defconstant +qx-control-key-mask+ 2)
+(defconstant +qx-meta-key-mask+ 8)
+
+(defun qx-alt-key-p (x)
+  (logtest +qx-alt-key-mask+ (if (stringp x) (parse-integer x) x)))
+
+(defun qx-control-key-p (x)
+  (logtest +qx-control-key-mask+ (if (stringp x) (parse-integer x) x)))
+
+(defun qx-shift-key-p (x)
+  (logtest +qx-shift-key-mask+ (if (stringp x) (parse-integer x) x)))
+
+(export! qx-alt-key-p qx-control-key-p qx-shift-key-p)
+
+(defmacro cfg (f)
+  (let ((x (gensym)))
+    `(b-when ,x (,f self)
+       (list (cons ,(intern f :keyword) ,x)))))
+
 (defun k-word (s)
   (when s (if (consp s) (mapcar 'k-word s)
             (intern s :keyword))))
@@ -42,14 +63,18 @@
            ,@body)))))
 
 (defparameter *js-response* nil)
+(defparameter *ekojs* t)
 
 (defmacro with-js-response ((req ent) &body body)
   `(prog1 nil
      (net.aserve:with-http-response (,req ,ent :content-type "text/javascript")
        (net.aserve:with-http-body (,req ,ent)
          (setf *js-response* nil)
          ,@body ;; this populates *js-response*
-         ;; (print `(,*js-response*))
+         (when *ekojs*
+           (mprt :ekojs *js-response*)
+           ;;(mprt :ekojsrq (rq-raw ,req))
+           )
          ;;(push *js-response* (responses session))
          (qxl:whtml (:princ (format nil "(function () {~a})();" (or *js-response* "null;"))))))))
 
@@ -151,10 +176,6 @@
      :layout (c? (mk-layout self 'qx-vbox ,@layo-iargs))
      :kids (c? (the-kids ,@kids))))
 
-(defmd qxl-stack (qx-composite)
-  (layout-iargs nil :cell nil)
-  :layout (c? (make-layout self 'qx-vbox (layout-iargs self))))
-
 ;;;(defmacro vbox ((&rest layout-iargs)(&rest compo-iargs) &rest kids)
 ;;;  `(make-kid 'qxl-stack
 ;;;     ,@compo-iargs
@@ -168,6 +189,15 @@
      :layout (c? (mk-layout self 'qx-vbox ,@layout-iargs))
      :kids (c-in (the-kids ,@kids))))
 
+(defmd qxl-stack (qx-composite)
+  layout-iargs
+  :layout (c? (make-layout self 'qx-vbox (^layout-iargs))))
+
+(export! qxl-row)
+(defmd qxl-row (qx-composite)
+  layout-iargs
+  :layout (c? (make-layout self 'qx-hbox (^layout-iargs))))
+
 (defmacro vboxn ((&rest layout-iargs)(&rest compo-iargs) &rest kids)
   "vbox where kids are altered procedurally"
   `(make-kid 'qx-composite

session.lisp

@@ -26,26 +26,27 @@
             (qxfmt "clDict[~a].add(clDict[~a],~a);" (oid self) (oid k) ao)
             (qxfmt "clDict[~a].add(clDict[~a]);" (oid self) (oid k))))))
 
-(defparameter *session-ct* 0)
-(defparameter *qx-sessions* (make-hash-table))
-
 (defmd qxl-session (qooxlisp-family)
   (session-id (incf *session-ct*) :cell nil)
   (oid 0 :cell nil)
   (dictionary (make-hash-table) :cell nil)
+  :registry? t
   (next-oid 1 :cell nil)
   (theme "qx.theme.Modern")
   (responses nil :cell nil)
   (focus (c-in nil))
+  keyboard-modifiers ;; not sure if this holdover gets kept
   )
 
 (defmethod initialize-instance :after ((self qxl-session) &key)
   (assert (null (gethash (session-id self) *qx-sessions*)))
   (setf (gethash (session-id self) *qx-sessions*) self))
 
-(export! .focus .focused)
-(define-symbol-macro .session (n^ qxl-session))
-(define-symbol-macro .focus (focus .session))
+(export! .focus .focused *web-session* ^session)
+
+
+(define-symbol-macro ^session (n^ qxl-session))
+(define-symbol-macro .focus (focus ^session))
 (define-symbol-macro .focused (eq self .focus))
 
 (defmethod session ((self qxl-session)) self)
@@ -84,3 +85,43 @@ sessId=~a;" (session-id self)))
                               (dfail "session-focus: oid ~s not in dictionary" oid))
                             (dfail "session-focus: No oid parameter: ~s" (rq-raw req)))
           (setf (focus session) new-focus))))))
+
+(export! qx-callback-js qx-callback-json make-qx-instance) ;;>>> maybe not once start-up inherits
+
+(defun qx-callback-js (req ent)
+  (with-js-response (req ent) 
+    (with-integrity ()
+      (b-if *web-session* (b-if sessId (parse-integer (req-val req "sessId") :junk-allowed t)
+                      (gethash sessId *qx-sessions*)
+                      (warn "Invalid sessId parameter ~s in callback req: ~a" (req-val req "sessId")
+                        (list (req-val req "opcode") (req-val req "oid"))))
+        (b-if self (b-if oid (parse-integer (req-val req "oid") :junk-allowed t)
+                     (gethash oid (dictionary *web-session*))
+                     (warn "Invalid oid parameter ~s in callback req: ~a" (req-val req "oid")
+                       (list (req-val req "sessId")(req-val req "opcode"))))
+          (let ((opcode (qxl-sym (req-val req "opcode"))))
+            ;(mprt :callback opcode :self self :req (request-raw-request req))
+            (b-if cb (funcall opcode self)
+              (funcall cb self req)
+              (dwarn "Widget ~a oid ~a in session ~a has no handler for ~a callback " self (oid self) (session-id *web-session*) opcode)))
+          (dwarn "Widget not found for oid ~a in session ~a for ~a callback" (oid self) (session-id *web-session*) (req-val req "opcode")))
+        (dwarn "Unknown session ID ~a in callback: ~a" (req-val req "sessId") 
+          (list (req-val req "opcode") (req-val req "oid")))))))
+
+(export! gethtml)
+
+(defun qx-callback-json (req ent)
+  (with-integrity ()
+    (with-json-response (req ent)
+      (b-if *web-session* (b-if sessId (parse-integer (req-val req "sessId") :junk-allowed t)
+                      (gethash sessId *qx-sessions*)
+                      (warn "Invalid sessId parameter ~s in callback req: ~a" (req-val req "sessId")
+                        (list (req-val req "opcode") (req-val req "oid"))))
+        (b-if self (b-if oid (parse-integer (req-val req "oid") :junk-allowed t)
+                     (gethash oid (dictionary *web-session*))
+                     (warn "Invalid oid parameter ~s in callback req: ~a" (req-val req "oid")
+                       (list (req-val req "sessId")(req-val req "opcode"))))
+          (funcall (qxl-sym (req-val req "opcode")) self req)
+          (dwarn "Widget not found for oid ~a in session ~a for ~a callback" (oid self) (session-id *web-session*) (req-val req "opcode")))
+        (dwarn "Unknown session ID ~a in callback: ~a" (req-val req "sessId") 
+          (list (req-val req "opcode") (req-val req "oid")))))))