Overview
| Comment: | Remove attr-present (redundant) | 
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk | 
| Files: | files | file ages | folders | 
| SHA3-256: | fdc4797490ff4a0c4a1e6a84f8080e41 | 
| User & Date: | joel on 2019-03-31 20:19:00 | 
| Other Links: | manifest | tags | 
Context
| 2019-04-04 | ||
| 15:48 | Merge alternate header/logo concept check-in: 5dbeca0e user: joel tags: trunk | |
| 15:22 | Subtler header + new logo concept Leaf check-in: 671acdae user: joel tags: alt-logo | |
| 2019-03-31 | ||
| 20:19 | Remove attr-present (redundant) check-in: fdc47974 user: joel tags: trunk | |
| 2019-03-24 | ||
| 00:50 | Correct scribble doc for select-rows! check-in: 4e28f613 user: joel tags: trunk | |
Changes
Modified code-docs/dust.scrbl from [d396f326] to [3dab2a11].
| ︙ | ︙ | |||
| 51 52 53 54 55 56 57 | 
These are project-wide pagetrees: @racket[articles-pagetree] contains a pagenode for every Pollen
document contained in @racket[articles-path], and @racket[series-pagetree] contains a pagenode for
every Pollen document in @racket[series-path]. The pagenodes themselves point to the rendered
@tt{.html} targets of the source documents.
@section{Metas and @code{txexpr}s}
 | < < < < < | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | 
These are project-wide pagetrees: @racket[articles-pagetree] contains a pagenode for every Pollen
document contained in @racket[articles-path], and @racket[series-pagetree] contains a pagenode for
every Pollen document in @racket[series-path]. The pagenodes themselves point to the rendered
@tt{.html} targets of the source documents.
@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.
I had to write this because @racket[attr-ref] wants a whole tagged X-expression (not just the
attributes); also, by default it raises an exception when @racket[_key] is missing, rather than
 | 
| ︙ | ︙ | 
Modified dust.rkt from [43f7824f] to [23ec4654].
| ︙ | ︙ | |||
| 33 34 35 36 37 38 39 | 
;; 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
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
 | < | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | 
;; 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
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         make-tag-predicate
         tx-strs
         ymd->english
         ymd->dateformat
         default-authorname
         default-title
         articles-path
 | 
| ︙ | ︙ | |||
| 100 101 102 103 104 105 106 | `(root ,@(include-in-pagetree articles-path ".poly.pm"))) (define (series-pagetree) `(root ,@(include-in-pagetree series-path ".poly.pm"))) ;; ~~~ Convenience functions for tagged x-expressions ~~~ | < < < < | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | 
  `(root ,@(include-in-pagetree articles-path ".poly.pm")))
(define (series-pagetree)
  `(root ,@(include-in-pagetree series-path ".poly.pm")))
;; ~~~ Convenience functions for tagged x-expressions ~~~
(define (maybe-attr name attrs [missing ""])
  (define result (assoc name attrs))
  (cond
    [(pair? result) (cadr result)]
    [else missing]))
;; Returns a function will test if a txexpr's tag matches the given symbol.
 | 
| ︙ | ︙ | |||
| 130 131 132 133 134 135 136 | 
  (define test-attrs '([name "Hazel"] [rank "Chief"]))
  (parameterize ([current-metas test-metas])
    (check-equal? (maybe-meta 'name) "Fiver") ; present meta
    (check-equal? (maybe-meta 'age) "")       ; missing meta
    (check-equal? (maybe-meta 'age 2) 2))      ; alternate default value
  
 | < < | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | 
  (define test-attrs '([name "Hazel"] [rank "Chief"]))
  (parameterize ([current-metas test-metas])
    (check-equal? (maybe-meta 'name) "Fiver") ; present meta
    (check-equal? (maybe-meta 'age) "")       ; missing meta
    (check-equal? (maybe-meta 'age 2) 2))      ; alternate default value
  
  (check-equal? (maybe-attr 'rank test-attrs) "Chief")
  (check-equal? (maybe-attr 'dingus test-attrs) "")
  (check-equal? (maybe-attr 'dingus test-attrs "zippy") "zippy"))
;; Return the first N words out of a list of txexprs. This function will unpack the strings out of
;; the elements of one txexpr at a time until it finds the requested number of words. It aims to be
;; both reliable and fast for any size of list you pass it, and smart about the punctuation it
 | 
| ︙ | ︙ | |||
| 221 222 223 224 225 226 227 | 
(define (build-note-id txpr)
  (string-append (maybe-attr 'date (get-attrs txpr))
                 "_"
                 (uri-encode (maybe-attr 'author (get-attrs txpr) default-authorname))))
;; Extract the last disposition (if any), and the ID of the disposing note, out of a list of notes
(define (notes->last-disposition-values txprs)
 | | | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | 
(define (build-note-id txpr)
  (string-append (maybe-attr 'date (get-attrs txpr))
                 "_"
                 (uri-encode (maybe-attr 'author (get-attrs txpr) default-authorname))))
;; Extract the last disposition (if any), and the ID of the disposing note, out of a list of notes
(define (notes->last-disposition-values txprs)
  (define (contains-disposition? tx) (attrs-have-key? tx 'disposition))
  (define disp-notes (filter contains-disposition? txprs))
  (cond [(not (empty? disp-notes))
         (define latest-disposition-note (last disp-notes))
         (values (attr-ref latest-disposition-note 'disposition)
                 (build-note-id latest-disposition-note))]
        [else (values "" "")]))
        
 | 
| ︙ | ︙ |