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

-

Browse Source
This commit is contained in:
Hans Dijkema
2026-03-05 14:42:42 +01:00
parent 3b53a945f9
commit 4780a3dcb7
9 changed files with 382 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
private/lib/linux/librktwebview_qt.so
View File

Binary file not shown.

25
private/racket-webview-qt.rkt
View File

@@ -36,6 +36,8 @@
rkt-webview-valid?
rkt-webview-open-devtools
rkt-webview-choose-dir
rkt-webview-file-open
rkt-webview-file-save
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -270,6 +272,15 @@
(define-rktwebview rkt_webview_choose_dir
(_fun _int _string/utf-8 _string/utf-8 -> _rkt_js_result_t-pointer))
;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_open(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
(define-rktwebview rkt_webview_file_open
(_fun _int _string/utf-8 _string/utf-8 _string/utf-8 -> _rkt_js_result_t-pointer))
;RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_save(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
(define-rktwebview rkt_webview_file_save
(_fun _int _string/utf-8 _string/utf-8 _string/utf-8 -> _rkt_js_result_t-pointer))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialize and start library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -400,6 +411,20 @@
(rkt_webview_destroy_js_result r)
(list result value)))
(define (rkt-webview-file-open wv title base-dir permitted-exts)
(let* ((r (rkt_webview_file_open (rkt-wv-win wv) title base-dir permitted-exts))
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
(result (rkt_js_result_t-result r)))
(rkt_webview_destroy_js_result r)
(list result value)))
(define (rkt-webview-file-save wv title base-dir permitted-exts)
(let* ((r (rkt_webview_file_save (rkt-wv-win wv) title base-dir permitted-exts))
(value (cast (rkt_js_result_t-value r) _pointer _string*/utf-8))
(result (rkt_js_result_t-result r)))
(rkt_webview_destroy_js_result r)
(list result value)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Administration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

250
private/racket-webview.rkt
View File

@@ -16,6 +16,9 @@
xml
xml/xexpr
json
(prefix-in g: gregor)
(prefix-in g: gregor/time)
gregor-utils
)
(provide webview-create
@@ -37,6 +40,18 @@
webview-set-title!
webview-choose-dir
webview-file-open
webview-file-save
wv-permitted-exts
make-wv-permitted-exts
wv-permitted-exts-name
wv-permitted-exts-exts
set-wv-permitted-exts-exts!
set-wv-permitted-exts-name!
wv-permitted-exts?
wv-permitted-exts-exts?
wv-list-of-permitted-exts?
webview-bind!
@@ -44,14 +59,16 @@
webview-set-html!
webview-set-innerHTML!
webview-set-value!
webview-value
webview-value/bool
webview-value/symbol
webview-value/number
;webview-value/date
;webview-value/time
;webview-value/datetime
webview-value/date
webview-value/time
webview-value/datetime
webview-add-class!
webview-remove-class!
@@ -60,12 +77,12 @@
webview-set-attr!
webview-attr
;webview-attr/bool
;webview-attr/symbol
;webview-attr/number
;webview-attr/date
;webview-attr/time
;webview-attr/datetime
webview-attr/bool
webview-attr/symbol
webview-attr/number
webview-attr/date
webview-attr/time
webview-attr/datetime
;webview-del-attr!
@@ -192,6 +209,63 @@
(esc-quote selector)
func))))
(define (make-exts-filter list-of-pe)
(define (mef pe)
(format "~a ~a"
(wv-permitted-exts-name pe)
(map (λ (e) (format "*.~a" e)) (wv-permitted-exts-exts pe))))
(string-join (map mef (if (list? list-of-pe) list-of-pe (list list-of-pe))) ";;"))
(define (filter->exts str)
(let ((re #px"^([^ ]+)\\s+[(]([^)]+)[)]"))
(let ((m (regexp-match re str)))
(cond ((eq? m #f)
#f)
(else (let* ((re1 #px"\\s+")
(re2 #px"[*][.](.*)")
(exts (regexp-split re1 (caddr m))))
(make-wv-permitted-exts (cadr m)
(map (λ (e)
(let ((m (regexp-match re2 e)))
(string->symbol (cadr m))))
exts))
)
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data structures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct wv-permitted-exts
((name #:mutable) (exts #:mutable))
#:transparent
)
(define (wv-permitted-exts-exts? e)
(list-of? symbol? e))
(define (wv-permitted-exts-name? e)
(string? e))
(define wv-pm-exts? wv-permitted-exts?)
(set! wv-permitted-exts? (λ (e)
(and (wv-pm-exts? e)
(wv-permitted-exts-exts? (wv-permitted-exts-exts e))
(wv-permitted-exts-name? (wv-permitted-exts-name e))
)))
(define (wv-list-of-permitted-exts? l)
(list-of? (λ (e) (and
(wv-permitted-exts? e)
(wv-permitted-exts-exts? (wv-permitted-exts-exts e))))
l))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Webview functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -267,18 +341,45 @@
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
(let ((h (fromJson (cadr res))))
(let ((r (make-hash)))
(hash-set! r 'dir (hash-ref h 'dir))
(hash-set! r 'state (string->symbol
(hash-ref h 'state)))
r)))
(let ((r (make-hash (hash->list (fromJson (cadr res))))))
(hash-set! r 'state (string->symbol (hash-ref r 'state)))
r))
(else #f))
)
)
)
)
(define (file-open-save wv title base-dir permitted-exts open-save-f)
(let* ((bd (if (path? base-dir) (path->string base-dir) base-dir))
(ext-filter (make-exts-filter permitted-exts)))
(let ((res (open-save-f (wv-handle wv) title bd ext-filter)))
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
(let* ((h (make-hash (hash->list (fromJson (cadr res))))))
(hash-set! h 'state (string->symbol (hash-ref h 'state)))
(hash-set! h 'used-filter (filter->exts (hash-ref h 'used-filter)))
h))
(else #f))
)
)
)
)
(define/contract (webview-file-open wv title base-dir permitted-exts)
(-> wv? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
(file-open-save wv title base-dir permitted-exts rkt-webview-file-open))
(define/contract (webview-file-save wv title base-dir permitted-exts)
(-> wv? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
(file-open-save wv title base-dir permitted-exts rkt-webview-file-save))
(define/contract (webview-set-title! wv title)
(-> wv? string? symbol?)
(rkt-webview-set-title! (wv-handle wv) title))
@@ -351,7 +452,7 @@
)
(define/contract (webview-set-value! wv id val)
(-> wv? symbol? (or/c symbol? string? number? boolean?) symbol?)
(-> wv? symbol? (or/c symbol? string? number? boolean? g:date? g:time? g:datetime?) symbol?)
(webview-run-js wv
(with-id id el
((string-append
@@ -361,7 +462,17 @@
" el.value = '~a';\n"
"}")
(if (eq? val #f) "false" "true")
(esc-quote (format "~a" val))))
(cond
([(g:date? val)]
(date->string val))
([(g:time? val)]
(time->string val))
([(g:datetime? val)]
(datetime->string val))
(else
(esc-quote (format "~a" val))))
)
)
)
)
@@ -381,28 +492,26 @@
#f
v)))
(define/contract (webview-value/number wv id)
(-> wv? symbol? (or/c number? boolean?))
(let ((v (webview-value wv id)))
(if (eq? v #f)
#f
(string->number (webview-value wv id)))))
(define-syntax wvv
(syntax-rules ()
((_ name type-pred? convert)
(define/contract (name wv id)
(-> wv? symbol? (or/c type-pred? boolean?))
(let ((v (webview-value wv id)))
(if (eq? v #f)
#f
(convert v))))
)
)
)
(define/contract (webview-value/symbol wv id)
(-> wv? symbol? (or/c symbol? boolean?))
(let ((v (webview-value wv id)))
(if (eq? v #f)
#f
(string->symbol (webview-value wv id)))))
(wvv webview-value/time g:time? string->time)
(wvv webview-value/date g:date? string->date)
(wvv webview-value/datetime g:datetime? string->datetime)
(wvv webview-value/number number? string->number)
(wvv webview-value/symbol symbol? string->symbol)
(wvv webview-value/bool boolean? (λ (e) (if (string=? e "true") #t #f)))
(define/contract (webview-value/bool wv id)
(-> wv? symbol? (or/c symbol? boolean?))
(let ((v (webview-value wv id)))
(if (eq? v #f)
'fail
(if (string=? (webview-value wv id) "true")
#t
#f))))
(define/contract (webview-add-class! wv id-or-selector class)
(-> wv? (or/c symbol? string?) (or/c symbol? string? list?) hash?)
@@ -496,13 +605,22 @@
)
(define/contract (webview-set-attr! wv selector attr-entries)
(-> wv? (or/c symbol? string?) (or/c kv? list-of-kv?) hash?)
(let ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
(cl (mk-js-array (if (kv? attr-entries)
(list attr-entries)
attr-entries)))
(-> wv? (or/c symbol? string?)
(or/c kv? list-of-kv?) hash?)
(let* ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
(ae* (if (kv? attr-entries) (list attr-entries) attr-entries))
(ae** (map (λ (kv)
(let ((v (kv-2 kv)))
(make-kv (kv-1 kv)
(cond
([g:date? v] (date->string v))
([g:time? v] (time->string v))
([g:datetime? v] (datetime->string v))
(else (format "~a" v))))
)) ae*))
(cl (mk-js-array ae**))
)
(webview-call-js wv
(with-selector sel
@@ -531,39 +649,25 @@
)
)
#|(define/contract (webview-set-style! wv selector style-entries)
(-> wv? (or/c symbol? string?) (or/c list? list-of-kv?) hash?)
(define (webview-set-style!* wv selector h)
(list wv selector h))
(define-syntax webview-style-entry
(define-syntax wva
(syntax-rules ()
((_ h (k v))
(with-handlers ([exn:fail? (λ (e)
(hash-set! h 'k v))])
(hash-set! h k v)))
((_ h q l)
(hash-set! h (car l) (cadr l)))
((_ h l)
(hash-set! h (car l) (cadr l)))
)
)
(define-syntax webview-set-style!
(syntax-rules ()
((_ wv selector st ...)
(webview-set-style!* wv selector
(let ((h (make-hash)))
(webview-style-entry h st)
...
h))
((_ name type-pred? convert)
(define/contract (name wv id attr)
(-> wv? symbol? (or/c symbol? string?) (or/c type-pred? boolean?))
(let ((v (webview-attr wv id attr)))
(if (eq? v #f)
#f
(convert v))))
)
)
)
|#
(wva webview-attr/number number? string->number)
(wva webview-attr/symbol symbol? string->symbol)
(wva webview-attr/date g:date? string->date)
(wva webview-attr/time g:time? string->time)
(wva webview-attr/datetime g:datetime string->datetime)
(wvv webview-attr/bool boolean? (λ (e) (if (string=? e "true") #t #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; testing

72
private/utils.rkt
View File

@@ -2,7 +2,12 @@
(require racket/string
racket/port
racket/contract
json
(prefix-in g: gregor)
(prefix-in g: gregor/time)
gregor-utils
racket-sprintf
)
(provide while
@@ -14,10 +19,19 @@
fromJson
mk-js-array
js-code
kv-1
kv-2
make-kv
kv?
list-of-kv?
list-of-symbol?
list-of?
string->time
time->string
string->date
date->string
string->datetime
datetime->string
)
(define-syntax while
@@ -108,6 +122,22 @@
(and (list? e) (= (length e) 2) (symbol? (car e)))
(and (pair? e) (symbol? (car e)))))
(define/contract (kv-1 e)
(-> kv? symbol?)
(car e))
(define/contract (kv-2 e)
(-> kv? any/c)
(if (list? e)
(cadr e)
(cdr e)))
(define/contract (make-kv k v)
(-> symbol? any/c kv?)
(if (list? v)
(list k v)
(cons k v)))
(define (list-of? pred? l)
(define (all-pred? l)
(if (null? l)
@@ -124,4 +154,44 @@
(define (list-of-symbol? l)
(list-of? symbol? l))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Date / Time conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string->time s)
(with-handlers ([exn:fail?
(λ (e) (g:parse-time s "HH:mm"))])
(g:parse-time s "HH:mm:ss")))
(define (time->string t)
(unless (or (g:time? t) (g:datetime? t) (g:moment? t))
(error "set! - gregor time?, moment? or datetime? expected"))
(sprintf "%02d:%02d:%02d" (g:->hours t) (g:->minutes t) (g:->seconds t)))
(define (string->datetime s)
(with-handlers ([exn:fail?
(λ (e) (g:parse-moment s "yyyy-MM-dd'T'HH:mm:ss"))])
(g:parse-moment s "yyyy-MM-dd'T'HH:mm")))
(define (datetime->string dt)
(when (racket-date? dt)
(datetime->string date->moment dt))
(unless (or (g:datetime? dt) (g:moment? dt) (g:date? dt) (g:time? dt))
(error "set! - gregor time? , date?, datetime? or moment? expected"))
(sprintf "%04d:%02d:%02dT%02d:%02d:%02d"
(g:->year dt) (g:->month dt) (g:->day dt)
(g:->hours dt) (g:->minutes dt) (g:->seconds dt))
)
(define (string->date d)
(g:parse-date d "yyyy-MM-dd"))
(define (date->string d)
(when (racket-date? d)
(date->string (date->moment d)))
(unless (or (g:date? d) (g:moment? d) (g:datetime? d))
(error "set! - gregor date expected"))
(sprintf "%04d-%02d-%02d" (g:->year d) (g:->month d) (g:->day d)))

4
rktwebview_qt/command.h
View File

@@ -23,8 +23,8 @@
#define COMMAND_WINDOW_STATUS 17
#define COMMAND_SET_TITLE 18
#define COMMAND_CHOOSE_DIR 19
#define COMMAND_OPEN_FILE 20
#define COMMAND_SAVE_FILE 21
#define COMMAND_FILE_OPEN 20
#define COMMAND_FILE_SAVE 21
class Command
{

12
rktwebview_qt/rktwebview.cpp
View File

@@ -190,3 +190,15 @@ rkt_js_result_t *rkt_webview_choose_dir(rktwebview_t w, const char *title, const
rkt_webview_init();
return handler->rktChooseDir(w, title, base_dir);
}
rkt_js_result_t *rkt_webview_file_open(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts)
{
rkt_webview_init();
return handler->rktFileOpen(w, title, base_dir, permitted_exts);
}
rkt_js_result_t *rkt_webview_file_save(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts)
{
rkt_webview_init();
return handler->rktFileSave(w, title, base_dir, permitted_exts);
}

2
rktwebview_qt/rktwebview.h
View File

@@ -81,6 +81,8 @@ RKTWEBVIEW_QT_EXPORT result_t rkt_webview_minimize(rktwebview_t w);
RKTWEBVIEW_QT_EXPORT window_state_t rkt_webview_window_state(rktwebview_t w);
RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_choose_dir(rktwebview_t w, const char *title, const char *base_dir);
RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_open(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
RKTWEBVIEW_QT_EXPORT rkt_js_result_t *rkt_webview_file_save(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
}

91
rktwebview_qt/rktwebview_qt.cpp
View File

@@ -274,6 +274,41 @@ void Rktwebview_qt::processCommand(Command *cmd)
cmd->done = true;
}
break;
case COMMAND_FILE_OPEN:
case COMMAND_FILE_SAVE: {
int wv = cmd->args[0].toInt();
QString title = cmd->args[1].toString();
QString base_dir = cmd->args[2].toString();
QString exts = cmd->args[3].toString();
if (_views.contains(wv)) {
WebviewWindow *w = _views[wv];
QString file;
QString selected_filter;
if (cmd->cmd == COMMAND_FILE_OPEN) {
file = QFileDialog::getOpenFileName(w, title, base_dir, exts, &selected_filter);
} else {
file = QFileDialog::getSaveFileName(w, title, base_dir, exts, &selected_filter);
}
if (file == "") {
QJsonObject obj;
obj["state"] = "canceled";
obj["file"] = "";
obj["used-filter"] = selected_filter;
cmd->result = QString::fromUtf8(QJsonDocument(obj).toJson(QJsonDocument::JsonFormat::Compact));
} else {
QJsonObject obj;
obj["state"] = "choosen";
obj["file"] = file;
obj["used-filter"] = selected_filter;
cmd->result = QString::fromUtf8(QJsonDocument(obj).toJson(QJsonDocument::JsonFormat::Compact));
}
} else {
cmd->js_result_ok = false;
cmd->result = false;
}
cmd->done = true;
}
break;
default: {
cmd->result = false;
cmd->done = true;
@@ -484,6 +519,62 @@ rkt_js_result_t *Rktwebview_qt::rktChooseDir(rktwebview_t w, const char *title,
return r;
}
rkt_js_result_t *Rktwebview_qt::rktFileOpen(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts)
{
Command c(COMMAND_FILE_OPEN);
c.args.push_back(w);
QString t(title);
c.args.push_back(t);
QString dir(base_dir);
c.args.push_back(dir);
QString exts(permitted_exts);
c.args.push_back(exts);
postCommand(&c);
while(!c.done) { doEvents(); }
bool oke = c.js_result_ok;
rkt_js_result_t *r = static_cast<rkt_js_result_t *>(malloc(sizeof(rkt_js_result_t)));
r->result = c.js_result_ok ? result_t::oke : result_t::choose_dir_failed;
r->value = strdup(c.result.toString().toUtf8());
return r;
}
rkt_js_result_t *Rktwebview_qt::rktFileSave(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts)
{
Command c(COMMAND_FILE_SAVE);
c.args.push_back(w);
QString t(title);
c.args.push_back(t);
QString dir(base_dir);
c.args.push_back(dir);
QString exts(permitted_exts);
c.args.push_back(exts);
postCommand(&c);
while(!c.done) { doEvents(); }
bool oke = c.js_result_ok;
rkt_js_result_t *r = static_cast<rkt_js_result_t *>(malloc(sizeof(rkt_js_result_t)));
r->result = c.js_result_ok ? result_t::oke : result_t::choose_dir_failed;
r->value = strdup(c.result.toString().toUtf8());
return r;
}
result_t Rktwebview_qt::rktWindowSetTitle(rktwebview_t wv, const char *title)
{
Command c(COMMAND_SET_TITLE);

2
rktwebview_qt/rktwebview_qt.h
View File

@@ -85,6 +85,8 @@ public:
window_state_t rktWindowState(rktwebview_t w);
rkt_js_result_t *rktChooseDir(rktwebview_t w, const char *title, const char *base_dir);
rkt_js_result_t * rktFileOpen(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
rkt_js_result_t * rktFileSave(rktwebview_t w, const char *title, const char *base_dir, const char *permitted_exts);
result_t rktWindowSetTitle(rktwebview_t wv, const char *title);