Overview
| Comment: | Add ◊index tag, save index entries to cache db. Addresses [5daecde7] | 
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk | 
| Files: | files | file ages | folders | 
| SHA3-256: | d76599127fa594324b515877c3fed258 | 
| User & Date: | joel on 2019-05-05 12:46:23 | 
| Other Links: | manifest | tags | 
Context
| 2019-05-05 | ||
| 14:38 | Add styles for keyword index links check-in: 1947b407 user: joel tags: trunk | |
| 12:46 | Add ◊index tag, save index entries to cache db. Addresses [5daecde7] check-in: d7659912 user: joel tags: trunk | |
| 2019-04-30 | ||
| 19:20 | Rename listing functions check-in: 552ad2a9 user: joel tags: trunk | |
Changes
Modified code-docs/dust.scrbl from [63fa6d30] to [f9a0825d].
| ︙ | ︙ | |||
| 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | 
@tt{.html} targets of the source documents.
@defproc[(here-output-path) path?]
Returns the path to the current output file, relative to @racket[current-project-root]. If no metas
are available, raises an error. This is like what you can get from the @tt{here} variable that Pollen
provides, except it is available outside templates.
@section{Metas and @code{txexpr}s}
@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]
Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.
 | > > > > > > > > > > > > | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | 
@tt{.html} targets of the source documents.
@defproc[(here-output-path) path?]
Returns the path to the current output file, relative to @racket[current-project-root]. If no metas
are available, raises an error. This is like what you can get from the @tt{here} variable that Pollen
provides, except it is available outside templates.
@defproc[(here-id [suffix (or/c (listof string?) string? #f) #f]) string?]
Returns the 8-character prefix of the SHA1 hash of the current document’s output path. If no metas
are available, raises an error. If @racket[_suffix] evaluates to a string or a list of strings, they
are appended verbatim to the end of the hash.
This ID is used when creating URL fragment links within an article, such as for footnotes and index
entries. As long as the web version of the article is not moved to a new URL, the ID will remain the
same, which ensures deep links using the ID don’t break. The ID also ensures each article’s internal
links will be unique, so that links do not collide when multiple articles are being shown on
a single HTML page.
@section{Metas and @code{txexpr}s}
@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]
Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.
 | 
| ︙ | ︙ | 
Modified code-docs/pollen.scrbl from [8e12d00a] to [a48aad25].
| ︙ | ︙ | |||
| 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | 
  #lang pollen
  ◊dialogue{
    ◊say["Tavi"]{You also write fiction, or you used to. Do you still?}
    ◊say["Lorde"]{The thing is, when I write now, it comes out as songs.}
  }
}|
@defproc[(note [#:date date-str non-empty-string?]
               [#:author author string? ""]
               [#:author-url author-url string? ""]
               [#:disposition disp-str string? ""]) txexpr?]
Add a note to the “Further Notes” section of the article. Notes are like blog comments but are
 | > > > > > > > > > > > > > > > > > > > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | 
  #lang pollen
  ◊dialogue{
    ◊say["Tavi"]{You also write fiction, or you used to. Do you still?}
    ◊say["Lorde"]{The thing is, when I write now, it comes out as songs.}
  }
}|
@defproc[(index [heading string?] [elements xexpr?] ...) txexpr?]
Creates an entry in the keyword index under @racket[_heading] that points back to this spot in the
document. If @racket[_elements] is not empty, the web edition of the document will use it as the
contents of an understated hyperlink to back to @racket[_heading] in the keyword index.
The example below will create two index entries, one under the heading “compassion” and one under
the heading “cats”:
@codeblock|{
  #lang pollen
  “I have a theory which I suspect is rather immoral,” Smiley 
  went on, more lightly. “Each of us has only a quantum of 
  ◊index["compassion"]{compassion}. That if we lavish our concern
  on every stray ◊index["cats"] cat we never get to the centre of 
  things. What do you think of it?” 
}|
@defproc[(note [#:date date-str non-empty-string?]
               [#:author author string? ""]
               [#:author-url author-url string? ""]
               [#:disposition disp-str string? ""]) txexpr?]
Add a note to the “Further Notes” section of the article. Notes are like blog comments but are
 | 
| ︙ | ︙ | 
Modified crystalize.rkt from [0c40f48a] to [17c941d5].
| ︙ | ︙ | |||
| 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | 
(define table_series-fields
  '(pagenode
    title
    published
    noun_plural
    noun_singular))
(define table_articles (make-table-schema "articles" table_articles-fields))
(define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id)))
(define table_series (make-table-schema "series" table_series-fields))
;; ~~~ Provided functions: Initializing; Saving posts and notes
;; Initialize the database connection, creating the database if it doesn’t
;; exist, and executing the table schema queries
;;
(define (spell-of-summoning!)
 | > > > > > > > > > | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | 
(define table_series-fields
  '(pagenode
    title
    published
    noun_plural
    noun_singular))
(define table_keywordindex-fields
  '(entry
    subentry
    pagenode
    anchor))
(define table_articles (make-table-schema "articles" table_articles-fields))
(define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id)))
(define table_series (make-table-schema "series" table_series-fields))
(define table_keywordindex (make-table-schema "keywordindex"
                                              table_keywordindex-fields
                                              #:primary-key-cols '(pagenode anchor)))
;; ~~~ Provided functions: Initializing; Saving posts and notes
;; Initialize the database connection, creating the database if it doesn’t
;; exist, and executing the table schema queries
;;
(define (spell-of-summoning!)
  (init-db! DBFILE table_articles table_notes table_series table_keywordindex))
;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
(define (crystalize-article! pagenode doc)
  (define-values
    (doc2 maybe-title) (splitf-txexpr doc (make-tag-predicate 'title)))
 | 
| ︙ | ︙ | |||
| 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | 
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]
         [series-node (series-pagenode)]
         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]
         [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]
         [footer (html$-article-close footertext)]
         [notes-section-html (crystalize-notes! pagenode title-plain note-txprs)])
    ;; Values must come in the order defined in table_article_fields
    (define article-record
      (list (symbol->string pagenode)
            title-plain
            title-html
            (bool->int title-specified?)
 | > > | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | 
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]
         [series-node (series-pagenode)]
         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]
         [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]
         [footer (html$-article-close footertext)]
         [notes-section-html (crystalize-notes! pagenode title-plain note-txprs)])
    (crystalize-index-entries! pagenode body-txpr)
    ;; Values must come in the order defined in table_article_fields
    (define article-record
      (list (symbol->string pagenode)
            title-plain
            title-html
            (bool->int title-specified?)
 | 
| ︙ | ︙ | |||
| 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | ;; return html$ of note (html$-note-in-article note-id note-date content-html author author-url)) (define (article-plain-title pagenode) (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode))) ;; ~~~ Series ~~~ ;; Preloads the SQLite cache with info about each series. ;; I may not actually need this but I’m leaving it for now. (define (preheat-series!) (query! "DELETE FROM `series`") (define series-values | > > > > > > > > > > > > > > > > > > > > > > | 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 | 
  
  ;; return html$ of note
  (html$-note-in-article note-id note-date content-html author author-url))
(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
(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)))
  (define-values (_ entries) (splitf-txexpr doc index-entry?))
  ; Naive idempotence: delete and re-insert all index entries every time doc is rendered.
  (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
              (symbol->string pagenode)
              (attr-ref entry-tx 'id))))
    (query! (make-insert-rows-query "keywordindex" table_keywordindex-fields entry-rows))))
;; ~~~ Series ~~~
;; Preloads the SQLite cache with info about each series.
;; I may not actually need this but I’m leaving it for now.
(define (preheat-series!)
  (query! "DELETE FROM `series`")
  (define series-values
 | 
| ︙ | ︙ | 
Modified dust.rkt from [62b90e17] to [c44ac1c4].
| ︙ | ︙ | |||
| 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | 
;; -------------------------------------------------------------------------
(require pollen/core
         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec
         gregor
         txexpr
         racket/list
         racket/system
         racket/string)
;; Provides common helper functions used throughout the project
(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available
         here-output-path
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         invalidate-series
         make-tag-predicate
         tx-strs
         ymd->english
 | > > | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | 
;; -------------------------------------------------------------------------
(require pollen/core
         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec
         file/sha1
         gregor
         txexpr
         racket/list
         racket/system
         racket/string)
;; Provides common helper functions used throughout the project
(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available
         here-output-path
         here-id
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         invalidate-series
         make-tag-predicate
         tx-strs
         ymd->english
 | 
| ︙ | ︙ | |||
| 59 60 61 62 63 64 65 | (define default-authorname "Joel Dueck") (define series-folder "series") (define articles-folder "articles") (define (default-title body-txprs) (format "“~a…”" (first-words body-txprs 5))) | < | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | 
(define default-authorname "Joel Dueck")
(define series-folder "series")
(define articles-folder "articles")
(define (default-title body-txprs)
  (format "“~a…”" (first-words body-txprs 5)))
(define (maybe-meta m [missing ""])
  (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
        [else missing]))
;; Return the current output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
 | 
| ︙ | ︙ | |||
| 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | 
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))
(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))
;; “Touches” the last-modified date on the current article’s series, if there is one
(define (invalidate-series)
  (define series-name (maybe-meta 'series #f))
  (when series-name
    (define series-file (build-path (current-project-root)
 | > > > > > > > > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | 
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))
(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))
;; Generates a short ID for the current article
(define (here-id [suffix #f])
  (define here-hash
    (substring (bytes->hex-string (sha1-bytes (path->bytes (here-output-path)))) 0 8))
  (cond [(list? suffix) (apply string-append here-hash suffix)]
        [(string? suffix) (string-append here-hash suffix)]
        [else here-hash]))
;; “Touches” the last-modified date on the current article’s series, if there is one
(define (invalidate-series)
  (define series-name (maybe-meta 'series #f))
  (when series-name
    (define series-file (build-path (current-project-root)
 | 
| ︙ | ︙ | 
Modified pollen.rkt from [4eb79d88] to [76ee6f63].
| ︙ | ︙ | |||
| 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | (poly-branch-tag smallcaps) (poly-branch-tag center) (poly-branch-tag section) (poly-branch-tag subsection) (poly-branch-tag code) (poly-branch-tag dialogue) (poly-branch-tag say) (poly-branch-kwargs-tag blockcode) (poly-branch-kwargs-tag verse) ; [#:title ""] [#:italic "no"] (poly-branch-tag link) (poly-branch-tag url) (poly-branch-tag fn) (poly-branch-tag fndef) | > | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | (poly-branch-tag smallcaps) (poly-branch-tag center) (poly-branch-tag section) (poly-branch-tag subsection) (poly-branch-tag code) (poly-branch-tag dialogue) (poly-branch-tag say) (poly-branch-tag index) (poly-branch-kwargs-tag blockcode) (poly-branch-kwargs-tag verse) ; [#:title ""] [#:italic "no"] (poly-branch-tag link) (poly-branch-tag url) (poly-branch-tag fn) (poly-branch-tag fndef) | 
| ︙ | ︙ | 
Modified tags-html.rkt from [a9c3097d] to [5a9bf33f].
| ︙ | ︙ | |||
| 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | 
;; Tag functions used by pollen.rkt when HTML is the output format.
(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag
         txexpr
         "dust.rkt")
(provide html-fn
         html-fndef)
;; Customized paragraph decoder replaces single newlines within paragraphs
 | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | 
;; Tag functions used by pollen.rkt when HTML is the output format.
(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag
         net/uri-codec
         txexpr
         "dust.rkt")
(provide html-fn
         html-fndef)
;; Customized paragraph decoder replaces single newlines within paragraphs
 | 
| ︙ | ︙ | |||
| 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | 
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
 | > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | 
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-index
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
 | 
| ︙ | ︙ | |||
| 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | 
  `(body ,@second-pass))
(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))
(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))
(define (html-verse attrs elems)
  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]
 | > > > > > > | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | 
  `(body ,@second-pass))
(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))
(define (html-index . elems)
  `(a [[id ,(here-id (list "_idx-" (uri-encode (car elems))))]
       [data-index-entry ,(car elems)]
       [class "index-link"]]
      ,@(cdr elems)))
(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))
(define (html-verse attrs elems)
  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]
 | 
| ︙ | ︙ |