◊(Local Yarn Code "Check-in [7843fa34]")

Overview
Comment:Use titles from poems as article title if no other title supplied
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 7843fa34beba0d4cf26451f38bdecba27259ac83b686309105ecaf052ab354b7
User & Date: joel on 2019-06-16 20:20:35
Other Links: manifest | tags
Context
2019-06-18
03:53
Improve accessibility (CSS, contrast) check-in: 89123ed5 user: joel tags: trunk
2019-06-16
20:20
Use titles from poems as article title if no other title supplied check-in: 7843fa34 user: joel tags: trunk
19:08
Fix dependency bug in makefile check-in: eafa8b45 user: joel tags: trunk
Changes

Modified crystalize.rkt from [bd3a0100] to [297d7e43].

119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133







-
+







    (body-txpr note-txprs) (splitf-txexpr doc2 (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))
  
  (let* ([pubdate (select-from-metas 'published (current-metas))]
         [doc-html    (->html body-txpr #:splice? #t)]
         [title-specified? (not (equal? '() maybe-title))]
         [title-val   (if (not (null? maybe-title)) (car maybe-title) maybe-title)]
         [title-val   (if (not (null? maybe-title)) (car maybe-title) (check-for-poem-title doc))]
         [title-tx    (make-article-title title-val body-txpr disposition disp-note-id)]
         [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)]
149
150
151
152
153
154
155
156

157
158
159
160
161
162
163
149
150
151
152
153
154
155

156
157
158
159
160
161
162
163







-
+







            (maybe-meta 'noun (series-noun))
            (length note-txprs)
            doc-html
            disposition
            disp-note-id
            (string-append header doc-html footer)
            "" ; listing_excerpt_html: Not yet used
            (html$-article-listing-short pagenode pubdate title-plain))) ; listing_short_html: Not yet used
            (html$-article-listing-short pagenode pubdate title-html)))

    (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
          
    (string-append header doc-html notes-section-html footer)))

;; ~~~ Retrieve listings of articles and notes ~~~
;; ~~~ (Mainly for use on Series pages         ~~~
209
210
211
212
213
214
215



















216
217
218
219
220
221
222
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from
;; listing functions
(define (unfence html-str)
  (regexp-replace* #px"<[\\/]{0,1}style>" html-str ""))

;; ~~~ Article-related helper functions ~~~
;;

;; If the first element is a titled poem, the poem’s title can be used for the article title.
(define (check-for-poem-title doc)
  (define e1 (car (get-elements doc)))
  (define e2 (if (null? (get-elements e1))
                 '()
                 (car (get-elements e1))))
  (cond
    [(and (txexpr? e1)
          (equal? 'div (get-tag e1))
          (attrs-have-key? e1 'class)
          (string=? "poem" (attr-ref e1 'class))
          (not (null? e2))
          (txexpr? e2)
          (equal? 'p (get-tag e2))
          (attrs-have-key? e2 'class)
          (string=? "verse-heading" (attr-ref e2 'class)))
     `(title (span [[class "smallcaps"]] "‘" ,@(get-elements e2) "’"))]
    [else '()]))

;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title supplied-title body-tx disposition disp-note-id)
  (define title-elems
    (cond [(null? supplied-title) (list (default-title (get-elements body-tx)))]
          [else (get-elements supplied-title)]))