A bookmarks-edit.rkt => bookmarks-edit.rkt +116 -0
@@ 0,0 1,116 @@
+#lang racket/gui
+(require "persist.rkt")
+
+(define bookmarks-edit-window
+ (new frame%
+ [label "Edit Bookmark"]
+ [width 600]
+ [x 200]
+ [y 200]))
+
+(define panel
+ (new vertical-panel%
+ [parent bookmarks-edit-window]
+ [vert-margin 2]
+ [horiz-margin 2]
+ [alignment '(left bottom)]))
+
+(define title-field
+ (new text-field%
+ [label "Title"]
+ [parent panel]))
+
+(define url-field
+ (new text-field%
+ [label "URL"]
+ [parent panel]))
+
+(define favourite-checkbox
+ (new check-box%
+ [label "Favourite"]
+ [parent panel]))
+
+(define f-message
+ (new message%
+ [parent panel]
+ [label "Favourite bookmarks are shown in the bookmarks menu and the new tab (if set in the preferences)."]))
+
+(define subscribe-checkbox
+ (new check-box%
+ [label "Subscribe"]
+ [parent panel]))
+
+(define s-message
+ (new message%
+ [parent panel]
+ [label "Subscriptions are shown in the new tab when they update (if set in the preferences)."]))
+
+(define tags-field
+ (new text-field%
+ [label "Tags"]
+ [parent panel]))
+
+(define t-message
+ (new message%
+ [parent panel]
+ [label "Tags should be comma separated."]))
+
+(define n-message
+ (new message%
+ [parent panel]
+ [label "Notes:"]))
+
+(define notes-canvas
+ (new editor-canvas%
+ [parent panel]
+ [line-count 5]
+ [label "Editor Canvas"]))
+
+(define notes-text (new text%))
+(send notes-text insert "")
+(send notes-canvas set-editor notes-text)
+
+(define footer
+ (new horizontal-panel%
+ [parent bookmarks-edit-window]
+ [horiz-margin 2]
+ [vert-margin 2]
+ [alignment '(right bottom)]))
+
+(define cancel-button
+ (new button%
+ [label "Cancel"]
+ [parent footer]
+ [callback (lambda (b e)
+ (send bookmarks-edit-window show #f))]))
+
+(define (save-values b e)
+ (let ([url (send url-field get-value)]
+ [title (send title-field get-value)]
+ [favourite (send favourite-checkbox get-value)]
+ [subscribe (send subscribe-checkbox get-value)]
+ [tags (string-split (send tags-field get-value) "," #:trim? #t)]
+ [notes (send notes-text get-text)])
+ (add-bookmark (make-bookmark url title subscribe favourite 0 tags notes))
+ (send bookmarks-edit-window show #f)))
+
+(define save-button
+ (new button%
+ [label "Save"]
+ [parent footer]
+ [callback save-values]))
+
+
+(define (show-edit-bookmark-window b)
+ (send url-field set-value (bookmark-url b))
+ (send title-field set-value (bookmark-title b))
+ (send favourite-checkbox set-value (bookmark-favourite b))
+ (send subscribe-checkbox set-value (bookmark-subscribe b))
+ (send tags-field set-value (string-join (bookmark-tags b) ", "))
+ (send notes-text insert (bookmark-notes b))
+ (send bookmarks-edit-window show #t))
+
+(provide show-edit-bookmark-window)
+
+(module+ main
+ (show-edit-bookmark-window (make-bookmark "")))
M config.rkt => config.rkt +1 -1
@@ 26,6 26,6 @@ version
;; Config parameters
-(define debug-mode? (make-parameter #f))
+(define debug-mode? (make-parameter #t))
M persist.rkt => persist.rkt +13 -9
@@ 42,6 42,7 @@
(set-default-pref 'homepage "gemini://gemini.circumlunar.space")
(set-default-pref 'new-tab-section/aggregators #t)
+(set-default-pref 'new-tab-section/favourites #t)
;;;;;;;;;;;;;;;;;;;;;;;;
@@ 50,12 51,12 @@
(define bookmarks-file (build-path data-folder "bookmarks.rktd"))
-(define bookmarks (make-parameter '()))
+(define bookmarks (make-parameter (make-hash)))
(serializable-struct bookmark
(url
title
- tracking
+ subscribe
favourite
last-checksum
tags
@@ 63,23 64,25 @@
#:mutable
#:transparent)
-(define (make-bookmark url [title ""] [tracking #f] [favourite #f] [last-checksum 0] [tags '()] [notes ""])
- (bookmark url title tracking favourite last-checksum tags notes))
+(define (make-bookmark url [title ""] [subscribe #f] [favourite #f] [last-checksum 0] [tags '()] [notes ""])
+ (bookmark url title subscribe favourite last-checksum tags notes))
(define (add-bookmark b)
(let ([bs (bookmarks)])
- (bookmarks (append bs b))))
+ (hash-set! bs (bookmark-url b) b)
+ (save-bookmarks)))
(define (save-bookmarks)
(let ([s (serialize (bookmarks))])
(with-output-to-file bookmarks-file
- (write (bookmarks))
+ (lambda () (write s))
#:exists 'replace)))
(define (load-bookmarks)
(let ([bs (if (file-exists? bookmarks-file)
- (deserialize (port->string (open-input-file bookmarks-file)))
- '())])
+ (with-input-from-file bookmarks-file
+ (lambda () (deserialize (read))))
+ (make-hash))])
(bookmarks bs)))
@@ 88,5 91,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ main
(displayln data-folder)
- (displayln preferences-file))
+ (displayln preferences-file)
+ (load-bookmarks))
M preferences.rkt => preferences.rkt +7 -0
@@ 27,6 27,12 @@
[parent panel]
[value (get-pref 'new-tab-section/aggregators)]))
+(define new-tab-section/favourites-checkbox
+ (new check-box%
+ [label "Show favourites in new tab"]
+ [parent panel]
+ [value (get-pref 'new-tab-section/favourites)]))
+
(define footer
(new horizontal-panel%
[parent preferences-window]
@@ 44,6 50,7 @@
(define (save-values b e)
(set-pref 'homepage (send homepage-field get-value))
(set-pref 'new-tab-section/aggregators (send new-tab-section/aggregators-checkbox get-value))
+ (set-pref 'new-tab-section/favourites (send new-tab-section/favourites-checkbox get-value))
(send preferences-window show #f))
(define save-button
M window.rkt => window.rkt +42 -7
@@ 10,6 10,7 @@
"utils.rkt"
"history.rkt"
"persist.rkt"
+ "bookmarks-edit.rkt"
"preferences.rkt")
(provide initialize-window)
@@ 33,6 34,7 @@
])
(define tabs '())
+
(define current-url #f)
(external-browser (lambda (u)
@@ 160,13 162,20 @@
(send multi-transport fetch url current-url))
(define (new-tab-template)
- (let ([aggregators (if (get-pref 'new-tab-section/aggregators)
- `((heading 1 "Aggregators")
- (link "gemini://gemini.circumlunar.space/capcom/" "CAPCOM")
- (link "gemini://rawtext.club:1965/~sloum/spacewalk.gmi" "Spacewalk"))
- '())])
- (append aggregators)))
-
+ (let* ([aggregators (if (get-pref 'new-tab-section/aggregators)
+ `((heading 1 "Aggregators")
+ (link "gemini://gemini.circumlunar.space/capcom/" "CAPCOM")
+ (link "gemini://rawtext.club:1965/~sloum/spacewalk.gmi" "Spacewalk"))
+ '())]
+ [favourites (if (and (get-pref 'new-tab-section/favourites) #t)
+ (append
+ '((heading 1 "Favourites"))
+ (map (lambda (b) `(link ,(bookmark-url b) ,(bookmark-title b))) (filter (lambda (b) (bookmark-favourite b)) (hash-values (bookmarks)))))
+ '())]
+ [template (append aggregators favourites)])
+ (when (debug-mode?)
+ (pretty-print template))
+ template))
(define (new-tab [url #f])
(send browser-tabs append "New Tab")
@@ 237,6 246,19 @@
(define (render-complete)
(void))
+(define (current-tab)
+ (list-ref tabs (send browser-tabs get-selection)))
+
+(define (current-tab-title)
+ (let* ([t (current-tab)]
+ [m (tab-mime t)]
+ [c (tab-content t)])
+ (cond [(equal? m "text/gemini") (let ([first-heading (findf (lambda (l) (and (equal? (first l) 'heading) (equal? (second l) 1))) c)])
+ (if first-heading
+ (third first-heading)
+ ""))]
+ [else ""])))
+
; needs to be after parent show so that we have parents dimensions
(define browser-tabs
(new tab-panel%
@@ 344,6 366,19 @@
[shortcut #\h]
[callback (λ _ (show-history-window history-backward new-tab))]))
+ (define bookmarks-menu
+ (new menu%
+ [parent menu-bar]
+ [label "Bookmarks"]))
+
+ (define add-bookmark-menu
+ (new menu-item%
+ [parent bookmarks-menu]
+ [label "A&dd bookmark"]
+ [help-string "Add current site to bookmarks"]
+ [shortcut #\d]
+ [callback (λ _ (show-edit-bookmark-window (make-bookmark current-url (current-tab-title))))]))
+
(define help-menu
(new menu%
[parent menu-bar]