summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-19 21:26:13 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-19 21:26:13 +0100
commitffa16d2022a4ff058dace836f5e0a4fc94f64db7 (patch)
tree71d530a389702e6a86a532c5b58ac534e7c3a45d
parent2d692a12cb44cf09bb3be324661c79f104366ba3 (diff)
Propagate the “lang” variable to generated links.
-rw-r--r--mulkcms.lisp53
1 files changed, 44 insertions, 9 deletions
diff --git a/mulkcms.lisp b/mulkcms.lisp
index ee236fb..802fbba 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -5,6 +5,7 @@
:pooled-p t :use-ssl :try))
(defvar *requested-characteristics*)
+(defvar *propagated-params*)
(unless (member "html-human-date" *template-formatters* :key #'car :test #'equal)
(setq *template-formatters*
@@ -31,6 +32,14 @@
(random #x1000000000000)))
+(defmacro dynamic-lambda ((&rest dynvars) lambda-list &body body)
+ (let ((lexvars (mapcar (lambda (x) (declare (ignore x)) (gensym)) dynvars)))
+ `(let ,(mapcar #'list lexvars dynvars)
+ (lambda ,lambda-list
+ (let ,(mapcar #'list dynvars lexvars)
+ ,@body)))))
+
+
(defun hashcash-hash-validp (text)
(let* ((stripped-text (ppcre:regex-replace-all "\\s+" text ""))
(digest (ironclad:digest-sequence 'ironclad:sha256 (flexi-streams:string-to-octets stripped-text :external-format :utf8))))
@@ -131,6 +140,27 @@
:single))
+(defun queryize-alist (alist)
+ (format nil "~{~A~^&~}"
+ (mapcar (lambda (x)
+ (destructuring-bind (name . value)
+ x
+ (format nil
+ "~A=~A"
+ (json-template::escape-for-uri name)
+ (json-template::escape-for-uri value))))
+ alist)))
+
+(defun uri-with-query (string alist)
+ (if alist
+ (format nil "~A~A~A"
+ string
+ (if (position #\? string)
+ #\&
+ #\?)
+ (queryize-alist alist))
+ string))
+
(defun link-to (action &key comment-id article-id revision-id (absolute nil))
;; Taken from Mulkblog.
(symbol-macrolet ((article-base (find-canonical-article-alias article-id)))
@@ -138,9 +168,11 @@
#'(lambda (&rest args)
(let ((path (apply #'format nil args)))
(if absolute
- (with-output-to-string (strout)
- (puri:render-uri (puri:merge-uris path *base-uri*)
- strout))
+ (uri-with-query
+ (with-output-to-string (strout)
+ (puri:render-uri (puri:merge-uris path *base-uri*)
+ strout))
+ *propagated-params*)
path)))
(ecase action
(:index "")
@@ -454,7 +486,7 @@
"feed" "feed/"
"journal/feed" "journal/feed")
:test #'string=)
- (lambda ()
+ (dynamic-lambda (*propagated-params*) ()
(with-db
(with-cache (path
(query "SELECT max(date) FROM article_revisions" :single)
@@ -673,7 +705,7 @@
*requested-characteristics*))
(declare (ignore characteristics action))
(when (string= path "admin/articles")
- (lambda ()
+ (dynamic-lambda (*propagated-params*) ()
(with-authorization (user-id :require :admin)
(with-db
(labels ((paramify-revision-row (row article-id)
@@ -778,7 +810,7 @@
:single)))
(ecase action
(:edit
- (lambda ()
+ (dynamic-lambda (*propagated-params*) ()
(with-authorization (user-id :require :admin)
(with-db
(with-transaction ()
@@ -877,7 +909,7 @@
:content-label "Content"
:characteristics-label "Characteristics"))))))))
(:view
- (lambda ()
+ (dynamic-lambda (*propagated-params*) ()
(with-db
(with-cache (path
(query "SELECT max(date)
@@ -989,7 +1021,7 @@
(defun find-transaction-key-handler (path)
(when (string= path "RPC/generate-transaction-key")
- (lambda ()
+ (dynamic-lambda (*propagated-params*) ()
(with-db
(setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(format nil "~D" (query "SELECT nextval('transaction_key_seq')" :single!))))))
@@ -1006,7 +1038,10 @@
(let ((langs (split-sequence #\| langstr)))
(mapcar (lambda (x) (list (cons "language" x)))
langs)))
- *default-characteristics-precedence-list*)))
+ *default-characteristics-precedence-list*))
+ (*propagated-params* (remove-if-not (lambda (x)
+ (equal (car x) "lang"))
+ params)))
(or (find-article-summary-handler
path
params)