From dbdb7e29afc9ea8235ceefc5be08b0363233632d Mon Sep 17 00:00:00 2001
From: Willem Rein Oudshoorn <woudshoo+github@xs4all.nl>
Date: Fri, 19 Apr 2013 12:53:25 +0200
Subject: [PATCH] Allow arbitrary tag names.  However if two tags have the same
 slug they will be merged. The name of the merged tag will be one of the
 original names. However this should not happen in practice.

---
 coleslaw.asd           |  1 +
 src/content.lisp       | 10 ++++++----
 src/feeds.lisp         |  2 +-
 src/indices.lisp       | 16 ++++++++++++----
 src/tags.lisp          | 12 ++++++++++++
 themes/hyde/index.tmpl |  2 +-
 themes/hyde/post.tmpl  |  2 +-
 7 files changed, 34 insertions(+), 11 deletions(-)
 create mode 100644 src/tags.lisp

diff --git a/coleslaw.asd b/coleslaw.asd
index a25f13f..6e2a524 100644
--- a/coleslaw.asd
+++ b/coleslaw.asd
@@ -19,6 +19,7 @@
                (:file "util")
                (:file "config")
                (:file "themes")
+               (:file "tags")
                (:file "content")
                (:file "posts")
                (:file "indices")
diff --git a/src/content.lisp b/src/content.lisp
index 8250f0b..0c886f3 100644
--- a/src/content.lisp
+++ b/src/content.lisp
@@ -30,9 +30,11 @@
            (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
          (field-name (line)
            (make-keyword (string-upcase (subseq line 0 (position #\: line)))))
-         (read-delimited (str &optional (delimiter ", "))
-           (mapcar (compose #'slugify #'string-downcase)
-                   (cl-ppcre:split delimiter str))))
+         (read-tags (str)
+           (mapcar (lambda (name) 
+		     (let ((name (string-trim " " name)))
+		       (make-instance 'tag :name name :slug (slugify name))))
+                   (cl-ppcre:split "," str))))
     (with-open-file (in file)
       (unless (string= (read-line in) ";;;;;")
         (error "The provided file lacks the expected header."))
@@ -41,7 +43,7 @@
                      appending (list (field-name line)
                                      (aref (parse-field line) 0))))
             (content (slurp-remainder in)))
-        (setf (getf meta :tags) (read-delimited (getf meta :tags)))
+        (setf (getf meta :tags) (read-tags (getf meta :tags)))
         (append meta (list :text content))))))
 
 (defun find-all (content-type)
diff --git a/src/feeds.lisp b/src/feeds.lisp
index 768d243..01ff301 100644
--- a/src/feeds.lisp
+++ b/src/feeds.lisp
@@ -17,7 +17,7 @@
       (write-page (page-path rss) (render-page rss rss-template))
       (write-page (page-path atom) (render-page atom atom-template))
       (dolist (feed feeds)
-        (let ((index (index-by-tag feed by-date)))
+        (let ((index (index-by-tag-name feed by-date)))
           (setf (index-id index) (format nil "~a-rss.xml" feed)
                 (index-posts index) (first-10 (index-posts index)))
           (write-page (page-path index) (render-page index rss-template)))))))
diff --git a/src/indices.lisp b/src/indices.lisp
index f03e690..836244b 100644
--- a/src/indices.lisp
+++ b/src/indices.lisp
@@ -35,7 +35,7 @@
 (defun all-tags ()
   "Retrieve a list of all tags used in content."
   (let ((tags (mappend #'content-tags (hash-table-values *content*))))
-    (sort (remove-duplicates tags :test #'string=) #'string<)))
+    (sort (remove-duplicates tags :test #'tag-slug=) #'string< :key #'tag-name)))
 
 (defun get-month (timestamp)
   "Extract the YYYY-MM portion of TIMESTAMP."
@@ -43,10 +43,18 @@
 
 (defun index-by-tag (tag content)
   "Return an index of all CONTENT matching the given TAG."
-  (flet ((valid-p (obj) (member tag (content-tags obj) :test #'string=)))
-    (make-instance 'tag-index :id tag
+  (flet ((valid-p (obj) (member tag (content-tags obj) :test #'tag-slug=)))
+    (make-instance 'tag-index :id (tag-slug tag)
                               :posts (remove-if-not #'valid-p content)
-                              :title (format nil "Posts tagged ~a" tag))))
+                              :title (format nil "Posts tagged ~a" (tag-name tag)))))
+
+(defun index-by-tag-name (name content)
+  "Return an index of all CONTENT matching the given tag with tag NAME.
+The comparison is done by comparing the slugs because that is what 
+uniquely identifes a tag."
+  (index-by-tag 
+   (find (slugify name) (all-tags) :test #'string= :key #'tag-slug)
+   content))
 
 (defun index-by-month (month content)
   "Return an index of all CONTENT matching the given MONTH."
diff --git a/src/tags.lisp b/src/tags.lisp
new file mode 100644
index 0000000..bf1bcee
--- /dev/null
+++ b/src/tags.lisp
@@ -0,0 +1,12 @@
+(in-package :coleslaw)
+
+(defclass tag ()
+  ((name :initform nil :initarg :name :accessor tag-name)
+   (slug :initform nil :Initarg :slug :accessor tag-slug)))
+
+(defun tag-name= (tag-1 tag-2)
+  (string= (tag-name tag-1) (tag-name tag-2)))
+
+(defun tag-slug= (tag-1 tag-2)
+  (string= (tag-slug tag-1) (tag-slug tag-2)))
+
diff --git a/themes/hyde/index.tmpl b/themes/hyde/index.tmpl
index dd9681b..7e5f1a0 100644
--- a/themes/hyde/index.tmpl
+++ b/themes/hyde/index.tmpl
@@ -17,7 +17,7 @@
 <div id="tagsoup">
   <p>This blog covers
     {foreach $tag in $tags}
-      <a href="{$config.domain}/tag/{$tag}.html">{$tag}</a>{nil}
+      <a href="{$config.domain}/tag/{$tag.slug}.html">{$tag.name}</a>{nil}
       {if not isLast($tag)},{sp}{/if}
     {/foreach}
 </div>
diff --git a/themes/hyde/post.tmpl b/themes/hyde/post.tmpl
index 9d4648c..67eeaf2 100644
--- a/themes/hyde/post.tmpl
+++ b/themes/hyde/post.tmpl
@@ -5,7 +5,7 @@
   <h1 class="title">{$post.title}</h1>{\n}
   <div class="tags">{\n}
     Tagged as {foreach $tag in $post.tags}
-                <a href="../tag/{$tag}.html">{$tag}</a>{nil}
+                <a href="../tag/{$tag.slug}.html">{$tag.name}</a>{nil}
                     {if not isLast($tag)},{sp}{/if}
               {/foreach}
   </div>{\n}