Skip to content
Browse files

ongoing

  • Loading branch information...
1 parent eca6203 commit 2540794b0ebf38e01b09d19099861a0d5bbdbecd @kennytilton committed Jun 18, 2010
Showing with 101 additions and 56 deletions.
  1. +1 −1 cl-json_0.4.0/src/objects.lisp
  2. +13 −5 layout.lisp
  3. +3 −37 qooxlisp.lisp
  4. +2 −2 qooxlisp.lpr
  5. +35 −5 qx-utils.lisp
  6. +47 −6 session.lisp
View
2 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
View
18 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
View
40 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)
View
4 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
View
40 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
View
53 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")))))))

0 comments on commit 2540794

Please sign in to comment.
Something went wrong with that request. Please try again.