Changeset 3557
- Timestamp:
- 07/22/08 16:08:27 (4 months ago)
- Files:
-
- trunk/projects/bos/web/contract-rss.lisp (modified) (2 diffs)
- trunk/projects/bos/web/news-handlers.lisp (modified) (3 diffs)
- trunk/projects/bos/web/news-rss.lisp (modified) (1 diff)
- trunk/projects/bos/web/news-tags.lisp (modified) (2 diffs)
- trunk/projects/bos/web/poi-handlers.lisp (modified) (8 diffs)
- trunk/projects/bos/web/rss.lisp (modified) (1 diff)
- trunk/projects/bos/web/startup.lisp (modified) (1 diff)
- trunk/projects/bos/web/tags.lisp (modified) (4 diffs)
- trunk/projects/bos/web/web-utils.lisp (modified) (2 diffs)
- trunk/projects/bos/web/webserver.lisp (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/projects/bos/web/contract-rss.lisp
r2343 r3557 8 8 9 9 (defmethod rss-item-title ((contract contract)) 10 (format nil (case (intern (bos.web:: current-website-language))10 (format nil (case (intern (bos.web::request-language)) 11 11 (de "~A Quadratmeter wurden ~@[von ~A ~]gekauft") 12 12 (t "~A square meters bought~@[ by ~A~]")) … … 19 19 (defmethod rss-item-link ((contract contract)) 20 20 #+(or) 21 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web:: current-website-language) (store-object-id item)))21 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item))) 22 22 23 23 (defmethod rss-item-guid ((item contract)) 24 24 #+(or) 25 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web:: current-website-language) (store-object-id item)))25 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item))) 26 26 27 27 (defmethod rss-item-pub-date ((contract contract)) trunk/projects/bos/web/news-handlers.lisp
r2484 r3557 11 11 12 12 (defmethod handle-object-form ((handler edit-news-handler) action (news-item (eql nil))) 13 (let ((language ( hunchentoot:session-value :language)))13 (let ((language (request-language))) 14 14 (with-bos-cms-page (:title "Edit news items") 15 15 (content-language-chooser) … … 34 34 35 35 (defmethod handle-object-form ((handler edit-news-handler) action news-item) 36 (let ((language ( hunchentoot:session-value :language)))36 (let ((language (request-language))) 37 37 (with-bos-cms-page (:title "Edit news item") 38 38 (content-language-chooser) … … 50 50 51 51 (defmethod handle-object-form ((handler edit-news-handler) (action (eql :save)) news-item) 52 (let ((language ( hunchentoot:session-value :language)))52 (let ((language (request-language))) 53 53 (with-query-params (title text) 54 54 (update-news-item news-item language :title title :text text) trunk/projects/bos/web/news-rss.lisp
r2343 r3557 5 5 6 6 (defmethod rss-item-published ((item news-item)) 7 (news-item-published item (bos.web:: current-website-language)))7 (news-item-published item (bos.web::request-language))) 8 8 9 9 (defmethod rss-item-title ((item news-item)) 10 (news-item-title item (bos.web:: current-website-language)))10 (news-item-title item (bos.web::request-language))) 11 11 12 12 (defmethod rss-item-description ((item news-item)) 13 (news-item-text item (bos.web:: current-website-language)))13 (news-item-text item (bos.web::request-language))) 14 14 15 15 (defmethod rss-item-link ((item news-item)) 16 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web:: current-website-language) (store-object-id item)))16 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item))) 17 17 18 18 (defmethod rss-item-guid ((item news-item)) 19 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web:: current-website-language) (store-object-id item)))19 (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item))) 20 20 21 21 (defmethod rss-item-pub-date ((item news-item)) trunk/projects/bos/web/news-tags.lisp
r2812 r3557 8 8 9 9 (define-bknr-tag news-headlines (&key archive) 10 (let ((language ( hunchentoot:session-value :language)))10 (let ((language (request-language))) 11 11 (let* ((now (get-universal-time)) 12 12 (news-items (if archive … … 35 35 (define-bknr-tag news-item () 36 36 (let ((news-item (find-store-object (parse-integer (nth-value 1 (parse-url))))) 37 (language ( hunchentoot:session-value :language)))37 (language (request-language))) 38 38 (html ((:h1 :class "extra") 39 39 (:princ-safe (format-date-time (news-item-time news-item) :show-time nil)) trunk/projects/bos/web/poi-handlers.lisp
r3548 r3557 19 19 "Please use only alphanumerical characters, - and _ for technical POI names"))) 20 20 (t 21 (redirect (edit-object-url (make-poi ( hunchentoot:session-value :language) name)))))))21 (redirect (edit-object-url (make-poi (request-language) name))))))) 22 22 23 23 (defclass edit-poi-handler (editor-only-handler edit-object-handler) … … 35 35 (:princ-safe (poi-name poi)) 36 36 " - " 37 (:princ-safe (slot-string poi 'title ( hunchentoot:session-value :language)))))))))37 (:princ-safe (slot-string poi 'title (request-language))))))))) 38 38 (html (:h2 "No POIs created yet"))) 39 39 ((:form :method "post" :action "/make-poi") … … 53 53 action (poi poi)) 54 54 (with-query-params (language shift shift-by) 55 (unless language (setq language ( hunchentoot:session-value :language)))55 (unless language (setq language (request-language))) 56 56 (when shift 57 57 ;; change image order … … 66 66 (setf (nth (+ shift-by old-position) new-images) tmp) 67 67 (change-slot-values poi 'bos.m2::images new-images))) 68 (setf (hunchentoot:session-value :language) language)69 68 (with-bos-cms-page (:title "Edit POI") 70 69 (content-language-chooser) … … 170 169 (action (eql :save)) (poi poi)) 171 170 (with-query-params (published title subtitle description language x y icon movie) 172 (unless language (setq language ( hunchentoot:session-value :language)))171 (unless language (setq language (request-language))) 173 172 (let ((args (list :title title 174 173 :published published … … 302 301 (defmethod handle-object-form ((handler edit-poi-image-handler) action poi-image) 303 302 (with-query-params (language poi) 304 (unless language (setq language ( hunchentoot:session-value :language)))303 (unless language (setq language (request-language))) 305 304 (with-bos-cms-page (:title "Edit POI Image") 306 305 (html … … 332 331 (defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :save)) poi-image) 333 332 (with-query-params (title subtitle description language) 334 (unless language (setq language ( hunchentoot:session-value :language)))333 (unless language (setq language (request-language))) 335 334 (update-poi-image poi-image language 336 335 :title title … … 372 371 (html 373 372 ((:script :language "JavaScript") 374 (:princ (make-poi-javascript ( or (hunchentoot:session-value :language) *default-language*)))373 (:princ (make-poi-javascript (request-language))) 375 374 (:princ "parent.poi_fertig(pois, anzahlSponsoren, anzahlVerkauft);") 376 375 (:princ (format nil "parent.last_sponsors([~{~A~^,~%~}]);" (mapcar #'contract-js last-paid-contracts))))))))) trunk/projects/bos/web/rss.lisp
r2343 r3557 7 7 8 8 (defmethod rss-item-published ((item news-item)) 9 (format t "Language: ~A~%" ( current-website-language))9 (format t "Language: ~A~%" (request-language)) 10 10 t) 11 11 12 12 (defmethod rss-item-title ((item news-item)) 13 (news-item-title item ( current-website-language)))13 (news-item-title item (request-language))) 14 14 15 15 (defmethod rss-item-description ((item news-item)) 16 (news-item-text item ( current-website-language)))16 (news-item-text item (request-language))) 17 17 18 18 (defmethod rss-item-link ((item news-item)) 19 (format nil "http://createrainforest.org/~A/news-extern/~A" ( current-website-language) (store-object-id item)))19 (format nil "http://createrainforest.org/~A/news-extern/~A" (request-language) (store-object-id item))) 20 20 21 21 (defmethod rss-item-guid ((item news-item)) 22 (format nil "http://createrainforest.org/~A/news-extern/~A" ( current-website-language) (store-object-id item)))22 (format nil "http://createrainforest.org/~A/news-extern/~A" (request-language) (store-object-id item))) 23 23 trunk/projects/bos/web/startup.lisp
r3432 r3557 42 42 (format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug) 43 43 (force-output) 44 (setq hunchentoot:*catch-errors-p* (not debug))45 44 (when *webserver* 46 45 (hunchentoot:stop-server *webserver*)) 47 (setf *hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)46 (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) 48 47 hunchentoot:*rewrite-for-session-urls* nil) 49 (setq *webserver* (hunchentoot:start-server :port *port* #+not-yet :threaded #+not-yet(not debug)48 (setq *webserver* (hunchentoot:start-server :port *port* (not debug) 50 49 :persistent-connections-p nil)) 51 50 (if start-frontend trunk/projects/bos/web/tags.lisp
r3415 r3557 16 16 (define-bknr-tag language-chooser (name) 17 17 (html ((:select :name name) 18 (language-options-1 ( current-website-language)))))18 (language-options-1 (request-language))))) 19 19 20 20 (define-bknr-tag language-options () 21 (language-options-1 ( current-website-language)))21 (language-options-1 (request-language))) 22 22 23 23 (define-bknr-tag worldpay-receipt () … … 42 42 (when (equal want-print "no") 43 43 (contract-set-download-only-p contract t)) 44 (contract-issue-cert contract name :address address :language ( hunchentoot:session-value :language))44 (contract-issue-cert contract name :address address :language (request-language)) 45 45 (mail-worldpay-sponsor-data) 46 46 (bknr.web::redirect-request :target (if gift "index" … … 79 79 (scan #?r"rweisung" action) 80 80 (scan #?r"verf" action))) 81 (language ( hunchentoot:session-value :language))81 (language (request-language)) 82 82 (sponsor (make-sponsor :language language)) 83 83 (contract (make-contract sponsor numsqm … … 134 134 strasse 135 135 plz ort) 136 :language ( hunchentoot:session-value :language))136 :language (request-language)) 137 137 (mail-manual-sponsor-data)))) 138 138 trunk/projects/bos/web/web-utils.lisp
r3294 r3557 31 31 " - current content language is " 32 32 (cmslink "change-language" 33 (:princ-safe ( current-website-language))33 (:princ-safe (request-language)) 34 34 " (" 35 (:princ-safe (language-name ( current-website-language)))35 (:princ-safe (language-name (request-language))) 36 36 ")")))) 37 37 38 38 (defun language-name (language-short-name) 39 39 (cadr (assoc language-short-name (website-languages) :test #'equal))) 40 41 (defun current-website-language ()42 (unless (hunchentoot:session-value :language)43 (setf (hunchentoot:session-value :language) *default-language*))44 (hunchentoot:session-value :language))45 40 46 41 (defun content-language-chooser () … … 52 47 (html (cmslink (format nil "~A?language=~A" (hunchentoot:request-uri*) language-symbol) 53 48 (:princ-safe language-name))))) 54 (if (equal ( hunchentoot:session-value :language) language-symbol)49 (if (equal (request-language) language-symbol) 55 50 (html "[" (show-language-link) "]") 56 51 (html (show-language-link))) trunk/projects/bos/web/webserver.lisp
r3554 r3557 113 113 (when logout 114 114 (hunchentoot:remove-session hunchentoot:*session*))) 115 (let ((language ( hunchentoot:session-value :language)))115 (let ((language (request-language))) 116 116 (redirect #?"/infosystem/$(language)/satellitenkarte.htm"))) 117 117 … … 179 179 (call-next-method)))) 180 180 181 (defmethod authorize :after ((authorizer bos-authorizer)) 182 (let ((new-language (or (language-from-url (hunchentoot:request-uri*)) 183 (query-param "language"))) 184 (current-language (hunchentoot:session-value :language))) 185 (when (or (not current-language) 186 (and new-language 187 (not (equal new-language current-language)))) 188 (setf (hunchentoot:session-value :language) 189 (or new-language 190 (find-browser-prefered-language) 191 *default-language*))))) 181 (defun request-language () 182 (or (hunchentoot:aux-request-value :language) 183 *default-language*)) 184 185 (defmethod handle :before ((handler page-handler)) 186 (setf (hunchentoot:aux-request-value :language) 187 (or (query-param "language") 188 (query-param "lang") 189 (language-from-url (hunchentoot:request-uri*)) 190 (hunchentoot:session-value :language) 191 (find-browser-prefered-language) 192 *default-language*))) 192 193 193 194 ;;; TODOreorg … … 213 214 ("/country-stats" country-stats-handler) 214 215 ("/contract-tree-kml" contract-tree-kml-handler) 215 ("/contract-tree-image" contract-tree-image-handler) 216 ("/contract-tree-image" contract-tree-image-handler) 216 217 ("/contract-image" contract-image-handler) 217 218 ("/contract" contract-handler)
