diff --git a/private/lib/linux/librktwebview_qt.so b/private/lib/linux/librktwebview_qt.so index 49165c4..927c26c 100755 Binary files a/private/lib/linux/librktwebview_qt.so and b/private/lib/linux/librktwebview_qt.so differ diff --git a/private/racket-webview-qt.rkt b/private/racket-webview-qt.rkt index b360189..4beed4c 100644 --- a/private/racket-webview-qt.rkt +++ b/private/racket-webview-qt.rkt @@ -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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/private/racket-webview.rkt b/private/racket-webview.rkt index 74fff5f..b138d25 100644 --- a/private/racket-webview.rkt +++ b/private/racket-webview.rkt @@ -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 diff --git a/private/utils.rkt b/private/utils.rkt index af66f69..53257d0 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -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))) + + diff --git a/rktwebview_qt/command.h b/rktwebview_qt/command.h index 9b09cba..b9e2d2e 100644 --- a/rktwebview_qt/command.h +++ b/rktwebview_qt/command.h @@ -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 { diff --git a/rktwebview_qt/rktwebview.cpp b/rktwebview_qt/rktwebview.cpp index aa2b1a4..6855242 100644 --- a/rktwebview_qt/rktwebview.cpp +++ b/rktwebview_qt/rktwebview.cpp @@ -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); +} diff --git a/rktwebview_qt/rktwebview.h b/rktwebview_qt/rktwebview.h index 457147c..b964dba 100644 --- a/rktwebview_qt/rktwebview.h +++ b/rktwebview_qt/rktwebview.h @@ -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); } diff --git a/rktwebview_qt/rktwebview_qt.cpp b/rktwebview_qt/rktwebview_qt.cpp index a0a973f..e9249fe 100644 --- a/rktwebview_qt/rktwebview_qt.cpp +++ b/rktwebview_qt/rktwebview_qt.cpp @@ -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(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(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); diff --git a/rktwebview_qt/rktwebview_qt.h b/rktwebview_qt/rktwebview_qt.h index 0f7c4b0..295a89c 100644 --- a/rktwebview_qt/rktwebview_qt.h +++ b/rktwebview_qt/rktwebview_qt.h @@ -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);