Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -16,10 +16,11 @@ (require pollen/setup pollen/core pollen/template racket/string racket/function + racket/list txexpr db/base "sqlite-tools.rkt" "snippets-html.rkt" "dust.rkt") @@ -332,11 +333,22 @@ (define (article-plain-title pagenode) (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode))) ;; ~~~ Keyword Index Entries ~~~ -;; (private) Save any index entries in doc to the cache +;; (private) Convert an entry key into a list of at most two elements, +;; a main entry and a sub-entry. +;; "entry" → '("entry" "") +;; "entry!sub" → '("entry" "sub") +;; "entry!sub!why?!? '("entry" "sub") +(define (split-entry str) + (define splits (string-split str "!")) + (list (car splits) + (cadr (append splits (list ""))))) + +;; (private) Save any index entries in doc to the SQLite cache +;; Sub-entries are specified by "!" in the index key (define (crystalize-index-entries! pagenode doc) (define (index-entry? tx) (and (txexpr? tx) (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index (attr-ref tx 'data-index-entry #f))) @@ -346,12 +358,13 @@ (query! "DELETE FROM `keywordindex` WHERE `pagenode` = ?1" (symbol->string pagenode)) (unless (null? entries) (define entry-rows (for/list ([entry-tx (in-list entries)]) - (list (attr-ref entry-tx 'data-index-entry) - "" ; subentries not yet implemented + (define entry-parts (split-entry (attr-ref entry-tx 'data-index-entry))) + (list (first entry-parts) + (second entry-parts) (symbol->string pagenode) (attr-ref entry-tx 'id)))) (query! (make-insert-rows-query "keywordindex" table_keywordindex-fields entry-rows)))) ;; ~~~ Series ~~~ Index: keyword-index.rkt ================================================================== --- keyword-index.rkt +++ keyword-index.rkt @@ -7,78 +7,147 @@ ;; the articles, by pulling them out of the SQLite cache DB. (require racket/match racket/list racket/file + racket/string db/base net/uri-codec pollen/template) (require "crystalize.rkt" + "dust.rkt" "snippets-html.rkt") (provide main) -;; Get the index entries from the SQLite cache, return them as a list of vectors +;; Terminology (because these things get confusing fast) +;; +;; Index HEADING: A word or phrase that appears in the index +;; Index SUBHEADING: A Heading that appears under another Heading +;; Index LINK: The connection between a particular Article and a Heading. +;; In the Index, represented by a URL+fragment back into the Article. +;; In the Article, represented by a URL+fragment to the Heading in the Index. +;; Index ENTRY: A Heading, a unique ID, a list of Links, and a list of Subheading-entries +;; Index RECORD: A simple vector representing a Link the way it is fetched from the SQLite +;; cache: #("heading" "subheading" NUMBER "/absolute-path.html#id_fragment" "Article Title") + +(struct entry (heading ; String + id ; String + links ; List + subentries) #:transparent) ; List of entry structs + +;; Get the first letter of an entry’s heading +(define (first-letter e) + (char-upcase (first (string->list (entry-heading e))))) + +;; Format the ID for back-linking to a particular entry on the keyword index page +(define (format-entry-id head subhead) + (define maybe-sub + (cond [(non-empty-string? subhead) (string-append "!" subhead)] + [else ""])) + (uri-encode (string-downcase (string-append head maybe-sub)))) + +;; Convert a Record into a txexpr representing a link to the original article +(define (make-link rec) + (match-define (vector _ _ num link-url article-title) rec) + `(a [[href ,link-url] + [title ,article-title]] + ,(number->string num))) + +;; See if a Record belongs under an entry's heading or under an entry's subheading. +;; For subheadings, only checks the first one! This is because we rely on the records +;; being pre-alphabetized as they are fetched from the SQLite cache, and being +;; processed in order. +(define (test-match e record) + (match-define (vector record-head record-subhead _ _ _) record) + (define heading-match? + (string-ci=? (entry-heading e) record-head)) + (define subheading-match? + (and heading-match? + (not (null? (entry-subentries e))) + (non-empty-string? record-subhead) + (string-ci=? (entry-heading (first (entry-subentries e))) record-subhead))) + + (cond [(and heading-match? subheading-match?) 'existing-subhead] + [(and heading-match? + (non-empty-string? record-subhead)) 'new-subhead] + [heading-match? 'heading] + [else 'not-a-match])) + +;; Add a record’s link to the front of an entry’s list of links +(define (add-entry-link e rec) + (define existing-links (entry-links e)) + (struct-copy entry e [links (cons (make-link rec) existing-links)])) + +;; Add a record’s link to the first subheading given in an entry. +(define (add-to-first-subentry e record) + (match-define (entry _ _ _ (cons last-sub rest-subs)) e) + (define updated-sub (add-entry-link last-sub record)) + (struct-copy entry e [subentries (cons updated-sub rest-subs)])) + +;; Add a record's link to a new subheading in an entry +(define (add-new-subentry e record) + (match-define (vector head subhead _ _ _) record) + (define subhead-id (format-entry-id head subhead)) + (define new-sub (entry subhead subhead-id (list (make-link record)) '())) + (struct-copy entry e [subentries (list new-sub)])) + +;; Make a new entry from a record, placing its link in either the main entry +;; or in a new sub-entry. +(define (new-entry record) + (match-define (vector head subhead _ _ _) record) + (define e (entry head (format-entry-id head "") '() '())) + (cond [(non-empty-string? subhead) (add-new-subentry e record)] + [else (add-entry-link e record)])) + +;; Get the index entries from the SQLite cache, return them as a list of vectors (Records!) (define (fetch-entries) (define q ◊string-append{ - SELECT entry, subentry, a.rowid, "/" || k.pagenode || "#" || anchor AS href, title_plain + SELECT entry, subentry, a.rowid, "◊web-root" || k.pagenode || "#" || anchor AS href, title_plain FROM keywordindex k INNER JOIN articles a ON a.pagenode = k.pagenode - ORDER BY entry COLLATE NOCASE ASC;}) + ORDER BY entry COLLATE NOCASE ASC, subentry COLLATE NOCASE ASC;}) (query-rows (sqltools:dbc) q)) -;; Convert a vector (row) into a txexpr representing a link to the original article -(define (make-link row) - `(a [[href ,(vector-ref row 3)] - [title ,(vector-ref row 4)]] - ,(number->string (vector-ref row 2)))) - -;(require sugar/debug) - ;; Convert a list of vectors from the cache DB into a list of the form: -;; (list (cons FIRST-LETTER -;; (list (cons KEYWORD -;; (list LINKS ...)) -;; ...)) -;; ...) -(define (group-entries data) - (define collated-list - (for/fold ([entry-table null] - #:result (reverse entry-table)) - ([row (in-list data)]) - (define this-entry (vector-ref row 0)) - (cond [(and (not (null? entry-table)) - (string-ci=? (first (first entry-table)) this-entry)) - (match-define (cons (list last-entry last-list) rest-entries) entry-table) - (cons `(,last-entry ,(append last-list (list (make-link row)))) rest-entries)] - [else - (cons `(,this-entry ,(list (make-link row))) - entry-table)]))) - (define (first-letter entry) - (char-upcase (first (string->list (first entry))))) - - (for/list ([letter-group (in-list (group-by first-letter collated-list))]) +;; ((FIRST-LETTER (entries ...)) ...) +;; The method relies on the records being pre-sorted by the SQL query. +(define (group-entries records) + (define collated + (for/fold ([entries (list (new-entry (first records)))] + #:result (reverse entries)) + ([row (in-list (rest records))]) + (match-define (cons last-entry rest-entries) entries) + (case (test-match last-entry row) + [(existing-subhead) (cons (add-to-first-subentry last-entry row) rest-entries)] + [(new-subhead) (cons (add-new-subentry last-entry row) rest-entries)] + [(heading) (cons (add-entry-link last-entry row) rest-entries)] + [else (cons (new-entry row) entries)]))) + (for/list ([letter-group (in-list (group-by first-letter collated))]) (list (first-letter (first letter-group)) letter-group))) -(define (entry+links->txexpr entry) - (match-define (list entry-word links) entry) - `(li [[id ,(uri-encode (string-downcase entry-word))]] - ,entry-word nbsp - ,@(add-between links ", "))) +;; Convert an entry into a list item, recursively adding subentries +(define (entry->txexpr e) + (match-define (entry head id links subentries) e) + (define sub-txs + (cond [(null? subentries) ""] + [else `(ul ,@(map entry->txexpr subentries))])) + `(li [[id ,id]] ,head nbsp ,@(add-between links ", ") ,sub-txs)) ;; Return the complete HTML for the keyword index. Each letter group begins with a heading for the ;; letter, followed by a definition list for its entries. -(define (html$-index entries) +(define (html$-index grouped-entries) (define groups - (for/list ([letter-group (in-list entries)]) + (for/list ([letter-group (in-list grouped-entries)]) (match-define (list letter-char entries) letter-group) `(section (h2 ,(list->string (list letter-char))) - (ul ,@(map entry+links->txexpr entries))))) + (ul ,@(map entry->txexpr entries))))) (apply string-append (map ->html groups))) +;; Build the complete HTML page (define (html$-keywordindex-page the-index) ◊string-append{ ◊html$-page-head{The Local Yarn: Keyword Index} Index: web-extra/martin.css.pp ================================================================== --- web-extra/martin.css.pp +++ web-extra/martin.css.pp @@ -650,10 +650,15 @@ #keywordindex ul { margin-top: 0; list-style-type: none; padding: 0; } + + #keywordindex ul ul { + margin-left: 0.5em; + font-size: smaller; + } /* End of mobile-first typography and layout */ }