mirror of
https://github.com/rabbibotton/clog.git
synced 2026-01-04 08:12:01 -08:00
menus for clog-web
This commit is contained in:
David Botton
parent
c95f8e1e3e
commit
d2a915502d
3 changed files with 193 additions and 12 deletions
|
|
@ -189,6 +189,10 @@ If W3-CSS-URL has not been loaded before is installed unless is nil."
|
||||||
(when jquery-ui
|
(when jquery-ui
|
||||||
(load-script (html-document clog-body) jquery-ui)))
|
(load-script (html-document clog-body) jquery-ui)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Implementation - Menus
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;
|
||||||
;; menu-bar ;;
|
;; menu-bar ;;
|
||||||
;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;
|
||||||
|
|
@ -261,10 +265,6 @@ create-gui-menu-bar."))
|
||||||
(window-normalize value))
|
(window-normalize value))
|
||||||
(windows app))))
|
(windows app))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Implementation - Menus
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; create-gui-menu-bar ;;
|
;; create-gui-menu-bar ;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
|
||||||
|
|
@ -78,6 +78,18 @@
|
||||||
(hide-on-medium-screens generic-function)
|
(hide-on-medium-screens generic-function)
|
||||||
(hide-on-large-screens generic-function)
|
(hide-on-large-screens generic-function)
|
||||||
|
|
||||||
|
"CLOG-WEB - Menus"
|
||||||
|
(clog-web-menu-bar class)
|
||||||
|
(create-web-menu-bar generic-function)
|
||||||
|
(web-menu-bar generic-function)
|
||||||
|
(web-menu-bar-height generic-function)
|
||||||
|
(clog-web-menu-drop-down class)
|
||||||
|
(create-web-menu-drop-down generic-function)
|
||||||
|
(clog-web-menu-item class)
|
||||||
|
(create-web-menu-item generic-function)
|
||||||
|
(create-web-menu-full-screen generic-function)
|
||||||
|
(create-web-menu-icon generic-function)
|
||||||
|
|
||||||
"CLOG-WEB - Interactions"
|
"CLOG-WEB - Interactions"
|
||||||
(clog-web-alert function)
|
(clog-web-alert function)
|
||||||
(clog-web-form function))
|
(clog-web-form function))
|
||||||
|
|
@ -89,7 +101,11 @@
|
||||||
(defclass clog-web ()
|
(defclass clog-web ()
|
||||||
((body
|
((body
|
||||||
:accessor body
|
:accessor body
|
||||||
:documentation "Top level access to browser window")))
|
:documentation "Top level access to browser window")
|
||||||
|
(web-menu
|
||||||
|
:accessor web-menu
|
||||||
|
:initform nil
|
||||||
|
:documentation "Installed menu bar if installed")))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; create-clog-web ;;
|
;; create-clog-web ;;
|
||||||
|
|
@ -116,6 +132,172 @@ If W3-CSS-URL has not been loaded before is installed unless is nil."
|
||||||
(setf (connection-data-item clog-body "w3-css") t)
|
(setf (connection-data-item clog-body "w3-css") t)
|
||||||
(load-css (html-document clog-body) w3-css-url))))
|
(load-css (html-document clog-body) w3-css-url))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;
|
||||||
|
;; web-menu-bar ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric web-menu-bar (clog-obj)
|
||||||
|
(:documentation "Get/setf window web-menu-bar. This is set buy
|
||||||
|
create-web-menu-bar."))
|
||||||
|
|
||||||
|
(defmethod web-menu-bar ((obj clog-obj))
|
||||||
|
(let ((app (connection-data-item obj "clog-web")))
|
||||||
|
(web-menu app)))
|
||||||
|
|
||||||
|
(defgeneric set-web-menu-bar (clog-obj value)
|
||||||
|
(:documentation "Set window web-menu-bar"))
|
||||||
|
|
||||||
|
(defmethod set-web-menu-bar ((obj clog-obj) value)
|
||||||
|
(let ((app (connection-data-item obj "clog-web")))
|
||||||
|
(setf (web-menu app) value)))
|
||||||
|
(defsetf web-menu-bar set-web-menu-bar)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; web-menu-bar-height ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric web-menu-bar-height (clog-obj)
|
||||||
|
(:documentation "Get web-menu-bar height"))
|
||||||
|
|
||||||
|
(defmethod web-menu-bar-height ((obj clog-obj))
|
||||||
|
(let ((app (connection-data-item obj "clog-web")))
|
||||||
|
(if (web-menu app)
|
||||||
|
(height (web-menu app))
|
||||||
|
0)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-bar ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defclass clog-web-menu-bar (clog-div)()
|
||||||
|
(:documentation "Menu bar"))
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-bar (clog-obj &key class html-id)
|
||||||
|
(:documentation "Attached a menu bar to a CLOG-OBJ in general a
|
||||||
|
clog-body."))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-bar ((obj clog-obj)
|
||||||
|
&key (class "w3-bar w3-black w3-card-4")
|
||||||
|
(html-id nil))
|
||||||
|
(let ((div (create-div obj :class class :html-id html-id))
|
||||||
|
(app (connection-data-item obj "clog-web")))
|
||||||
|
(change-class div 'clog-web-menu-bar)
|
||||||
|
(setf (web-menu app) div)
|
||||||
|
div))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-drop-down ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defclass clog-web-menu-drop-down (clog-div)()
|
||||||
|
(:documentation "Drop down menu"))
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-drop-down (clog-web-menu-bar
|
||||||
|
&key content class html-id)
|
||||||
|
(:documentation "Attached a menu bar drop-down to a CLOG-WEB-MENU-BAR"))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-drop-down ((obj clog-web-menu-bar)
|
||||||
|
&key (content "")
|
||||||
|
(class "w3-dropdown-content w3-bar-block w3-card-4")
|
||||||
|
(html-id nil))
|
||||||
|
(let* ((hover (create-div obj :class "w3-dropdown-hover"))
|
||||||
|
(button (create-button hover :class "w3-button" :content content))
|
||||||
|
(div (create-div hover :class class :html-id html-id)))
|
||||||
|
(declare (ignore button))
|
||||||
|
(change-class div 'clog-web-menu-drop-down)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-item ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defclass clog-web-menu-item (clog-span)()
|
||||||
|
(:documentation "Menu item"))
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-item (clog-web-menu-drop-down
|
||||||
|
&key content
|
||||||
|
on-click
|
||||||
|
class
|
||||||
|
html-id)
|
||||||
|
(:documentation "Attached a menu item to a CLOG-WEB-MENU-DROP-DOWN"))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-item ((obj clog-obj)
|
||||||
|
&key (content "")
|
||||||
|
(on-click nil)
|
||||||
|
(class "w3-bar-item w3-button")
|
||||||
|
(html-id nil))
|
||||||
|
(let ((span
|
||||||
|
(create-span obj :content content :class class :html-id html-id)))
|
||||||
|
(set-on-click span on-click)
|
||||||
|
(change-class span 'clog-web-menu-item)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-item ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defclass clog-web-menu-item (clog-span)()
|
||||||
|
(:documentation "Menu item"))
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-item (clog-web-menu-drop-down
|
||||||
|
&key content
|
||||||
|
on-click
|
||||||
|
class
|
||||||
|
html-id)
|
||||||
|
(:documentation "Attached a menu item to a CLOG-WEB-MENU-DROP-DOWN"))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-item ((obj clog-obj)
|
||||||
|
&key (content "")
|
||||||
|
(on-click nil)
|
||||||
|
(class "w3-bar-item w3-button")
|
||||||
|
(html-id nil))
|
||||||
|
(let ((span
|
||||||
|
(create-span obj :content content :class class :html-id html-id)))
|
||||||
|
(set-on-click span on-click)
|
||||||
|
(change-class span 'clog-web-menu-item)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-full-screen ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-full-screen (clog-web-menu-bar &key html-id)
|
||||||
|
(:documentation "Add as last item in menu bar to allow for a full screen
|
||||||
|
icon ⤢ and full screen mode."))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-full-screen ((obj clog-web-menu-bar)
|
||||||
|
&key (html-id nil))
|
||||||
|
(create-child obj
|
||||||
|
" <span class='w3-bar-item w3-right' style='user-select:none;'
|
||||||
|
onClick='if (document.fullscreenElement==null) {
|
||||||
|
documentElement.requestFullscreen()
|
||||||
|
} else {document.exitFullscreen();}'>⤢</span>"
|
||||||
|
:html-id html-id
|
||||||
|
:clog-type 'clog-web-menu-item))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; create-web-menu-icon ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric create-web-menu-icon (clog-web-menu-bar &key image-url
|
||||||
|
on-click
|
||||||
|
class
|
||||||
|
html-id)
|
||||||
|
(:documentation "Add icon as menu bar item."))
|
||||||
|
|
||||||
|
(defmethod create-web-menu-icon ((obj clog-web-menu-bar)
|
||||||
|
&key (image-url "/img/clogwicon.png")
|
||||||
|
(on-click nil)
|
||||||
|
(class "w3-button w3-bar-item")
|
||||||
|
(html-id nil))
|
||||||
|
(set-on-click
|
||||||
|
(create-child obj
|
||||||
|
(format nil "<button class='~A'>~
|
||||||
|
<img height=22 src='~A'></button>"
|
||||||
|
class
|
||||||
|
image-url)
|
||||||
|
:html-id html-id
|
||||||
|
:clog-type 'clog-web-menu-item)
|
||||||
|
on-click))
|
||||||
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; set-maximum-page-width-in-pixels ;;
|
;; set-maximum-page-width-in-pixels ;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
|
||||||
|
|
@ -9,23 +9,22 @@
|
||||||
|
|
||||||
|
|
||||||
(defpackage #:clog-user
|
(defpackage #:clog-user
|
||||||
(:use #:cl #:clog #:clog-web #:clog-gui)
|
(:use #:cl #:clog #:clog-web)
|
||||||
(:export start-tutorial))
|
(:export start-tutorial))
|
||||||
|
|
||||||
(in-package :clog-user)
|
(in-package :clog-user)
|
||||||
|
|
||||||
(defun on-new-window (body)
|
(defun on-new-window (body)
|
||||||
(clog-web-initialize body)
|
(clog-web-initialize body)
|
||||||
(clog-gui-initialize body)
|
|
||||||
(setf (title (html-document body)) "Tutorial 26")
|
(setf (title (html-document body)) "Tutorial 26")
|
||||||
;; Install a menu
|
;; Install a menu
|
||||||
(let* ((menu (create-gui-menu-bar body))
|
(let* ((menu (create-web-menu-bar body))
|
||||||
(tmp (create-gui-menu-icon menu :on-click (lambda (obj)
|
(tmp (create-web-menu-icon menu :on-click (lambda (obj)
|
||||||
(setf (hash (location body)) "rung2"))))
|
(setf (hash (location body)) "rung2"))))
|
||||||
(tmp (create-gui-menu-item menu :content "About"
|
(tmp (create-web-menu-item menu :content "About"
|
||||||
|
:class "w3-bar-item w3-button w3-right"
|
||||||
:on-click (lambda (obj)
|
:on-click (lambda (obj)
|
||||||
(setf (hash (location body)) "rung2"))))
|
(setf (hash (location body)) "rung2")))))
|
||||||
(tmp (create-gui-menu-full-screen menu)))
|
|
||||||
(declare (ignore tmp)))
|
(declare (ignore tmp)))
|
||||||
;; rung-1
|
;; rung-1
|
||||||
(let* ((first-rung (create-web-compositor body :html-id "rung1"))
|
(let* ((first-rung (create-web-compositor body :html-id "rung1"))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue