Merge pull request #47 from redline6561/user-defined-routing

User defined routing

NEWS.md

 ## Changes for 0.9.4 (2013-05-05):
 
+* **SITE-BREAKING CHANGE**: Coleslaw now supports user-defined routing.
+  Instead of hard-coding the paths various content types are stored at,
+  they must be specified in the configuration file (.coleslawrc). Just
+  copy the `:routing` key from the [example][single_site.rc] to get
+  the old behavior.
 * Coleslaw no longer expects a particular repo layout. Use whatever
   directory hierarchy you like.
 
 
 * Initial release.
 
-[hacking_guide]: https://github.com/redline6561/coleslaw/blob/master/docs/hacking.md
-[theming_guide]: https://github.com/redline6561/coleslaw/blob/master/docs/themes.md
+[hacking_guide]:  https://github.com/redline6561/coleslaw/blob/master/docs/hacking.md
+[theming_guide]:  https://github.com/redline6561/coleslaw/blob/master/docs/themes.md
+[single_site.rc]: https://github.com/redline6561/coleslaw/blob/master/examples/single-site.coleslawrc

coleslaw.asd

 (defsystem #:coleslaw
   :name "coleslaw"
   :description "Flexible Lisp Blogware"
-  :version "0.9.3"
+  :version "0.9.4-dev"
   :license "BSD"
   :author "Brit Butler <redline6561@gmail.com>"
   :pathname "src/"

docs/hacking.md

 
 - `page-url`: Generate a unique, relative path for the object on the site
   sans file extension. An :around method adds that later. The `slug` slot
-  on the object is generally used to hold a portion of the unique
+  on the object is conventionally used to hold a portion of the unique
   identifier. i.e. `(format nil "posts/~a" (content-slug object))`.
 - `render`: A method that calls the appropriate template with `theme-fn`,
   passing it any needed arguments and returning rendered HTML.
 function. There may be other areas where it was assumed tags/dates
 will always be present.
 
-### User-Defined Routing
-
-There is no reason *coleslaw* should be in charge of the site layout or
-should care. If all objects only used the *slug* slot in their `page-url`
-methods, there could be a :routing argument in the config containing
-a plist of `(:class "~{format string~}")` pairs. A default method could
-check the :class key under `(routing *config*)` if no specialized
-`page-url` was defined. This would have the additional benefit of
-localizing all the site routing in one place. New Content Types would
-probably `pushnew` a plist onto the config key in their `enable` function.
-This has been implemented on the branch `user-defined-routing`.
-
 ### New Content Type: Pages!
 
 Many users have requested a content type PAGE, for static pages. It

examples/multi-site.coleslawrc

                                       :domain "http://blub.co.za"
                                       :feeds ("lisp")
                                       :plugins ((mathjax))
+                                      :routing ((:post           "posts/~a")
+                                                (:tag-index      "tag/~a")
+                                                (:month-index    "date/~a")
+                                                (:numeric-index  "~d")
+                                                (:feed           "~a.xml")
+                                                (:tag-feed       "tag/~a.xml"))
                                       :sitenav ((:url "http://twitter.com/ralph_moeritz" :name "Twitter")
                                                 (:url "http://github.com/ralph-moeritz" :name "Code"))
                                       :staging-dir "/tmp/coleslaw"
                                   :domain "http://musings.co.za"
                                   :feeds ("opinion")
                                   :plugins ((mathjax))
+                                  :routing ((:post           "posts/~a")
+                                            (:tag-index      "tag/~a")
+                                            (:month-index    "date/~a")
+                                            (:numeric-index  "~d")
+                                            (:feed           "~a.xml")
+                                            (:tag-feed       "tag/~a.xml"))
                                   :sitenav ((:url "http://twitter.com/ralph_moeritz" :name "Twitter")
                                             (:url "http://github.com/ralph-moeritz" :name "Code"))
                                   :staging-dir "/tmp/coleslaw"

examples/single-site.coleslawrc

            (disqus :shortname "my-site-name")
            (analytics :tracking-code "foo"))
  :repo "/home/git/tmp/improvedmeans/"
+ :routing ((:post           "posts/~a")
+           (:tag-index      "tag/~a")
+           (:month-index    "date/~a")
+           (:numeric-index  "~d")
+           (:feed           "~a.xml")
+           (:tag-feed       "tag/~a.xml"))
  :sitenav ((:url "http://redlinernotes.com/" :name "Home")
            (:url "http://twitter.com/redline6561" :name "Twitter")
            (:url "http://github.com/redline6561" :name "Code")

src/documents.lisp

 ;; Instance Methods
 
 (defgeneric page-url (document)
-  (:documentation "The url to the DOCUMENT without the domain."))
+  (:documentation "The url to the DOCUMENT without the domain.")
+  (:method (document)
+    (let* ((class-name (class-name (class-of document)))
+           (route (assoc class-name (routing *config*))))
+      (if route
+          (format nil (second route) (slot-value document 'slug))
+          (error "No routing method found for: ~A" class-name)))))
 
 (defmethod page-url :around ((document t))
   (let ((result (call-next-method)))

src/indexes.lisp

 
 (defclass tag-index (index) ())
 
-(defmethod page-url ((object tag-index))
-  (format nil "tag/~a" (index-slug object)))
-
 (defmethod discover ((doc-type (eql (find-class 'tag-index))))
   (let ((content (by-date (find-all 'post))))
     (dolist (tag (all-tags))
 
 (defclass month-index (index) ())
 
-(defmethod page-url ((object month-index))
-  (format nil "date/~a" (index-slug object)))
-
 (defmethod discover ((doc-type (eql (find-class 'month-index))))
   (let ((content (by-date (find-all 'post))))
     (dolist (month (all-months))
 
 (defclass numeric-index (index) ())
 
-(defmethod page-url ((object numeric-index))
-  (format nil "~d" (index-slug object)))
-
 (defmethod discover ((doc-type (eql (find-class 'numeric-index))))
   (let ((content (by-date (find-all 'post))))
     (dotimes (i (ceiling (length content) 10))
 (defclass feed (index)
   ((format :initform nil :initarg :format :accessor feed-format)))
 
-(defmethod page-url ((object feed))
-  (format nil "~(~a~).xml" (feed-format object)))
-
 (defmethod discover ((doc-type (eql (find-class 'feed))))
-  (let ((content (take-up-to 10 (by-date (find-all 'post)))))
+  (let ((content (by-date (find-all 'post))))
     (dolist (format '(rss atom))
-      (let ((feed (make-instance 'feed :content content :format format)))
+      (let ((feed (make-instance 'feed :format format
+                                 :content (take-up-to 10 content)
+                                 :slug (format nil "~(~a~)" format))))
         (add-document feed)))))
 
 (defmethod publish ((doc-type (eql (find-class 'feed))))
 
 (defclass tag-feed (feed) ())
 
-(defmethod page-url ((object tag-feed))
-  (format nil "tag/~a~(~a~).xml" (index-slug object) (feed-format object)))
-
 (defmethod discover ((doc-type (eql (find-class 'tag-feed))))
   (let ((content (by-date (find-all 'post))))
     (dolist (tag (feeds *config*))
       (let ((tagged (remove-if-not (lambda (x) (tag-p tag x)) content)))
         (dolist (format '(rss atom))
-          (let ((feed (make-instance 'tag-feed :content (take-up-to 10 tagged)
-                                     :format format
-                                     :slug tag)))
+          (let ((feed (make-instance 'tag-feed :format format
+                                     :content (take-up-to 10 tagged)
+                                     :slug (format nil "~a-~(~a~)" tag format))))
             (add-document feed)))))))
 
 (defmethod publish ((doc-type (eql (find-class 'tag-feed))))

src/posts.lisp

                                   :prev prev
                                   :next next)))
 
-(defmethod page-url ((object post))
-  (format nil "posts/~a" (content-slug object)))
-
 (defmethod publish ((doc-type (eql (find-class 'post))))
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
      while post do (write-document post nil :prev prev :next next)))