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.
This commit is contained in:
Willem Rein Oudshoorn 2013-04-19 12:53:25 +02:00
parent 3a5d2d1c68
commit dbdb7e29af
7 changed files with 34 additions and 11 deletions

View file

@ -19,6 +19,7 @@
(:file "util") (:file "util")
(:file "config") (:file "config")
(:file "themes") (:file "themes")
(:file "tags")
(:file "content") (:file "content")
(:file "posts") (:file "posts")
(:file "indices") (:file "indices")

View file

@ -30,9 +30,11 @@
(nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str))) (nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
(field-name (line) (field-name (line)
(make-keyword (string-upcase (subseq line 0 (position #\: line))))) (make-keyword (string-upcase (subseq line 0 (position #\: line)))))
(read-delimited (str &optional (delimiter ", ")) (read-tags (str)
(mapcar (compose #'slugify #'string-downcase) (mapcar (lambda (name)
(cl-ppcre:split delimiter str)))) (let ((name (string-trim " " name)))
(make-instance 'tag :name name :slug (slugify name))))
(cl-ppcre:split "," str))))
(with-open-file (in file) (with-open-file (in file)
(unless (string= (read-line in) ";;;;;") (unless (string= (read-line in) ";;;;;")
(error "The provided file lacks the expected header.")) (error "The provided file lacks the expected header."))
@ -41,7 +43,7 @@
appending (list (field-name line) appending (list (field-name line)
(aref (parse-field line) 0)))) (aref (parse-field line) 0))))
(content (slurp-remainder in))) (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)))))) (append meta (list :text content))))))
(defun find-all (content-type) (defun find-all (content-type)

View file

@ -17,7 +17,7 @@
(write-page (page-path rss) (render-page rss rss-template)) (write-page (page-path rss) (render-page rss rss-template))
(write-page (page-path atom) (render-page atom atom-template)) (write-page (page-path atom) (render-page atom atom-template))
(dolist (feed feeds) (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) (setf (index-id index) (format nil "~a-rss.xml" feed)
(index-posts index) (first-10 (index-posts index))) (index-posts index) (first-10 (index-posts index)))
(write-page (page-path index) (render-page index rss-template))))))) (write-page (page-path index) (render-page index rss-template)))))))

View file

@ -35,7 +35,7 @@
(defun all-tags () (defun all-tags ()
"Retrieve a list of all tags used in content." "Retrieve a list of all tags used in content."
(let ((tags (mappend #'content-tags (hash-table-values *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) (defun get-month (timestamp)
"Extract the YYYY-MM portion of TIMESTAMP." "Extract the YYYY-MM portion of TIMESTAMP."
@ -43,10 +43,18 @@
(defun index-by-tag (tag content) (defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG." "Return an index of all CONTENT matching the given TAG."
(flet ((valid-p (obj) (member tag (content-tags obj) :test #'string=))) (flet ((valid-p (obj) (member tag (content-tags obj) :test #'tag-slug=)))
(make-instance 'tag-index :id tag (make-instance 'tag-index :id (tag-slug tag)
:posts (remove-if-not #'valid-p content) :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) (defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH." "Return an index of all CONTENT matching the given MONTH."

12
src/tags.lisp Normal file
View file

@ -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)))

View file

@ -17,7 +17,7 @@
<div id="tagsoup"> <div id="tagsoup">
<p>This blog covers <p>This blog covers
{foreach $tag in $tags} {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} {if not isLast($tag)},{sp}{/if}
{/foreach} {/foreach}
</div> </div>

View file

@ -5,7 +5,7 @@
<h1 class="title">{$post.title}</h1>{\n} <h1 class="title">{$post.title}</h1>{\n}
<div class="tags">{\n} <div class="tags">{\n}
Tagged as {foreach $tag in $post.tags} 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} {if not isLast($tag)},{sp}{/if}
{/foreach} {/foreach}
</div>{\n} </div>{\n}