windows menu support

clog-form.lisp

@@ -175,7 +175,7 @@ elements."))
     :reset :search :submit :tel :text :time :url :week))
   
 (defgeneric create-form-element (clog-obj element-type
-				 &key name value label html-id)
+				 &key name value label class html-id)
   (:documentation "Create a new clog-form-element as child of CLOG-OBJ.
 It is importamt that clog-form-elements are a child or descendant of a
 clog-form in the DOM. The radio ELEMENT-TYPE groups by NAME."))
@@ -184,10 +184,15 @@ clog-form in the DOM. The radio ELEMENT-TYPE groups by NAME."))
 				&key (name nil)
 				  (value nil)
 				  (label nil)
+				  (class nil)
 				  (html-id nil))
   (let ((element (create-child
-		  obj (format nil "<input type='~A'~A~A/>"
+		  obj (format nil "<input type='~A'~A~A~A/>"
 			      (escape-string element-type)
+			      (if class
+				  (format nil " class='~A'"
+					  (escape-string class))
+				  "")
 			      (if value
 				  (format nil " value='~A'" value)
 				  "")
@@ -648,16 +653,21 @@ virtual keyboards."))
 ;;;;;;;;;;;;;;;;;;
 
 
-(defgeneric create-label (clog-obj &key content label-for html-id)
+(defgeneric create-label (clog-obj &key content label-for class html-id)
   (:documentation "Create a new clog-label as child of CLOG-OBJ."))
 
 (defmethod create-label ((obj clog-obj) &key (content "")
 					  (label-for nil)
+					  (class nil)
 					  (html-id nil))
-  (create-child obj (format nil "<label for='~A'>~A</label>"
+  (create-child obj (format nil "<label for='~A'~A>~A</label>"
 			    (if label-for
 				(html-id label-for)
 				"")
+			    (if class
+				(format nil " class='~A'"
+					(escape-string class))
+				"")
 			    (escape-string content))
 		:clog-type 'clog-label :html-id html-id :auto-place t))
 
@@ -682,11 +692,17 @@ virtual keyboards."))
 ;; create-fieldset ;;
 ;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric create-fieldset (clog-obj &key legend html-id)
+(defgeneric create-fieldset (clog-obj &key legend class html-id)
   (:documentation "Create a new clog-fieldset as child of CLOG-OBJ."))
 
-(defmethod create-fieldset ((obj clog-obj) &key (legend nil) (html-id nil))
+(defmethod create-fieldset ((obj clog-obj) &key (legend nil)
-  (create-child obj (format nil "<fieldset>~A</fieldset>"
+					     (class nil)
+					     (html-id nil))
+  (create-child obj (format nil "<fieldset~A>~A</fieldset>"
+			    (if class
+				(format nil " class='~A'"
+					(escape-string class))
+				"")
 			    (if legend
 				(format nil "<legend>~A</legend>" legend)
 				""))
@@ -750,7 +766,7 @@ optionally fill in with contents of data-list."))
 ;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric create-text-area (clog-obj
-			      &key columns rows name value label html-id)
+			      &key columns rows name value label class html-id)
   (:documentation "Create a new clog-text-area as child of CLOG-OBJ."))
 
 (defmethod create-text-area ((obj clog-obj)
@@ -759,11 +775,17 @@ optionally fill in with contents of data-list."))
 			       (name "")
 			       (value "")
 			       (label nil)
+			       (class nil)
 			       (html-id nil))
   (let ((element
 	  (create-child obj
-	    (format nil "<textarea name='~A' cols='~A' rows='~A'>~A</textarea>"
+	    (format nil "<textarea name='~A' cols='~A' rows='~A'~A>~A</textarea>"
-		    name columns rows (escape-string value))
+		    name columns rows
+		    (if class
+			(format nil " class='~A'"
+				(escape-string class))
+			"")
+		    (escape-string value))
 	    :clog-type 'clog-text-area :html-id html-id :auto-place t)))
 
     (when label
@@ -859,21 +881,26 @@ optionally fill in with contents of data-list."))
 ;; create-select ;;
 ;;;;;;;;;;;;;;;;;;;
 
-(defgeneric create-select (clog-obj &key name multiple label html-id)
+(defgeneric create-select (clog-obj &key name multiple label class html-id)
   (:documentation "Create a new clog-select as child of CLOG-OBJ."))
 
 (defmethod create-select ((obj clog-obj)
 			  &key (name nil)
 			    (multiple nil)
 			    (label nil)
+			    (class nil)
 			    (html-id nil))
   (let ((element (create-child
-		  obj (format nil "<select~A~A/>"
+		  obj (format nil "<select~A~A~A/>"
 			      (if multiple
 				  " multiple"
 				  "")
 			      (if name
 				  (format nil " name='~A'" name)
+				  "")
+			      (if class
+				  (format nil " class='~A'"
+					  (escape-string class))
 				  ""))
 		 :clog-type 'clog-select :html-id html-id :auto-place t)))
     (when label
@@ -916,7 +943,7 @@ optionally fill in with contents of data-list."))
 ;;;;;;;;;;;;;;;;;;;
 
 (defgeneric create-option (clog-obj
-			   &key content value selected disabled html-id)
+			   &key content value selected disabled class html-id)
   (:documentation "Create a new clog-option as child of CLOG-OBJ."))
 
 (defmethod create-option ((obj clog-obj) &key
@@ -924,8 +951,9 @@ optionally fill in with contents of data-list."))
 					   (value nil)
 					   (selected nil)
 					   (disabled nil)
+					   (class nil)
 					   (html-id nil))			  			  
-  (create-child obj (format nil "<option~A~A~A>~A</option>"
+  (create-child obj (format nil "<option~A~A~A~A>~A</option>"
 			    (if selected
 				" selected"
 				"")
@@ -935,6 +963,10 @@ optionally fill in with contents of data-list."))
 			    (if value
 				(format nil " value='~A'" value)
 				"")
+			    (if class
+				(format nil " class='~A'"
+					(escape-string class))
+				"")			    
 			    content)
 		:clog-type 'clog-option :html-id html-id :auto-place t))
 
@@ -971,9 +1003,14 @@ optionally fill in with contents of data-list."))
 
 (defmethod create-optgroup ((obj clog-obj) &key (content "")
 					     (disabled nil)
+					     (class nil)
 					     (html-id nil))			  			  
-  (create-child obj (format nil "<optgroup label='~A'~A/>"
+  (create-child obj (format nil "<optgroup label='~A'~A~A/>"
 			    content
+			    (if class
+				(format nil " class='~A'"
+					(escape-string class))
+				"")
 			    (if disabled
 				" disabled"
 				""))

clog-gui.lisp

@@ -26,7 +26,7 @@
    (windows
     :accessor windows
     :initform (make-hash-table :test 'equalp)
-    :documentation "Window collection")
+    :documentation "Window collection indexed by html-id")
    (last-z
     :accessor last-z
     :initform -9999
@@ -57,6 +57,10 @@
    (drag-y
     :accessor drag-y
     :documentation "Location of the top or height relative to pointer during drag")
+   (window-select
+    :accessor window-select
+    :initform nil
+    :documentation "If installed a drop down that selects window to maximize")
    (on-window-change
     :accessor on-window-change
     :initform nil
@@ -137,7 +141,7 @@ clog-body."))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass clog-gui-menu-item (clog-span)()
-  (:documentation "Menu bar"))
+  (:documentation "Menu item"))
 
 (defgeneric create-gui-menu-item (clog-gui-menu-drop-down
 				  &key content
@@ -156,6 +160,34 @@ clog-body."))
     (set-on-click span on-click)
     (change-class span 'clog-gui-menu-item)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; create-gui-menu-window-select ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass clog-gui-menu-window-select (clog-select)()
+  (:documentation "Drop down containing windows. Selecting a window
+will maximize it on top."))
+
+(defgeneric create-gui-menu-window-select (clog-gui-menu-drop-down
+					   &key class
+					     html-id)
+  (:documentation "Attached a menu item to a CLOG-GUI-MENU-DROP-DOWN"))
+
+(defmethod create-gui-menu-window-select
+    ((obj clog-obj)
+     &key (class "w3-select")
+       (html-id nil))
+  (let ((window-select (create-select obj :class class :html-id html-id))
+	(app           (connection-data-item obj "clog-gui")))
+    (change-class window-select 'clog-gui-menu-window-select)
+    (setf (window-select app) window-select)
+    (set-on-change window-select (lambda (obj)
+				   (let ((win (gethash (value obj) (windows app))))
+				     (when win
+				       (window-maximize win)))))
+    (create-option window-select :content "Select Window")
+    window-select))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; create-gui-menu-full-screen ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -278,6 +310,10 @@ The on-window-change clog-obj received is the new window"))
     :accessor last-y
     :initform nil
     :documentation "Last y before maximize")
+   (window-select-item
+    :accessor window-select-item
+    :initform nil
+    :documentation "Item in window select")
    (on-window-can-close
     :accessor on-window-can-close
     :initform nil
@@ -455,26 +491,16 @@ on-window-resize-done at end of resize."))
       (setf (closer win) (attach-as-child win (format nil "~A-closer" html-id)))
       (setf (sizer win) (attach-as-child win (format nil "~A-sizer" html-id)))
       (setf (content win) (attach-as-child win (format nil "~A-body"  html-id)))
-      (flet ((maximize-window (obj)
+      (setf (gethash (format nil "~A" html-id) (windows app)) win)
-	       (cond ((last-width win)
+      (if maximize
-		      (setf (width win) (last-width win))
+	  (window-maximize win)
-		      (setf (height win) (last-height win))
+	  (fire-on-window-change win app))
-		      (setf (top win) (last-y win))
+      (when (window-select app)
-		      (setf (left win) (last-x win))
+	(setf (window-select-item win) (create-option (window-select app)
-		      (setf (last-width win) nil))
+						      :content title
-		     (t
+						      :value html-id)))      
-		      (setf (last-x win) (left win))
+      (set-on-double-click (win-title win) (lambda (obj)
-		      (setf (last-y win) (top win))
+					     (window-toggle-maximize win)))
-		      (setf (last-height win) (height win))
-		      (setf (last-width win) (width win))
-		      (setf (top win) (unit :px menu-bar-height))
-		      (setf (left win) (unit :px 0))
-		      (setf (width win) (unit :vw 100))
-		      (setf (height win)
-			    (- (inner-height (window (body app))) 30))))))
-	(set-on-double-click (win-title win) #'maximize-window)
-	(when maximize
-	  (maximize-window win)))
       (set-on-click (closer win) (lambda (obj)
 				   (declare (ignore obj))
 				   (when (fire-on-window-can-close win)
@@ -483,27 +509,30 @@ on-window-resize-done at end of resize."))
 				     (remove-from-dom win)
 				     (fire-on-window-change nil app)
 				     (fire-on-window-close win))))
-      (setf (gethash (format nil "~A" html-id) (windows app)) win)
-      (fire-on-window-change win app)
       (cond (client-movement
 	     (jquery-execute win
 			     (format nil "draggable({handle:'#~A-title-bar'})" html-id))
 	     (jquery-execute win "resizable({handles:'se'})")
 	     (set-on-pointer-down (win-title win)
 	    			  (lambda (obj data)
+				    (declare (ignore obj) (ignore data))
 	    			    (setf (z-index win) (incf (last-z app)))
 	    			    (fire-on-window-change win app)))
 	     (set-on-event win "dragstart" 
 			   (lambda (obj)
+			     (declare (ignore obj))
 			     (fire-on-window-move win)))
 	     (set-on-event win "dragstop" 
 			   (lambda (obj)
+			     (declare (ignore obj))
 			     (fire-on-window-move-done win)))
 	     (set-on-event win "resizestart"
 			   (lambda (obj)
+			     (declare (ignore obj))
 			     (fire-on-window-size win)))
 	     (set-on-event win "resizestop" 
 			   (lambda (obj)
+			     (declare (ignore obj))
 			     (fire-on-window-size-done win))))
 	    (t
 	     (set-on-pointer-down
@@ -526,6 +555,8 @@ on-window-resize-done at end of resize."))
   (:documentation "Set window title"))
 
 (defmethod set-window-title ((obj clog-gui-window) value)
+  (when (window-select-item obj)
+    (setf (inner-html (window-select-item obj)) value))
   (setf (inner-html (win-title obj)) value))
 (defsetf window-title set-window-title)
 
@@ -539,6 +570,83 @@ on-window-resize-done at end of resize."))
 (defmethod window-content ((obj clog-gui-window))
   (content obj))
 
+;;;;;;;;;;;;;;;;;;
+;; window-focus ;;
+;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-focus (clog-gui-window)
+  (:documentation "Set CLOG-GUI-WINDOW as focused window."))
+
+(defmethod window-focus ((obj clog-gui-window))
+  (let ((app (connection-data-item obj "clog-gui")))
+    (setf (z-index obj) (incf (last-z app)))
+    (fire-on-window-change obj app)))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; window-maximize ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-maximize (clog-gui-window)
+  (:documentation "Set CLOG-GUI-WINDOW as maximized window."))
+
+(defmethod window-maximize ((obj clog-gui-window))
+  (let ((app (connection-data-item obj "clog-gui")))
+    (window-focus obj)
+    (unless (last-width obj)
+      (setf (last-x obj) (left obj))
+      (setf (last-y obj) (top obj))
+      (setf (last-height obj) (height obj))
+      (setf (last-width obj) (width obj))
+      (setf (top obj) (unit :px menu-bar-height))
+      (setf (left obj) (unit :px 0))
+      (setf (width obj) (unit :vw 100))
+      (setf (height obj)
+	    (- (inner-height (window (body app))) menu-bar-height)))))
+
+;;;;;;;;;;;;;;;;;;;;;;
+;; window-normalize ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-normalize (clog-gui-window)
+  (:documentation "Set CLOG-GUI-WINDOW as maximize window."))
+
+(defmethod window-normalize ((obj clog-gui-window))
+  (window-focus obj)
+  (when (last-width obj)
+    (setf (width obj) (last-width obj))
+    (setf (height obj) (last-height obj))
+    (setf (top obj) (last-y obj))
+    (setf (left obj) (last-x obj))
+    (setf (last-width obj) nil)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; window-toggle-maximize ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-toggle-maximize (clog-gui-window)
+  (:documentation "Set CLOG-GUI-WINDOW as maximize window."))
+
+(defmethod window-toggle-maximize ((obj clog-gui-window))
+  (let ((app (connection-data-item obj "clog-gui")))
+    (window-focus obj)
+    (cond ((last-width obj)
+	   (setf (width obj) (last-width obj))
+	   (setf (height obj) (last-height obj))
+	   (setf (top obj) (last-y obj))
+	   (setf (left obj) (last-x obj))
+	   (setf (last-width obj) nil))
+	  (t
+	   (setf (last-x obj) (left obj))
+	   (setf (last-y obj) (top obj))
+	   (setf (last-height obj) (height obj))
+	   (setf (last-width obj) (width obj))
+	   (setf (top obj) (unit :px menu-bar-height))
+	   (setf (left obj) (unit :px 0))
+	   (setf (width obj) (unit :vw 100))
+	   (setf (height obj)
+		 (- (inner-height (window (body app))) menu-bar-height))))))
+
+    
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-window-can-close ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

clog.lisp

@@ -656,14 +656,15 @@ embedded in a native template application.)"
   (clog-gui-initialize function)
 
   "CLOG-GUI - Menus"
-  (clog-gui-menu-bar           class)
+  (clog-gui-menu-bar             class)
-  (create-gui-menu-bar         generic-function)
+  (create-gui-menu-bar           generic-function)
-  (clog-gui-menu-drop-down     class)
+  (clog-gui-menu-drop-down       class)
-  (create-gui-menu-drop-down   generic-function)
+  (create-gui-menu-drop-down     generic-function)
-  (clog-gui-menu-item          class)
+  (clog-gui-menu-item            class)
-  (create-gui-menu-item        generic-function)
+  (create-gui-menu-item          generic-function)
-  (create-gui-menu-full-screen generic-function)
+  (create-gui-menu-window-select generic-function)
-  (create-gui-menu-icon        generic-function)
+  (create-gui-menu-full-screen   generic-function)
+  (create-gui-menu-icon          generic-function)
 
   "CLOG-GUI - Window System"
   (current-window              generic-function)
@@ -674,6 +675,10 @@ embedded in a native template application.)"
   (create-gui-window           generic-function)
   (window-title                generic-function)
   (window-content              generic-function)
+  (window-focus                generic-function)
+  (window-maximize             generic-function)
+  (window-normalize            generic-function)
+  (window-toggle-maximize      generic-function)
   (set-on-window-can-close     generic-function)
   (set-on-window-close         generic-function)
   (set-on-window-can-move      generic-function)

tutorial/22-tutorial.lisp

@@ -12,19 +12,19 @@
   ;; and :client-movement is set to nil. This mode offers numerous events
   ;; for fine control and is best for local applications although will be a bit
   ;; more choppy cross continent or via satellite.
-  (let ((win (create-gui-window body :client-movement t)))
+  (let ((win (create-gui-window body :title "Count" :client-movement t)))
     (dotimes (n 100)
       ;; window-content is the root element for the clog-gui
       ;; windows
       (create-div (window-content win) :content n))))
 
 (defun on-file-browse (body)
-  (let* ((win (create-gui-window body :client-movement t))
+  (let* ((win (create-gui-window body :title "Browse" :client-movement t))
 	 (browser (create-child (window-content win)
 	    "<iframe width=100% height=98% src='https://common-lisp.net/'></iframe>")))))
 
 (defun on-file-drawing (body)
-  (let* ((win (create-gui-window body :client-movement nil))
+  (let* ((win (create-gui-window body :title "Drawing" :client-movement t))
 	 (canvas (create-canvas (window-content win) :width 600 :height 400))
 	 (cx     (create-context2d canvas)))
     (set-border canvas :thin :solid :black)    
@@ -40,7 +40,7 @@
     (path-fill cx)))
 
 (defun on-file-movies (body)
-  (let ((win (create-gui-window body :client-movement t)))
+  (let ((win (create-gui-window body :title "Movie" :client-movement t)))
     (create-video (window-content win) :source "https://www.w3schools.com/html/mov_bbb.mp4")))
 
 (defun on-help-about (body)
@@ -67,7 +67,9 @@
 	 (tmp   (create-gui-menu-item file :content "Count" :on-click #'on-file-count))
 	 (tmp   (create-gui-menu-item file :content "Browse" :on-click #'on-file-browse))
 	 (tmp   (create-gui-menu-item file :content "Drawing" :on-click #'on-file-drawing))
-	 (tmp   (create-gui-menu-item file :content "Movies" :on-click #'on-file-movies))
+	 (tmp   (create-gui-menu-item file :content "Movie" :on-click #'on-file-movies))
+	 (win   (create-gui-menu-drop-down menu :content "Window"))
+	 (tmp   (create-gui-menu-window-select win))
 	 (help  (create-gui-menu-drop-down menu :content "Help"))
 	 (tmp   (create-gui-menu-item help :content "About" :on-click #'on-help-about))
 	 (tmp   (create-gui-menu-full-screen menu))))