Declarative GUI syntax

[rabbibotton]

Declarative GUI syntax

[rabbibotton]

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]

I'll work on integrating it tomorrow or Sun.

[mmontone]

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))

[rabbibotton]

Thanks!

I personally like :bind

[sabracrolleton]

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]

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]

Would be great if you could do this with nested sub-menus.

[mmontone]

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]

Note that this macro supports any level of nesting ...

[rabbibotton]

How would you use this with tutorial 9?

[mmontone]

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]

1. The clog-obj that the create on changes based on hierarchy
2. There is a non clog-obj's in the let.

[mmontone]

: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]

This is very nice. Would you be open to me adding it to clog (attributions of course)

[mmontone]

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]

I updated clog and posted to reddit tutorial 33, I also modified 22 with comments showing the syntax in use for menus. Thanks!!