Author: achiumenti Date: Fri Mar 14 02:57:28 2008 New Revision: 17 Modified: trunk/main/claw-core/src/misc.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/tests/test1.lisp Log: beginning of translators and i18n support Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Fri Mar 14 02:57:28 2008 @@ -144,7 +144,7 @@ (t (push element result)))) (nreverse result))) -(defmacro with-message (key locale &optional (default "")) +(defmacro with-message (key &optional (default "") locale) (let ((current-lisplet (gensym)) (current-page (gensym)) (current-component (gensym)) @@ -157,28 +157,43 @@ (,current-page (current-page)) (,current-component (current-component)) (,locale-val ,locale) - (,result)) - (log-message :info "LISPLET: ~a; PAGE: ~a; COMPONENT: ~a" - ,current-lisplet - ,current-page - ,current-component) - (when ,current-lisplet - (log-message :info "CALLING (message-dispatch ~a ~a ~a)" ,current-lisplet ,key-val ,locale-val) - (setf ,result (message-dispatch ,current-lisplet ,key-val ,locale-val))) - (when (and (null ,result) ,current-page) - (setf ,result (message-dispatch ,current-page ,key-val ,locale-val))) - (when (and (null ,result) ,current-component) - (setf ,result (message-dispatch ,current-component ,key-val ,locale-val))) - (when (null ,result) - (setf ,locale-val "") + (,result)) + (unless ,locale-val + (setf ,locale-val (user-locale))) (when ,current-lisplet (setf ,result (message-dispatch ,current-lisplet ,key-val ,locale-val))) (when (and (null ,result) ,current-page) (setf ,result (message-dispatch ,current-page ,key-val ,locale-val))) (when (and (null ,result) ,current-component) - (setf ,result (message-dispatch ,current-component ,key-val ,locale-val)))) - (if ,result - ,result - ,default-val))))) + (setf ,result (message-dispatch ,current-component ,key-val ,locale-val))) + (when (null ,result) + (setf ,locale-val "") + (when ,current-lisplet + (setf ,result (message-dispatch ,current-lisplet ,key-val ,locale-val))) + (when (and (null ,result) ,current-page) + (setf ,result (message-dispatch ,current-page ,key-val ,locale-val))) + (when (and (null ,result) ,current-component) + (setf ,result (message-dispatch ,current-component ,key-val ,locale-val)))) + (if ,result + ,result + ,default-val))))) - \ No newline at end of file + +(defun user-locale (&optional (request *request*) (session *session*)) + (let ((locale (when session + (session-value 'locale session)))) + (unless locale + (setf locale (first (loop for str in (all-matches-as-strings + "[A-Z|a-z|_]+" + (regex-replace-all "-" (regex-replace-all ";.*" (header-in "ACCEPT-LANGUAGE" request) "") "_")) + collect (if (> (length str) 2) + (string-upcase str :start 2) + str))))) + locale)) + +(defun (setf user-locale) (locale &optional (session *session*)) + (unless session + (setf session (lisplet-start-session))) + (setf (session-value 'locale session) locale)) + + Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Fri Mar 14 02:57:28 2008 @@ -272,6 +272,7 @@ :current-realm :current-page :current-component + :user-locale :page-current-component :user-in-role-p :login Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Fri Mar 14 02:57:28 2008 @@ -389,7 +389,7 @@ :url nil) (:documentation "A page object holds claw components to be rendered") ) -(defclass htcomponent () +(defclass htcomponent (i18n-aware) ((page :initarg :page :reader htcomponent-page :documentation "The owner page") (body :initarg :body @@ -431,6 +431,8 @@ (:default-initargs :raw nil) (:documentation "Component needed to render strings")) + + (defmethod initialize-instance :after ((inst tag) &rest keys) (let ((emptyp (getf keys :empty)) (body (getf keys :body))) @@ -943,7 +945,7 @@ js)) ;;;========= WCOMPONENT =================================== -(defclass wcomponent (htcomponent i18n-aware) +(defclass wcomponent (htcomponent) ((parameters :initarg :parameters :accessor wcomponent-parameters :type cons @@ -1142,8 +1144,8 @@ (when dispatcher (progn (setf result (message-dispatch dispatcher key locale)) - (when (and (null result) (> (length key) 2)) - (setf result (message-dispatch dispatcher (subseq key 0 2) locale))))) + (when (and (null result) (> (length locale) 2)) + (setf result (message-dispatch dispatcher key (subseq locale 0 2)))))) result)) (defmethod simple-message-dispatcher-add-message ((simple-message-dispatcher simple-message-dispatcher) locale key value) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Fri Mar 14 02:57:28 2008 @@ -354,7 +354,7 @@ (validator-required (page-current-component o) value)) :accessor 'form-page-name)"*")) (tr> :id "messaged" - (td> (with-message "SURNAME" "it")) + (td> (with-message "SURNAME" "SURNAME")) (td> (cinput> :id "surname" :type "text"