Compare commits
9 Commits
Author | SHA1 | Date |
---|---|---|
|
9b4515a104 | 4 years ago |
|
d0baaf3b66 | 4 years ago |
|
c567373950 | 4 years ago |
|
7de0d30b84 | 4 years ago |
|
13e6524922 | 4 years ago |
|
fb44ea118e | 4 years ago |
|
15cf8f4e6f | 4 years ago |
|
fd3a3cd38b | 4 years ago |
|
5637261606 | 4 years ago |
Binary file not shown.
Binary file not shown.
After Width: | Height: | Size: 431 KiB |
Binary file not shown.
After Width: | Height: | Size: 14 KiB |
@ -0,0 +1,180 @@
|
|||||||
|
#lang debug racket/gui
|
||||||
|
(require pollen/private/log
|
||||||
|
pollen/private/command
|
||||||
|
pollen/setup
|
||||||
|
pollen/private/project-server
|
||||||
|
net/sendurl)
|
||||||
|
|
||||||
|
(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 500]
|
||||||
|
[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 current-server-stopper (make-parameter #f))
|
||||||
|
|
||||||
|
(define (set-current-manager-directory val)
|
||||||
|
(current-manager-directory val)
|
||||||
|
(send directory-msg set-label (if val (path->string val) "")))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(set-current-manager-directory (expand-user-path "~/git/bpt/")))
|
||||||
|
|
||||||
|
(define button-directory
|
||||||
|
(let ([str "Select project directory"])
|
||||||
|
(new button%
|
||||||
|
[label str]
|
||||||
|
[parent hpanel-select]
|
||||||
|
[callback (λ (button evt)
|
||||||
|
(define dir (get-directory str))
|
||||||
|
(when dir
|
||||||
|
(set-current-manager-directory dir)
|
||||||
|
(set-server-port (setup:project-server-port dir))))])))
|
||||||
|
|
||||||
|
(define directory-msg
|
||||||
|
(new message%
|
||||||
|
[label ""]
|
||||||
|
[parent hpanel-select]
|
||||||
|
[auto-resize #true]))
|
||||||
|
|
||||||
|
(define hpanel-server-options (make-hpanel))
|
||||||
|
|
||||||
|
(define server-option-port
|
||||||
|
(new text-field%
|
||||||
|
[parent hpanel-server-options]
|
||||||
|
[label "server port"]
|
||||||
|
[min-width 150]
|
||||||
|
[stretchable-width #false]
|
||||||
|
[init-value (number->string (setup:project-server-port))]
|
||||||
|
[callback (λ (tf evt)
|
||||||
|
(set-server-port (string->number (send tf get-value))))]))
|
||||||
|
|
||||||
|
(define (set-server-port num)
|
||||||
|
(when (number? num)
|
||||||
|
(current-server-port num)
|
||||||
|
(send server-option-port set-value (number->string num))))
|
||||||
|
|
||||||
|
|
||||||
|
(define server-option-local
|
||||||
|
(new check-box%
|
||||||
|
[parent hpanel-server-options]
|
||||||
|
[label "local only"]
|
||||||
|
[callback (λ (cb evt)
|
||||||
|
(current-server-listen-ip (and (send cb get-value) "127.0.0.1")))]))
|
||||||
|
|
||||||
|
(define hpanel-server-controls (make-hpanel))
|
||||||
|
|
||||||
|
(define dialog-alert (new dialog%
|
||||||
|
[label "Error"]
|
||||||
|
[border 6]
|
||||||
|
[spacing 6]
|
||||||
|
[parent #f]))
|
||||||
|
|
||||||
|
(define dialog-message (new message%
|
||||||
|
[parent dialog-alert]
|
||||||
|
[auto-resize #t]
|
||||||
|
[label ""]))
|
||||||
|
|
||||||
|
(define dialog-alert-button-pane
|
||||||
|
(new horizontal-pane%
|
||||||
|
[parent dialog-alert]
|
||||||
|
[alignment '(right bottom)]))
|
||||||
|
|
||||||
|
(define dialog-alert-button-ok
|
||||||
|
(new button%
|
||||||
|
[parent dialog-alert-button-pane]
|
||||||
|
[label "OK"]
|
||||||
|
[style '(border)]
|
||||||
|
[callback (λ (button evt)
|
||||||
|
(send dialog-alert show #f))]))
|
||||||
|
|
||||||
|
(define (make-alert str)
|
||||||
|
(send dialog-message set-label str)
|
||||||
|
(send dialog-alert show #t))
|
||||||
|
|
||||||
|
(define button-start
|
||||||
|
(new button%
|
||||||
|
[label "Start project server"]
|
||||||
|
[parent hpanel-server-controls]
|
||||||
|
[callback (λ (button evt)
|
||||||
|
(if (current-server-stopper)
|
||||||
|
(make-alert "Project server already running.")
|
||||||
|
(match (current-manager-directory)
|
||||||
|
[#false (make-alert "No project directory selected.")]
|
||||||
|
[dir
|
||||||
|
(message "starting project server")
|
||||||
|
;; stopper is a function that sends a break signal
|
||||||
|
;; to the web server thread, wherever it is
|
||||||
|
(define stopper
|
||||||
|
(parameterize ([current-project-root dir])
|
||||||
|
(start-server (setup:main-pagetree dir) #:return #true)))
|
||||||
|
(current-server-stopper stopper)])))]))
|
||||||
|
|
||||||
|
(define button-stop
|
||||||
|
(new button%
|
||||||
|
[label "Stop project server"]
|
||||||
|
[parent hpanel-server-controls]
|
||||||
|
[callback (λ (button evt)
|
||||||
|
(match (current-server-stopper)
|
||||||
|
[#false (make-alert "Project server not running.")]
|
||||||
|
[stopper-proc
|
||||||
|
(stopper-proc)
|
||||||
|
(current-server-stopper #false)
|
||||||
|
(message "project server stopped")]))]))
|
||||||
|
|
||||||
|
(define button-launch
|
||||||
|
(new button%
|
||||||
|
[label "Launch browser"]
|
||||||
|
[parent hpanel-server-controls]
|
||||||
|
[callback (λ (button evt)
|
||||||
|
(cond
|
||||||
|
[(current-server-stopper)
|
||||||
|
(send-url
|
||||||
|
(format "http://localhost:~a/~a"
|
||||||
|
(current-server-port)
|
||||||
|
(setup:main-pagetree (current-manager-directory)))
|
||||||
|
#false)]
|
||||||
|
[else (make-alert "Project server not running.")]))]))
|
||||||
|
|
||||||
|
(define status-box
|
||||||
|
(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))
|
||||||
|
|
||||||
|
(define status-box-ed (send status-box get-editor))
|
||||||
|
|
||||||
|
(define log-receiver-thread
|
||||||
|
(thread (λ ()
|
||||||
|
(define rcvr (make-log-receiver pollen-logger 'info 'pollen))
|
||||||
|
(for ([vec (in-producer (λ () (sync rcvr)))])
|
||||||
|
(match-define (vector _ msg _ _) vec)
|
||||||
|
(send status-box-ed insert msg)
|
||||||
|
(send status-box-ed insert "\n")))))
|
||||||
|
|
||||||
|
(send window show #t)
|
@ -0,0 +1,13 @@
|
|||||||
|
#lang br
|
||||||
|
(require pict icns file/ico rsvg)
|
||||||
|
|
||||||
|
(define p (svg-file->pict "pollen-raw.svg"))
|
||||||
|
(send (pict->bitmap p) save-file "pollen.png" 'png)
|
||||||
|
|
||||||
|
(with-output-to-file "pollen.icns"
|
||||||
|
(λ () (void (write-bytes (pict->icns-bytes p))))
|
||||||
|
#:exists 'replace)
|
||||||
|
|
||||||
|
(write-icos (for/list ([size '(16 32 48 256)])
|
||||||
|
(argb->ico size size (pict->argb-pixels (scale p (/ size 720))))) "pollen.ico"
|
||||||
|
#:exists 'replace)
|
Loading…
Reference in New Issue