Stage everything. Bleh, I'll commit to a clean history from now on

1 files changed, 22 insertions, 69 deletions

diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm
index f8a8d6e..7457010 100644
--- a/haunt/jakob/builder/blog.scm
+++ b/haunt/jakob/builder/blog.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 match)
   #:use-module (jakob theme)
   #:use-module (jakob utils)
+  #:use-module (jakob utils pagination)
   #:use-module (jakob utils sxml)
   #:use-module (jakob utils tags)
   #:use-module (srfi srfi-1)
@@ -56,7 +57,21 @@
                (post-ref post 'tags))
           ", "))
     (article
-     ,(post-sxml post))))
+     ,(post-sxml post))
+    (section
+     (@ (id "webmention"))
+     (h2 ,(hyperlink "https://indieweb.org/Webmention" "Webmentions")
+         " for this Page")
+     (ul (@ (id "webmention-container")))
+     (form
+      (@ (action "https://webmention.io/jakob.space/webmention")
+         (method "post"))
+      (label "Have you written a "
+             ,(hyperlink "https://indieweb.org/responses" "response")
+             " to this? Let me know the URL:")
+      (input (@ (name "source") (type "url")))
+      (input (@ (value "Send Webmention") (type "submit"))))
+     ,(script "webmention.js"))))
 
 (define (render-preview post)
   "Return the SHTML for a preview of POST."
@@ -77,22 +92,9 @@
       (p ,(first-paragraph post))
       ,(hyperlink (or crosspost-uri local-uri) "read more 🢩"))))
 
-(define (render-listing posts title previous-page next-page)
-  "Return SHTML presenting previews for POSTS, with the header TITLE and links
-to PREVIOUS-PAGE and NEXT-PAGE."
-  `((h1 ,title)
-    ,@(map render-preview posts)
-    (nav
-     (@ (id "pagination"))
-     ,@(maybe-list
-        (when previous-page
-          (hyperlink previous-page "🢨 Previous Page"))
-        (when next-page
-          (hyperlink next-page "Next Page 🢩"))))))
-
 
 ;;;
-;;; Creation of permalink pages for individual posts.
+;;; Creation of permalink pages for individual lposts.
 ;;;
 
 ;; Subdirectory for permalink pages.
@@ -117,54 +119,6 @@ to PREVIOUS-PAGE and NEXT-PAGE."
 
 
 ;;;
-;;; Implementation of pagination.
-;;;
-
-(define %posts-per-page 10)
-
-(define* (paginate posts #:optional (posts-per-page %posts-per-page))
-  "Partition POSTS into list of no more than POSTS-PER-PAGE posts, of the
-form (index, posts)."
-  (let loop ((index 1)
-             (lst posts)
-             (result '()))
-    (if (null? lst)
-        result
-        (let ((how-many (min %posts-per-page (length lst))))
-          (loop (1+ index)
-                (drop lst how-many)
-                (cons (list index (take lst how-many))
-                      result))))))
-
-(define (post-list->pages base-title base-file-name posts)
-  "Return a list of Haunt pages for POSTS, with headers containing BASE-TITLE
-and output file names beginning with BASE-FILE-NAME."
-  (define (index->file-name index)
-    (if (= index 1)
-        (format #f "~a.html" base-file-name)
-        (format #f "~a-~a.html" base-file-name index)))
-  (map (match-lambda
-         ((index subset)
-          (let ((title (if (= index 1)
-                           base-title
-                           (format #f "~a — Page ~a" base-title index)))
-                (previous-page (if (>= (1- index) 1)
-                                   (index->file-name (1- index))
-                                   #f))
-                (next-page (if (<= (1+ index) (ceiling/ (length posts)
-                                                        %posts-per-page))
-                               (index->file-name (1+ index))
-                               #f)))
-            (make-page (index->file-name index)
-                       (theme #:title title
-                              #:content
-                              (render-listing subset title
-                                              previous-page next-page))
-                       sxml->html))))
-       (paginate posts)))
-
-
-;;;
 ;;; Navigation based on post tags.
 ;;;
 
@@ -176,9 +130,9 @@ and output file names beginning with BASE-FILE-NAME."
 only the posts tagged with that tag."
   (flat-map (match-lambda
               ((tag . posts)
-               (post-list->pages (format #f "Posts tagged as \"~a\"" tag)
-                                 (tag-uri %tag-prefix tag "")
-                                 posts)))
+               (items->pages render-preview posts
+                             (format #f "Posts tagged as \"~a\"" tag)
+                             (tag-uri %tag-prefix tag ""))))
             (group-by-tag posts (cut post-ref <> 'tags))))
 
 (define (all-tags posts)
@@ -210,9 +164,8 @@ of the 'post' objects associated with the site."
      (map post->page posts)
 
      ;; Main post navigation.
-     (post-list->pages
-      "Recent Posts" "index"
-      (posts/reverse-chronological posts))
+     (items->pages render-preview (posts/reverse-chronological posts)
+                   "Recent Posts" "index")
 
      ;; Tag-based navigation.
      (list (all-tags posts))