v0.5 Add config file support

README.org

@@ -1,13 +1,17 @@
-* gophwr v0.3
+* gophwr v0.4
   A graphical gopher browser in =racket/gui=.
 
 *** Project goals
     My aim is to create a decent gopher client suitable for daily use without
     resorting to web technologies. No HTML nor CSS under the hood.
 
 ** How to use
+   Install Racket, then run
    ~% racket src/main.rkt [--tls] [address]~
 
+   To configure it, copy the example [[assets/gophwr.rktd][config file]] to your Racket preferences
+   directory (~> (find-system-path 'pref-dir)~).
+
 ** Status
    This project is still under construction, expect occasional breakage.
    Patches welcome.
@@ -22,20 +26,18 @@
     + Save currently viewed page
     + Back/forward page
     + Delegate WWW links to web browser
+    + TLS option
+    + Config file
 
 *** Work in progress
-    + TLS support
-    + Themes
-      + Font settings
-      + Customisable colours
+    + Adjustable TLS support
     + Mouseover/right-click links
-    + Render images
 
 *** Up next
     + Options menu
+    + Bookmarks
     + Duplicate (=+=) types
     + Keyboard shortcuts
-    + Bookmarks
-    + Tabbed navigation
     + Find in page
     + Zooming
+    + Tabbed navigation

assets/gophwr.rktd

@@ -0,0 +1,30 @@
+(
+ (homepage "gopher.erkin.party:70/1/links")
+ (download-folder "/home/erkin/tmp")
+
+ (scrolls-per-page 500)
+ (wheel-step 1)
+ (auto-wrap? #f)
+
+ (initial-width 1024)
+ (initial-height 768)
+
+ ;; A string containing the name of the font
+ ;; #f for default monospace.
+ (font-name #f)
+ (font-size 11)
+ (title-size 23)
+
+ ;; Besides hexcodes, strings of colour names are accepted as well.
+ ;; To see a list of colours, try:
+ ;; (require racket/draw) (for-each displayln (send the-color-database get-names))
+
+ (fg-colour (#xEE #xEE #xEE))
+ (bg-colour (#x11 #x11 #x11))
+ (menu-colour (#xAA #xAA #xEE))
+ (link-colour (#xAA #xEE #xAA))
+ (error-colour (#xEE #xAA #xAA))
+ (document-colour (#xEE #xEE #xAA))
+ (download-colour (#xEE #xAA #xEE))
+ (clicked-colour (#xAA #xEE #xEE))
+)

src/config.rkt

@@ -1,48 +1,42 @@
 #lang racket/base
 (provide (all-defined-out))
+(require (only-in racket/draw make-color)
+         (only-in racket/file get-preference))
 
-(require (only-in racket/draw make-color))
+(define config-file (build-path (find-system-path 'pref-dir) "gophwr.rktd"))
 
-;;;; These will be adjustable in the options menu.
+(define tls-enabled? (make-parameter #f))
 
-(define *homepage* "suika.erkin.party:70/1/gophwr")
+;;; Preferences
+(define-syntax-rule (define-preference symbol default)
+  (define symbol
+    (get-preference (quote symbol) (λ () default) 'timestamp config-file)))
 
-(define *download-folder* #f)
+(define-preference homepage "suika.erkin.party:70/1/gophwr")
+(define-preference download-folder #f)
 
-(define *scrolls-per-page* 500)
-(define *wheel-step* 1)
+(define-preference scrolls-per-page 500)
+(define-preference wheel-step 1)
+(define-preference auto-wrap? #f)
 
-(define *initial-width* 1024)
-(define *initial-height* 768)
+(define-preference initial-width 1024)
+(define-preference initial-height 768)
 
-(define tls-enabled? (make-parameter #f))
-(define auto-wrap? (make-parameter #f))
-
-;; A string containing the name of the font
-;; #f for default monospace.
-(define *font* #f)
-
-(define *font-size* 11)
-(define *title-size* 23)
-
-;; Besides hexcodes, strings of colour names are accepted as well.
-;; To see a list of colours, try:
-;; (require racket/draw) (for-each displayln (send the-color-database get-names))
-
-(define *fg-colour*
-  (make-color #xEE #xEE #xEE))
-(define *bg-colour*
-  (make-color #x11 #x11 #x11))
-
-(define *menu-colour*
-  (make-color #xAA #xAA #xEE))
-(define *link-colour*
-  (make-color #xAA #xEE #xAA))
-(define *error-colour*
-  (make-color #xEE #xAA #xAA))
-(define *document-colour*
-  (make-color #xEE #xEE #xAA))
-(define *download-colour*
-  (make-color #xEE #xAA #xEE))
-(define *clicked-colour*
-  (make-color #xAA #xEE #xEE))
+(define-preference font-name #f)
+(define-preference font-size 11)
+(define-preference title-size 23)
+
+;;; Colours
+(define-syntax-rule (define-colour colour rgb)
+  (define colour
+    (apply make-color (get-preference (quote symbol) (λ () rgb) 'timestamp config-file))))
+
+(define-colour fg-colour '(#xEE #xEE #xEE))
+(define-colour bg-colour '(#x11 #x11 #x11))
+
+(define-colour menu-colour '(#xAA #xAA #xEE))
+(define-colour link-colour '(#xAA #xEE #xAA))
+(define-colour error-colour '(#xEE #xAA #xAA))
+(define-colour document-colour '(#xEE #xEE #xAA))
+(define-colour download-colour '(#xEE #xAA #xEE))
+(define-colour clicked-colour '(#xAA #xEE #xEE))

src/const.rkt

@@ -2,12 +2,12 @@
 (provide (all-defined-out))
 
 
-(define *project-name* "gophwr")
-(define *project-version* "v0.3.5")
+(define project-name "gophwr")
+(define project-version "v0.4.0")
 
-(define *version-message*
+(define version-message
   (list
-   (string-append *project-name* " " *project-version*)
+   (string-append project-name " " project-version)
    "Copyright (C) 2019 Erkin Batu Altunbaş"
    ""
    "Each file of this project's source code is subject "

src/entry.rkt

@@ -20,36 +20,36 @@
 (define (initialise-styles)
   (send* d-usual
     (set-family 'modern)
-    (set-face *font*)
-    (set-delta 'change-size *font-size*)
-    (set-delta-foreground *fg-colour*)
-    (set-delta-background *bg-colour*))
+    (set-face font-name)
+    (set-delta 'change-size font-size)
+    (set-delta-foreground fg-colour)
+    (set-delta-background bg-colour))
   (send* d-title
     (copy d-usual)
-    (set-delta 'change-size *title-size*))
+    (set-delta 'change-size title-size))
   (send* d-error
     (copy d-usual)
-    (set-delta-foreground *error-colour*))
+    (set-delta-foreground error-colour))
   ;; Menus we can navigate to
   (send* d-menu
     (copy d-usual)
-    (set-delta-foreground *menu-colour*))
+    (set-delta-foreground menu-colour))
   ;; Outgoing (web) links
   (send* d-link
     (copy d-usual)
-    (set-delta-foreground *link-colour*))
+    (set-delta-foreground link-colour))
   ;; Links to text files we can render
   (send* d-document
     (copy d-usual)
-    (set-delta-foreground *document-colour*))
+    (set-delta-foreground document-colour))
   ;; Binary files we can download
   (send* d-download
     (copy d-usual)
-    (set-delta-foreground *download-colour*))
+    (set-delta-foreground download-colour))
   ;; Style after click
   (send* d-clicked
     (copy d-usual)
-    (set-delta-foreground *clicked-colour*)))
+    (set-delta-foreground clicked-colour)))
 
 
 (define (render-text page content go-to)

src/info.rkt

@@ -3,7 +3,7 @@
 (define deps '("base" "gui-lib" "net-lib"))
 (define build-deps '())
 (define pkg-desc "A graphical gopher browser in Racket")
-(define version "0.3")
+(define version "0.4")
 (define pkg-authors '(erkin))
 (define gracket-launcher-names '("gophwr"))
 (define gracket-launcher-libraries '("main.rkt"))

src/main.rkt

@@ -9,20 +9,17 @@
 
 
 (define (display-version)
-  (for-each displayln *version-message*)
+  (for-each displayln version-message)
   (exit null))
 
 (module+ main
   (define addresses
     (command-line
-     #:program *project-name*
-
+     #:program project-name
      #:once-each
      (("--ssl" "--tls")
       "Enable TLS mode"
       (tls-enabled? #t))
-
-     #:once-any
      (("--version" "-v")
       "Show version and licence information"
       (display-version))
@@ -33,7 +30,7 @@
      ;; addresses as separate tabs in the future.
      #:args addresses
      (if (null? addresses)
-         (list *homepage*)
+         (list homepage)
          addresses)))
 
   (when (tls-enabled?)

src/window.rkt

@@ -19,9 +19,9 @@
 (define frame
   (new frame%
        (label
-        (string-append *project-name* " \u2014 " address))
-       (width *initial-width*)
-       (height *initial-height*)))
+        (string-append project-name " \u2014 " address))
+       (width initial-width)
+       (height initial-height)))
 
 ;;;; Menubar
 (define menu-bar
@@ -61,7 +61,7 @@
        (callback
         (λ _
           (let* ((filename (put-file "Choose a download location"
-                                     frame *download-folder* (last (string-split address "/")))))
+                                     frame download-folder (last (string-split address "/")))))
             (when filename
               (save-file filename
                          (send page-text get-text)
@@ -78,8 +78,8 @@
        (help-string "Show version and licence info")
        (callback (λ _
                    (message-box
-                    (string-append "About " *project-name*)
-                    (string-join *version-message* "\n") frame
+                    (string-append "About " project-name)
+                    (string-join version-message "\n") frame
                     '(ok no-icon))))))
 
 
@@ -110,7 +110,7 @@
 (define home-key
   (new button% (parent address-pane)
        (label "\u2302") ; House sign
-       (callback (λ _ (go-to *homepage*)))))
+       (callback (λ _ (go-to homepage)))))
 
 (define address-field
   (new text-field% (parent address-pane)
@@ -132,8 +132,8 @@
   (new editor-canvas% (parent frame)
        ;; I need a better way to handle auto-wrap/hscroll
        (style '(no-focus no-hscroll auto-vscroll))
-       (scrolls-per-page *scrolls-per-page*)
-       (wheel-step *wheel-step*)
+       (scrolls-per-page scrolls-per-page)
+       (wheel-step wheel-step)
        ;; Minimum size the canvas can be shrunk to is 16 lines.
        (line-count 16)
        (stretchable-width #t)
@@ -142,7 +142,7 @@
 (define page-text
   (new text%
    (line-spacing 0.6)
-   (auto-wrap (auto-wrap?))))
+   (auto-wrap auto-wrap?)))
 
 
 ;;; GUI starts here.
@@ -159,7 +159,7 @@
     (change-style d-usual)
     (set-max-undo-history 0))
   (send* page-canvas
-    (set-canvas-background *bg-colour*)
+    (set-canvas-background bg-colour)
     (set-editor page-text)
     (lazy-refresh #t))
 
@@ -184,7 +184,7 @@
 (define (loaded)
   (send frame set-status-text "")
   (send frame set-label
-        (string-append *project-name* " \u2014 " address)) ; em-dash
+        (string-append project-name " \u2014 " address)) ; em-dash
   (send page-text scroll-to-position 0)
   (when (send page-text in-edit-sequence?)
     (send page-text end-edit-sequence))
@@ -196,13 +196,13 @@
   (loaded)
   (send frame set-status-text "Error!")
   (send page-text insert
-        (string-append* *project-name* " error: " strs)))
+        (string-append* project-name " error: " strs)))
 
 (define (make-image-snip image-bytes type)
   (make-object image-snip%
                (make-object bitmap%
                             (open-input-bytes image-bytes)
-                            type *bg-colour* #t)))
+                            type bg-colour #t)))
 
 ;;; Navigation
 (define (refresh)
@@ -290,7 +290,7 @@
   (thread
    (λ ()
      (let ((filename (put-file "Choose a download location"
-                               frame *download-folder* (last (string-split path "/")))))
+                               frame download-folder (last (string-split path "/")))))
        (when filename
          (save-file filename
                     (fetch-file domain port path #:type 'binary)