mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

windows menu support

Browse source
This commit is contained in:
David Botton 2021-02-14 20:01:50 -05:00
parent aab910e644
commit 64d7723702
4 changed files with 204 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

67
clog-form.lisp
View file

@ -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))
(create-child obj (format nil "<fieldset>~A</fieldset>"
(defmethod create-fieldset ((obj clog-obj) &key (legend nil)
(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>"
name columns rows (escape-string value))
(format nil "<textarea name='~A' cols='~A' rows='~A'~A>~A</textarea>"
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"
""))

156
clog-gui.lisp
View file

@ -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)
(cond ((last-width win)
(setf (width win) (last-width win))
(setf (height win) (last-height win))
(setf (top win) (last-y win))
(setf (left win) (last-x win))
(setf (last-width win) nil))
(t
(setf (last-x win) (left win))
(setf (last-y win) (top 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)))
(setf (gethash (format nil "~A" html-id) (windows app)) win)
(if maximize
(window-maximize win)
(fire-on-window-change win app))
(when (window-select app)
(setf (window-select-item win) (create-option (window-select app)
:content title
:value html-id)))
(set-on-double-click (win-title win) (lambda (obj)
(window-toggle-maximize 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 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

21
clog.lisp
View file

@ -656,14 +656,15 @@ embedded in a native template application.)"
(clog-gui-initialize function)
"CLOG-GUI - Menus"
(clog-gui-menu-bar class)
(create-gui-menu-bar generic-function)
(clog-gui-menu-drop-down class)
(create-gui-menu-drop-down generic-function)
(clog-gui-menu-item class)
(create-gui-menu-item generic-function)
(create-gui-menu-full-screen generic-function)
(create-gui-menu-icon generic-function)
(clog-gui-menu-bar class)
(create-gui-menu-bar generic-function)
(clog-gui-menu-drop-down class)
(create-gui-menu-drop-down generic-function)
(clog-gui-menu-item class)
(create-gui-menu-item generic-function)
(create-gui-menu-window-select 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)

12
tutorial/22-tutorial.lisp
View file

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