Commit e0121a28 authored by Dave Cooper's avatar Dave Cooper

added form in tasty for required-inputs

parent 97c98521
;;
;; Copyright 2002, 2009, 2012 Genworks International
;; Copyright 2014 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
......@@ -30,6 +30,10 @@ o support for multiple viewports
o filter inspector slots to local slots
o make Update! work properly for pre-made object expression.
o allow input of required input-slots.
|#
......@@ -63,19 +67,23 @@ o filter inspector slots to local slots
(the (set-slot! :root-object (the root-object)))
(the tree update!)))
(use-jquery? (the have-valid-instance?))
(use-raphael? (the have-valid-instance?))
(use-x3dom? (the have-valid-instance?))
(use-jquery? (the have-valid-instance-and-inputs?))
(use-raphael? (the have-valid-instance-and-inputs?))
(use-x3dom? (the have-valid-instance-and-inputs?))
)
:computed-slots
(
(ui-specific-layout-js (when (the use-jquery?) "/static/gwl/js/tasty-initlayout-3.js"))
(have-valid-instance? (not (typep (the root-object) 'null-part)))
(additional-header-content (when (the have-valid-instance?)
(have-valid-instance-and-inputs? (and (the have-valid-instance?)
(the required-inputs-satisfied?)))
(additional-header-content (when (the have-valid-instance-and-inputs?)
(the ta2-style-view)))
(ta2-style-view (with-cl-who-string ()
......@@ -107,6 +115,8 @@ o filter inspector slots to local slots
;;(color-selected :red)
(required-inputs-satisfied? (the required-inputs-form satisfied?))
)
:hidden-objects
......@@ -141,6 +151,10 @@ o filter inspector slots to local slots
(the (make-root-instance type))))
(required-inputs-form :type 'required-inputs-form
:root-object (the root-object-object)
:tatu-root self)
(tree
:type 'tree:newertree
;;:type 'tree:tree
......@@ -337,10 +351,19 @@ The error was: ~a
((main-sheet-body
()
(if (the have-valid-instance?)
(write-the ui-sheet)
(write-the part-type-form main-sheet)))
(cond ((and (the have-valid-instance?)
(the required-inputs-satisfied?))
(write-the ui-sheet))
((the have-valid-instance?)
(write-the required-inputs-form))
(t (write-the part-type-form main-sheet))))
(required-inputs-form
()
(write-the required-inputs-form main-sheet))
(ui-sheet
()
(with-cl-who (:indent t)
......
;;
;; Copyright 2002, 2009 Genworks International and Genworks BV
;; Copyright 2014 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
......@@ -60,3 +60,66 @@
(:td ((:input :type :string :name :object-expression :size 40 :value
(the object-expression)))))
(:tr (:td :br) (:td ((:input :type :submit :name :submit :value " Browse!"))))))))))
(defparameter *test-self* nil)
(define-object required-inputs-form (base-html-sheet)
:input-slots
(root-object tatu-root)
:computed-slots
((respondent (the tatu-root))
(required-input-slots (the root-object (message-list :category :required-input-slots)))
(satisfied-toggle nil :settable)
(satisfied? (progn (the satisfied-toggle)
(let ((result t))
(dolist (slot (the required-input-slots))
(let ((status (the root-object (slot-status slot))))
(when (eql status :unbound) (setq result nil))))
(print-variables result)
result))))
:objects
((required-input-inputs :type 'text-form-control
:sequence (:size (length (the required-input-slots)))
:pseudo-inputs (keyword)
:size 20
:domain :pass-thru
:keyword (nth (the-child index)(the required-input-slots))
:default :unbound
:prompt (the-child keyword)))
:functions
(
(after-set!
()
(setq *test-self* (the root-object))
(format t "In the after-set! of the required-inputs-form...~%")
(dolist (slot (list-elements (the required-input-inputs)))
(unless (eql (the-object slot value) :unbound)
(the root-object (set-slot! (the-object slot keyword)
(the-object slot value)))))
(the (set-slot! :satisfied-toggle (not (the satisfied-toggle)))))))
(define-lens (html-format required-inputs-form)()
:output-functions
((main-sheet
()
(with-cl-who ()
(with-html-form (:cl-who? t)
(dolist (slot (list-elements (the required-input-inputs)))
(htm (:p (str (the-object slot html-string)))))
(:p ((:input :type :submit :name :submit :value " Browse!"))))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment