diff --git a/pollen/app.rkt b/pollen/app.rkt new file mode 100644 index 0000000..753a97a --- /dev/null +++ b/pollen/app.rkt @@ -0,0 +1,93 @@ +#lang debug racket/gui +(require pollen/private/log + pollen/private/command) + +(define app-mono-fam + (for*/first ([preferred + '("Triplicate T4" "Menlo" "Consolas" "Andale Mono" "Courier")] + [mono-fam (in-list (get-face-list 'mono))] + #:when (equal? preferred mono-fam)) + preferred)) + +(define app-font-size 14) +(define app-font (make-font #:face (send normal-control-font get-face) #:size app-font-size)) + +(define window (new frame% [label "Pollen Helper"] + [width 700] + [height 700] + [x 40] + [y 40] + [alignment '(left top)] + [spacing 6] + [border 6])) + +(define (make-hpanel) (new horizontal-panel% + [parent window] + [alignment '(left top)] + [stretchable-height #false])) + +(define hpanel-select (make-hpanel)) +(define current-manager-directory (make-parameter #f)) + +(define (set-current-manager-directory val) + (current-manager-directory val) + (send directory-msg set-label (if val (path->string val) ""))) + +(define button-directory + (let ([str "Select project directory"]) + (new button% + [label str] + [parent hpanel-select] + [callback (λ (button evt) (set-current-manager-directory (get-directory str)))]))) + +(define directory-msg + (new message% + [label ""] + [parent hpanel-select] + [auto-resize #true])) + +(define hpanel-server-controls (make-hpanel)) + +(define (make-alert str) + (define d (new dialog% + [label str] + [width 300] + [height 300] + [parent #f])) + #R d + #R (send d show #f)) + +(define button-start + (new button% + [label "Start project server"] + [parent hpanel-server-controls] + [callback (λ (button evt) + (match (current-manager-directory) + [#false (make-alert "boo")] + [dir + (with-logging-to-port + (current-error-port) + (λ () (start-project-server dir)) + #:logger pollen-logger + 'info + 'pollen)]))])) + +(define button-stop + (new button% + [label "Stop project server"] + [parent hpanel-server-controls] + [callback (λ (button evt) (void))])) + +(define wordbox (let* ([wb (new text-field% + [label #f] + [style '(multiple)] + [parent window] + [font (make-font #:face app-mono-fam #:size app-font-size)])] + [ed (send wb get-editor)]) + (send ed set-line-spacing (* app-font-size 0.4)) + (send ed set-padding 6 3 6 3) + wb)) + + + +(send window show #t) diff --git a/pollen/private/command.rkt b/pollen/private/command.rkt index fe23ed4..c29f50a 100644 --- a/pollen/private/command.rkt +++ b/pollen/private/command.rkt @@ -8,6 +8,7 @@ "file-utils.rkt" "log.rkt" "../setup.rkt") +(provide start-project-server) ;; The use of dynamic-require throughout this file is intentional: ;; this way, low-dependency raco commands (like "version") are faster. @@ -44,11 +45,11 @@ [(let ([str (getenv "PLTSTDERR")]) (and str (regexp-match "@pollen" str))) (dispatch-thunk)] [else (with-logging-to-port - (current-error-port) - dispatch-thunk - #:logger pollen-logger - 'info - 'pollen)])) + (current-error-port) + dispatch-thunk + #:logger pollen-logger + 'info + 'pollen)])) (define (very-nice-path x) (path->complete-path (simplify-path (cleanse-path (->path x))))) @@ -153,11 +154,22 @@ version print the version" (current-server-port) (make-publish-di (when (render-with-subdirs?) (for ([path (in-list dirlist)] #:when (directory-exists? path)) - (render-one-dir (->complete-path path)))))))] + (render-one-dir (->complete-path path)))))))] [path-args ;; path mode (message (format "rendering ~a" (string-join (map ->string path-args) " "))) (handle-batch-render path-args)])))) +(define (start-project-server dir + [http-port 8080] + [launch-wanted #false] + [localhost-wanted #false]) + (when dir + (parameterize ([current-project-root dir] + [current-server-port (or http-port (setup:project-server-port))] + [current-server-listen-ip (and localhost-wanted "127.0.0.1")]) + (message "starting project server ...") + ((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted)))) + (define (handle-start) (define launch-wanted #f) (define localhost-wanted #f) @@ -176,11 +188,7 @@ version print the version" (current-server-port) (make-publish-di (string->number (cadr clargs)))) (when (and http-port (not (exact-positive-integer? http-port))) (error (format "~a is not a valid port number" http-port))) - (parameterize ([current-project-root dir] - [current-server-port (or http-port (setup:project-server-port))] - [current-server-listen-ip (and localhost-wanted "127.0.0.1")]) - (message "starting project server ...") - ((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted))) + (start-project-server dir http-port launch-wanted localhost-wanted)) (define (make-publish-dir-name [project-root (current-directory)] [arg-command-name #f]) (define user-publish-path @@ -205,7 +213,7 @@ version print the version" (current-server-port) (make-publish-di (and (>= (length xs) (length prefix)) (andmap equal? prefix (for/list ([(x idx) (in-indexed xs)] #:break (= idx (length prefix))) - x)))) + x)))) ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir))) (define (handle-publish)