summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-15 22:08:15 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-15 22:08:15 +0100
commit746469e5e4be20dada50fccfdf7ca7d707cd6f66 (patch)
tree2bbc548a4554c551c54347e089ea97bd80dbb74e
parentf9522a230784fbea7d9e9daaa835dfd81e145c60 (diff)
Use PURI for calculation of absolute URIs from relative ones.
-rw-r--r--mulkcms.asd2
-rw-r--r--mulkcms.lisp59
2 files changed, 33 insertions, 28 deletions
diff --git a/mulkcms.asd b/mulkcms.asd
index 7668a81..4bd0f05 100644
--- a/mulkcms.asd
+++ b/mulkcms.asd
@@ -10,7 +10,7 @@
:version "0.0.1"
:depends-on (:cl-who :cl-json :alexandria :postmodern :split-sequence
:cl-ppcre :cl-fad :cxml :closure-html :json-template :cxml-stp
- :ironclad :flexi-streams :drakma)
+ :ironclad :flexi-streams :drakma :puri)
:components ((:file "package")
(:file "site")
(:file "mulkcms")
diff --git a/mulkcms.lisp b/mulkcms.lisp
index 9662b06..0e2c4ae 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -124,33 +124,38 @@
(defun link-to (action &key comment-id article-id revision-id (absolute nil))
;; Taken from Mulkblog.
- (with-output-to-string (out)
- (format out "~A" (if absolute *base-uri* ""))
- (symbol-macrolet ((article-base (find-canonical-article-alias article-id)))
- (multiple-value-call
- #'(lambda (&rest args) (apply #'format out args))
- (ecase action
- (:index "")
- (:full-index "/?full")
- (:view-atom-feed (values "/feed"))
- (:view-comment-feed (cond (article-id (values "/~A?comment-feed" article-base))
- (t "/comment-feed")))
- (:view (cond (comment-id (values "/~A#comment-~D" article-base comment-id))
- (article-id (values "/~A" article-base))
- (t "/")))
- (:view-comments (values "/~A#comments" article-base))
- ((:edit :preview) (cond (revision-id (values "/~A?edit&revision=~D" article-base revision-id))
- (t (values "/~A?edit" article-base))))
- (:post-comment (values "/~A" article-base))
- (:trackback (values "/~A?trackback" article-base))
- (:view-atom-entry (values "/~A?atom" article-base))
- (:save (values "/~A?save" article-base))
- (:moderation-page "/moderate")
- (:css "/journal.css")
- (:prettify.css "/prettify/prettify.css")
- (:prettify.js "/prettify/prettify.js")
- (:prettify-lisp.js "/prettify/lang-lisp.js")
- (:pingback "/rpc"))))))
+ (symbol-macrolet ((article-base (find-canonical-article-alias article-id)))
+ (multiple-value-call
+ #'(lambda (&rest args)
+ (print args)
+ (let ((path (apply #'format nil args)))
+ (if absolute
+ (with-output-to-string (strout)
+ (puri:render-uri (puri:merge-uris path *base-uri*)
+ strout))
+ path)))
+ (ecase action
+ (:index "")
+ (:full-index "/?full")
+ (:view-atom-feed (values "/feed"))
+ (:view-comment-feed (cond (article-id (values "/~A?comment-feed" article-base))
+ (t "/comment-feed")))
+ (:view (cond (comment-id (values "/~A#comment-~D" article-base comment-id))
+ (article-id (values "/~A" article-base))
+ (t "/")))
+ (:view-comments (values "/~A#comments" article-base))
+ ((:edit :preview) (cond (revision-id (values "/~A?edit&revision=~D" article-base revision-id))
+ (t (values "/~A?edit" article-base))))
+ (:post-comment (values "/~A" article-base))
+ (:trackback (values "/~A?trackback" article-base))
+ (:view-atom-entry (values "/~A?atom" article-base))
+ (:save (values "/~A?save" article-base))
+ (:moderation-page "/moderate")
+ (:css "/journal.css")
+ (:prettify.css "/prettify/prettify.css")
+ (:prettify.js "/prettify/prettify.js")
+ (:prettify-lisp.js "/prettify/lang-lisp.js")
+ (:pingback "/rpc")))))
(defun call-with-db (thunk)
(call-with-connection *database-connection-spec* thunk))