hans/racket-webview
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

documentation

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-01 16:23:56 +02:00
parent 5ee62d0064
commit ab666368b1
27 changed files with 1080 additions and 164 deletions
Download Patch File Download Diff File Expand all files Collapse all files

145
private/menu.rkt
View File

@@ -1,60 +1,72 @@
(module menu racket/base
(require json)
(require json
net/url)
(provide menu
menu-item
is-menu?
menu-set-callback!
menu-set-icon!
menu-set-title!
menu->json
with-menu-item
menu-for-each
ww-menu-item-callback
ww-menu-item-id
ww-menu-id
(provide wv-menu
wv-menu-item
is-wv-menu?
wv-menu-set-callback!
wv-menu-set-icon!
wv-menu-set-title!
wv-menu->json
with-wv-menu-item
wv-menu-for-each
wv-menu-item-callback
wv-menu-item-id
wv-menu-id
)
(define-struct ww-menu-item
(id [title #:mutable] [icon-file #:mutable] [callback #:mutable] [submenu #:mutable] [separator #:mutable])
(define-struct ww-menu-item*
(id [title #:mutable] [icon-url #:mutable] [callback #:mutable] [submenu #:mutable] [separator #:mutable])
#:transparent)
(define-struct ww-menu
(define-struct ww-menu*
(id [items #:mutable])
#:transparent
)
(define (is-menu? mnu)
(if (ww-menu? mnu)
(if (list? (ww-menu-items mnu))
(define (wv-menu-item-callback mi)
(ww-menu-item*-callback mi))
(define (wv-menu-item-id mi)
(ww-menu-item*-id mi))
(define (wv-menu-id m)
(ww-menu*-id m))
(define (is-wv-menu? mnu)
(if (ww-menu*? mnu)
(if (list? (ww-menu*-items mnu))
(letrec ((f (lambda (m)
(if (null? m)
#t
(if (ww-menu-item? (car m))
(if (eq? (ww-menu-item-submenu (car m)) #f)
(if (ww-menu-item*? (car m))
(if (eq? (ww-menu-item*-submenu (car m)) #f)
(f (cdr m))
(and (is-menu? (ww-menu-item-submenu (car m)))
(and (is-wv-menu? (ww-menu-item*-submenu (car m)))
(f (cdr m))))
#f)
))
))
(f (ww-menu-items mnu)))
(f (ww-menu*-items mnu)))
#f)
#f))
(define (menu . items)
(define (wv-menu . items)
(let ((menu-id #f))
(when (symbol? (car items))
(set! menu-id (car items))
(set! items (cdr items)))
(when (list? (car items))
(set! items (car items)))
(make-ww-menu menu-id items)))
(make-ww-menu* menu-id items)))
(define (menu-item id title
#:icon-file [icon-file #f]
(define (wv-menu-item id title
#:icon-url [icon-url #f]
#:callback [callback (lambda args #t)]
#:submenu [submenu #f]
#:separator [separator #f])
@@ -62,47 +74,49 @@
(error "menu-item needs an id of symbol?"))
(unless (string? title)
(error "menu-item needs a title of string?"))
(unless (or (eq? icon-file #f) (string? icon-file) (path? icon-file))
(unless (or (eq? icon-url #f) (string? icon-url) (url? icon-url))
(error "menu-item's optional argument icon-file must be #f, string? or path?"))
(unless (or (eq? submenu #f) (is-menu? submenu))
(unless (or (eq? submenu #f) (is-wv-menu? submenu))
(error "menu-item's optional argument submenu must be #f or is-menu?"))
(unless (boolean? separator)
(error "menu-item's optional argument separator must be boolean?"))
(make-ww-menu-item id title icon-file callback submenu separator))
(let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
(make-ww-menu-item* id title u callback submenu separator))
)
(define (menu->hash menu . for-json)
(define (wv-menu->hash menu . for-json)
(let ((fj (if (null? for-json) #f (car for-json))))
(unless (is-menu? menu)
(unless (is-wv-menu? menu)
(error "menu->hash must be called with a menu"))
(let* ((items (ww-menu-items menu))
(let* ((items (ww-menu*-items menu))
(r (map (λ (item)
(let ((h (make-hasheq)))
(hash-set! h 'id (format "~a" (ww-menu-item-id item)))
(hash-set! h 'name (ww-menu-item-title item))
(unless (eq? (ww-menu-item-icon-file item) #f)
(hash-set! h 'icon (ww-menu-item-icon-file item)))
(unless (eq? (ww-menu-item-submenu item) #f)
(hash-set! h 'submenu (menu->hash (ww-menu-item-submenu item) fj)))
(unless (eq? (ww-menu-item-separator item) #f)
(hash-set! h 'id (format "~a" (ww-menu-item*-id item)))
(hash-set! h 'name (ww-menu-item*-title item))
(unless (eq? (ww-menu-item*-icon-url item) #f)
(hash-set! h 'icon (ww-menu-item*-icon-url item)))
(unless (eq? (ww-menu-item*-submenu item) #f)
(hash-set! h 'submenu (wv-menu->hash (ww-menu-item*-submenu item) fj)))
(unless (eq? (ww-menu-item*-separator item) #f)
(hash-set! h 'separator #t))
h
)) items))
)
(let ((h (make-hasheq)))
(hash-set! h 'menu r)
(hash-set! h 'id (if fj (format "~a" (ww-menu-id menu)) (ww-menu-id menu)))
(hash-set! h 'id (if fj (format "~a" (ww-menu*-id menu)) (ww-menu*-id menu)))
h))))
(define (menu-for-each menu cb)
(let ((items (ww-menu-items menu)))
(define (wv-menu-for-each menu cb)
(let ((items (ww-menu*-items menu)))
(letrec ((f (λ (items)
(if (null? items)
#t
(let ((item (car items)))
(let ((submenu (ww-menu-item-submenu item)))
(let ((submenu (ww-menu-item*-submenu item)))
(if (eq? submenu #f)
(cb item)
(menu-for-each submenu cb)))
(wv-menu-for-each submenu cb)))
(f (cdr items))
)
)
@@ -110,23 +124,23 @@
))
(f items))))
(define (menu->json menu)
(define (wv-menu->json menu)
(let ((o (open-output-string)))
(write-json (menu->hash menu #t) o)
(write-json (wv-menu->hash menu #t) o)
(get-output-string o)))
(define (find-menu-item menu id)
(let ((items (ww-menu-items menu)))
(define (find-wv-menu-item menu id)
(let ((items (ww-menu*-items menu)))
(letrec ((f (λ (items)
(if (null? items)
#f
(let ((item (car items)))
(if (eq? (ww-menu-item-id item) id)
(if (eq? (ww-menu-item*-id item) id)
item
(let ((submenu (ww-menu-item-submenu item)))
(let ((submenu (ww-menu-item*-submenu item)))
(if (eq? submenu #f)
(f (cdr items))
(let ((found-item (find-menu-item submenu id)))
(let ((found-item (find-wv-menu-item submenu id)))
(if (eq? found-item #f)
(f (cdr items))
found-item))
@@ -136,37 +150,38 @@
))
(f items))))
(define (with-menu-item menu id cb)
(unless (is-menu? menu)
(define (with-wv-menu-item menu id cb)
(unless (is-wv-menu? menu)
(error "menu must be of is-menu?"))
(unless (symbol? id)
(error "id must be of symbol?"))
(let ((item (find-menu-item menu id)))
(let ((item (find-wv-menu-item menu id)))
(if (eq? item #f)
(error (format "cannot find id'~a in given menu" id))
(cb item)))
menu)
(define (menu-set-title! menu id title)
(define (wv-menu-set-title! menu id title)
(unless (string? title)
(error "title must be of string?"))
(with-menu-item menu id
(with-wv-menu-item menu id
(λ (item)
(set-ww-menu-item-title! item title))))
(set-ww-menu-item*-title! item title))))
(define (menu-set-icon! menu id icon)
(unless (or (eq? icon #f) (path? icon) (string? icon))
(define (wv-menu-set-icon! menu id icon-url)
(unless (or (eq? icon-url #f) (url? icon-url) (string? icon-url))
(error "title must be of #f, string? or path?"))
(with-menu-item menu id
(with-wv-menu-item menu id
(λ (item)
(set-ww-menu-item-icon-file! item icon))))
(let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
(set-ww-menu-item*-icon-url! item u)))))
(define (menu-set-callback! menu id cb)
(define (wv-menu-set-callback! menu id cb)
(unless (procedure? cb)
(error "callback must be of procedure?"))
(with-menu-item menu id
(with-wv-menu-item menu id
(λ (item)
(set-ww-menu-item-callback! item cb))))
(set-ww-menu-item*-callback! item cb))))
); end of module