Revision: 3705 Author: ksprotte URL: http://bknr.net/trac/changeset/3705

fixed content-language-chooser to keep other GET parameters U trunk/projects/bos/web/web-utils.lisp

Modified: trunk/projects/bos/web/web-utils.lisp =================================================================== --- trunk/projects/bos/web/web-utils.lisp 2008-07-31 08:02:37 UTC (rev 3704) +++ trunk/projects/bos/web/web-utils.lisp 2008-07-31 08:21:43 UTC (rev 3705) @@ -37,15 +37,23 @@ (defun language-name (language-short-name) (cadr (assoc language-short-name (website-languages) :test #'equal)))

-(defun content-language-chooser () - "Note that in the current implementation other GET parameters than - language will be lost (not appended to script-name)." +(defun content-language-chooser () (html ((:p :class "languages") "Content languages: " (loop for (language-symbol language-name) in (website-languages) - do (labels ((show-language-link () - (html (cmslink (format nil "~A?language=~A" (hunchentoot:script-name*) language-symbol) + do (labels ((show-language-link () + (html (cmslink (with-output-to-string (out) + (write-string (hunchentoot:script-name*) out) + ;; write language param and remaining get params + (write-string "?language=" out) + (write-string language-symbol out) + (dolist (get-param (remove "language" (hunchentoot:get-parameters*) :key #'first :test #'equal)) + (destructuring-bind (key . value) get-param + (write-string "&" out) + (write-string key out) + (write-string "=" out) + (write-string value out)))) (:princ-safe language-name))))) (if (equal (request-language) language-symbol) (html "[" (show-language-link) "]")