rabbibotton
commented
2 years ago Very cool. I am trying to get the clog-web stuff done and out the door, (Cool stuff is coming... :) but I for sure will take a better look at this!!
Closed mmontone closed 2 years ago
rabbibotton
commented
2 years ago Very cool. I am trying to get the clog-web stuff done and out the door, (Cool stuff is coming... :) but I for sure will take a better look at this!!
sabracrolleton
commented
2 years ago Would be great if you could do this with nested sub-menus.
mmontone
commented
2 years ago Would be great if you could do this with nested sub-menus.
You can't? I haven't looked at sub-menus in CLOG ...
mmontone
commented
2 years ago Note that this macro supports any level of nesting ...
rabbibotton
commented
2 years ago How would you use this with tutorial 9?
mmontone
commented
2 years ago How would you use this with tutorial 9?
Ok. Let me try a rewrite and post it here .. I can't see what's special there .. but I'll need to try to figure out.
rabbibotton
commented
2 years ago mmontone
commented
2 years ago This is my rewrite for tutorial 9. I had to change with-gui macro because it had a bug.
(in-package :clog-tut-9)
(defmacro with-gui (obj spec &body body)
(flet ((extract-bind (args)
(when args
(let ((fargs ())
bind)
(do* ((i 0)
(x (nth i args) (nth i args)))
((>= i (length args)))
(if (eql x :bind)
(progn
(setf bind (nth (1+ i) args))
(incf i 2))
(progn
(push x fargs)
(incf i))))
(values (reverse fargs) bind)))))
(let ((let-bindings ())
(used-bindings ()))
(labels ((create-from-spec (spec parent-binding)
(destructuring-bind (gui-func-name args &body children)
spec
(multiple-value-bind (gui-func-args bind) (extract-bind args)
(let* ((binding (or bind (gensym)))
(create-func-name (intern (concatenate 'string "CREATE-" (symbol-name gui-func-name)))))
(push `(,binding (,create-func-name ,parent-binding ,@gui-func-args)) let-bindings)
(when (or bind children)
(push binding used-bindings))
(dolist (child-spec children)
(create-from-spec child-spec binding)))))))
(create-from-spec spec obj)
`(let* ,(reverse let-bindings)
(declare (ignore ,@(set-difference (mapcar #'first let-bindings) used-bindings)))
,@body)))))
(defun on-new-window-spec (body)
(setf (title (html-document body)) "Tutorial 9")
;; When doing extensive setup of a page using connection cache
;; reduces rountrip traffic and speeds setup considerably.
(with-connection-cache (body)
(let* (last-tab)
;; Note: Since the there is no need to use the tmp objects
;; we reuse the same symbol name (tmp) even though the
;; compiler can mark those for garbage collection early
;; this not an issue as the element is created already
;; in the browser window. This is probably not the best
;; option for a production app though regardless.
;;
;; Create tabs and panels
(with-gui body
(div ()
(button (:bind t1 :content "Tab1"))
(button (:bind t2 :content "Tab2"))
(button (:bind t3 :content "Tab3"))
(br ())
;; Panel 1
(div (:bind p1)
;; Create form for panel 1
(form (:bind f1)
(form-element (:bind fe1 :text :label (create-label f1 :content "Fill in blank:")))
(br ())
(form-element (:bind fe2 :color :value "#ffffff"
:label (create-label f1 :content "Pick a color:")))
(br ())
(form-element (:submit :value "OK"))
(form-element (:reset :value "Start Again"))))
;; Panel 2
(div (:bind p2)
;; Create form for panel 2
(form (:bind f2)
(fieldset (:bind fs2 :legend "Stuff")
(label (:bind lbl :content "Please type here:"))
(text-area (:bind ta1 :columns 60 :rows 8 :label lbl))
(br ())
(form-element (:bind rd1 :radio :name "rd"))
(label (:content "To Be" :label-for rd1))
(form-element (:bind rd2 :radio :name "rd"))
(label (:content "No to Be" :label-for rd2))
(br ())
(form-element (:bind ck1 :checkbox :name "ck"))
(label (:content "Here" :label-for ck1))
(form-element (:bind ck2 :checkbox :name "ck"))
(label (:content "There" :label-for ck2))
(br ())
(select (:bind sl1 :label (create-label fs2 :content "Pick one:")))
(select (:bind sl2 :label (create-label fs2 :content "Pick one:")))
(select (:bind sl3 :multiple t :label (create-label fs2 :content "Pick some:"))
(option (:content "one"))
(option (:bind o2 :content "two"))
(option (:content "three"))
(optgroup (:content "These are a group")
(option (:content "four"))
(option (:bind o5 :content "five")))))
(form-element (:submit :value "OK"))
(form-element (:reset :value "Start Again"))))
;; Panel 3
(div (:bind p3 :content "Panel3 - Type here")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 1 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (place-holder fe1) "type here..")
(setf (requiredp fe1) t)
(setf (size fe1) 60)
(make-data-list fe1 '("Cool Title"
"Not So Cool Title"
"Why Not, Another Title"))
(make-data-list fe2 '("#ffffff"
"#ff0000"
"#00ff00"
"#0000ff"
"#ff00ff"))
(set-on-submit f1
(lambda (obj)
(declare (ignore obj))
(setf (title (html-document body)) (value fe1))
(setf (background-color p1) (value fe2))
(setf (hiddenp f1) t)
(create-span p1 :content
"<br><b>Your form has been submitted</b>")))
(setf (width p1) "100%")
(setf (width p2) "100%")
(setf (width p3) "100%")
(setf (height p1) 400)
(setf (height p2) 400)
(setf (height p3) 400)
(set-border p1 :thin :solid :black)
(set-border p2 :thin :solid :black)
(set-border p3 :thin :solid :black)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 2 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (vertical-align ta1) :top)
(disable-resize ta1)
(setf (vertical-align sl1) :top)
(setf (vertical-align sl2) :top)
(setf (vertical-align sl3) :top)
(setf (size sl1) 3)
(add-select-options sl1 '("one"
"two"
"three"
"four"
"five"))
(add-select-options sl2 '("one"
"two"
"three"
"four"
"five"))
(set-on-change sl3 (lambda (obj)
(declare (ignore obj))
(when (selectedp o5)
(alert (window body) "Selected 5"))))
(set-on-submit f2
(lambda (obj)
(declare (ignore obj))
(setf (hiddenp f2) t)
(create-span p2 :content
(format nil "<br><b>Your form has been submitted:</b>
<br>~A<hr>1 - ~A<br>2 - ~A<br>3 - ~A"
(value ta1)
(value sl1)
(value sl2)
(selectedp o2)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 3 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (editablep p3) t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tab functionality
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(flet ((select-tab (obj)
(setf (hiddenp p1) t)
(setf (hiddenp p2) t)
(setf (hiddenp p3) t)
(setf (background-color t1) :lightgrey)
(setf (background-color t2) :lightgrey)
(setf (background-color t3) :lightgrey)
(setf (background-color last-tab) :lightblue)
(setf (hiddenp obj) nil)
(focus obj)))
(setf last-tab t1)
(select-tab p1)
(set-on-click t1 (lambda (obj)
(setf last-tab obj)
(select-tab p1)))
(set-on-click t2 (lambda (obj)
(setf last-tab obj)
(select-tab p2)))
(set-on-click t3 (lambda (obj)
(setf last-tab obj)
(select-tab p3))))))))
(defun start-tutorial-spec ()
"Start turtorial."
(initialize 'on-new-window-spec)
(open-browser)):bind is a special argument there, and is not passed to the element creation function. It is possible to change it to &bind, to make it more "different", or introduce some other structure for binding, but the concept remains the same.
rabbibotton
commented
2 years ago This is very nice. Would you be open to me adding it to clog (attributions of course)
mmontone
commented
2 years ago Of course you can add, that's why I'm sharing.
It will need a bit of explanation perhaps, you are better at writing than I am :)
Syntax is (element-name args &body children). With special binding argument in args. Macro-expanding helps to understand what is going on.
We could also consider ideas on how to implement binding. If let it be with :bind, or &bind, or :name or something else...
rabbibotton
commented
2 years ago Thanks!
I personally like :bind
rabbibotton
commented
2 years ago I'll work on integrating it tomorrow or Sun.
sabracrolleton
commented
2 years ago Re: nested submenus. I agree there should not be a problem with the macro. The problem is certainly between my keyboard and my chair in creating new methods for create-gui-menu-drop-down .
rabbibotton
commented
2 years ago If no objection I am going to change from with-gui to with-clog-create the longer description should help make it clear in the code the declarative part is with clog and for those unfamiliar help them understand it is replacing create- so can still look up documentation. I also am going to move with-clog-create to its own tutorial and in tutorial 9 point to it. The reason is for someone just starting important they can use meta-. to look up docs.
rabbibotton
commented
2 years ago I updated clog and posted to reddit tutorial 33, I also modified 22 with comments showing the syntax in use for menus. Thanks!!
Just for fun, I wrote this macro:
Spec syntax is basically,
(creation-func args &body children). And for binding some widget to a variable for later use, add:bind binding-nameas part of theargs.As an example, this example from tutorial 24:
Can be rewritten as:
The macroexpansion also takes care of the let bindings to ignore:
Posting here in case somebody likes it and wants to use.