Index: crystalize.rkt
==================================================================
--- crystalize.rkt
+++ crystalize.rkt
@@ -121,11 +121,11 @@
     (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)]
@@ -151,11 +151,11 @@
             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)))
 
@@ -211,10 +211,29 @@
 (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)))]