start app

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)

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)