Cleanups to new-tags. Fixes Issue #27.
This commit is contained in:
parent
dbdb7e29af
commit
08ac715884
5 changed files with 19 additions and 31 deletions
|
@ -19,7 +19,6 @@
|
|||
(:file "util")
|
||||
(:file "config")
|
||||
(:file "themes")
|
||||
(:file "tags")
|
||||
(:file "content")
|
||||
(:file "posts")
|
||||
(:file "indices")
|
||||
|
|
|
@ -3,6 +3,14 @@
|
|||
(defparameter *content* (make-hash-table :test #'equal)
|
||||
"A hash table to store all the site content and metadata.")
|
||||
|
||||
(defclass tag ()
|
||||
((name :initform nil :initarg :name :accessor tag-name)
|
||||
(slug :initform nil :Initarg :slug :accessor tag-slug)))
|
||||
|
||||
(defun make-tag (str)
|
||||
"Takes a string and returns a TAG instance with a name and slug."
|
||||
(make-instance 'tag :name (string-trim " " str) :slug (slugify str)))
|
||||
|
||||
(defclass content ()
|
||||
((tags :initform nil :initarg :tags :accessor content-tags)
|
||||
(slug :initform nil :initarg :slug :accessor content-slug)
|
||||
|
@ -31,10 +39,7 @@
|
|||
(field-name (line)
|
||||
(make-keyword (string-upcase (subseq line 0 (position #\: line)))))
|
||||
(read-tags (str)
|
||||
(mapcar (lambda (name)
|
||||
(let ((name (string-trim " " name)))
|
||||
(make-instance 'tag :name name :slug (slugify name))))
|
||||
(cl-ppcre:split "," str))))
|
||||
(mapcar #'make-tag (cl-ppcre:split "," str))))
|
||||
(with-open-file (in file)
|
||||
(unless (string= (read-line in) ";;;;;")
|
||||
(error "The provided file lacks the expected header."))
|
||||
|
|
|
@ -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-name feed by-date)))
|
||||
(let ((index (index-by-tag (make-tag 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)))))))
|
||||
|
|
|
@ -34,8 +34,9 @@
|
|||
|
||||
(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 #'tag-slug=) #'string< :key #'tag-name)))
|
||||
(let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
|
||||
(tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
|
||||
(sort tags #'string< :key #'tag-name)))
|
||||
|
||||
(defun get-month (timestamp)
|
||||
"Extract the YYYY-MM portion of TIMESTAMP."
|
||||
|
@ -43,18 +44,13 @@
|
|||
|
||||
(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 #'tag-slug=)))
|
||||
(labels ((tag-slug= (a b)
|
||||
(string= (tag-slug a) (tag-slug b)))
|
||||
(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-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))
|
||||
:posts (remove-if-not #'valid-p content)
|
||||
:title (format nil "Posts tagged ~a" (tag-name tag)))))
|
||||
|
||||
(defun index-by-month (month content)
|
||||
"Return an index of all CONTENT matching the given MONTH."
|
||||
|
|
|
@ -1,12 +0,0 @@
|
|||
(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)))
|
||||
|
Loading…
Add table
Reference in a new issue