[claw-cvs] r16 - in trunk/main/claw-core: src tests
Author: achiumenti Date: Wed Mar 12 15:20:24 2008 New Revision: 16 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 Wed Mar 12 15:20:24 2008 @@ -144,33 +144,31 @@ (t (push element result)))) (nreverse result))) -(defmacro message (key locale &optional (default "")) +(defmacro with-message (key locale &optional (default "")) (let ((current-lisplet (gensym)) (current-page (gensym)) (current-component (gensym)) (result (gensym)) (key-val key) - (locale-val locale) + (locale-val (gensym)) (default-val default)) `#'(lambda () (let ((,current-lisplet (current-lisplet)) - (,current-page (current-page)) - (,current-component (current-component)) - (,result)) + (,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 (and (null ,result) (> (length ,locale-val) 2)) - (setf ,locale-val (subseq ,locale-val 0 2)) - (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)))) + (setf ,result (message-dispatch ,current-component ,key-val ,locale-val))) (when (null ,result) (setf ,locale-val "") (when ,current-lisplet Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Wed Mar 12 15:20:24 2008 @@ -275,7 +275,12 @@ :page-current-component :user-in-role-p :login - :message + ;;i18n + :message-dispatcher + :message-dispatch + :simple-message-dispatcher + :simple-message-dispatcher-add-message + :with-message ;;validation :translator :translator-integer Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Wed Mar 12 15:20:24 2008 @@ -214,6 +214,9 @@ - WCOMPONENT is the tag instance - PAGE the page instance")) +(defgeneric simple-message-dispatcher-add-message (simple-message-dispatcher locale key value) + (:documentation "Adds a key value pair to a given locale for message translation")) + (defvar *html-4.01-strict* "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">" "Page doctype as HTML 4.01 STRICT") @@ -326,6 +329,10 @@ (defclass message-dispatcher () ()) +(defclass simple-message-dispatcher (message-dispatcher) + ((locales :initform (make-hash-table :test #'equal) + :accessor simple-message-dispatcher-locales))) + (defclass i18n-aware (message-dispatcher) ((message-dispatcher :initarg :message-dispatcher :accessor message-dispatcher @@ -577,9 +584,9 @@ (let ((body (page-content page)) (jsonp (page-json-id-list page))) (if (null body) - ;(format nil "null body for page ~a~%" (type-of page)) - (setf (current-page) page) + (format nil "null body for page ~a~%" (type-of page)) (progn + (setf (current-page) page) (page-init page) (when (page-req-parameter page *rewind-parameter*) (htcomponent-rewind body page)) @@ -728,7 +735,7 @@ (when child-tag (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) - ((functionp child-tag) (funcall child-tag)) + ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) (t (htcomponent-render child-tag page))))) (when (null previous-print-status) (setf (page-can-print page) nil) @@ -793,11 +800,13 @@ (htcomponent-json-print-start-component tag)) (when (or (page-can-print page) previous-print-status) (tag-render-starttag tag page)) + (when (string-equal "messaged" (htcomponent-client-id tag)) + (log-message :info "RENDEING ~a: body ~a" (htcomponent-client-id tag) body-list)) (dolist (child-tag body-list) - (when child-tag - (cond + (when child-tag + (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) - ((functionp child-tag) (funcall child-tag)) + ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) (t (htcomponent-render child-tag page))))) (when (or (page-can-print page) previous-print-status) (tag-render-endtag tag page)) @@ -815,7 +824,7 @@ (when child-tag (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) - ((functionp child-tag) (funcall child-tag)) + ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) (t (htcomponent-render child-tag page))))) (dolist (injection injections) (when injection @@ -876,7 +885,7 @@ (when element (cond ((stringp element) (htcomponent-render ($> element) page)) - ((functionp element) (funcall element)) + ((functionp element) (htcomponent-render ($> (funcall element)) page)) (t (htcomponent-render element page))))) (if (null xml-p) (page-format page "~%//-->") @@ -918,7 +927,7 @@ (when child-tag (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) - ((functionp child-tag) (funcall child-tag)) + ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) (t (htcomponent-render child-tag page))))) (when (page-can-print page) (htcomponent-render (htbody-init-scripts-tag page) page) @@ -1095,7 +1104,7 @@ (when child-tag (cond ((stringp child-tag) (htcomponent-render ($> child-tag) page)) - ((functionp child-tag) (funcall child-tag)) + ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page)) (t (htcomponent-render child-tag page))))) (wcomponent-after-render wcomponent page) (when (null previous-print-status) @@ -1137,6 +1146,13 @@ (setf result (message-dispatch dispatcher (subseq key 0 2) locale))))) result)) - - +(defmethod simple-message-dispatcher-add-message ((simple-message-dispatcher simple-message-dispatcher) locale key value) + (let ((current-locale (gethash locale (simple-message-dispatcher-locales simple-message-dispatcher) (make-hash-table :test #'equal)))) + (setf (gethash key current-locale) value) + (setf (gethash locale (simple-message-dispatcher-locales simple-message-dispatcher)) current-locale))) + +(defmethod message-dispatch ((simple-message-dispatcher simple-message-dispatcher) key locale) + (let ((current-locale (gethash locale (simple-message-dispatcher-locales simple-message-dispatcher)))) + (when current-locale + (gethash key current-locale)))) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Wed Mar 12 15:20:24 2008 @@ -35,11 +35,22 @@ (setf *clawserver-base-path* "/claw") +(defvar *lisplet-messages* + (make-instance 'simple-message-dispatcher)) + +(simple-message-dispatcher-add-message *lisplet-messages* "en" "NAME" "Name") +(simple-message-dispatcher-add-message *lisplet-messages* "en" "SURNAME" "Surname") + +(simple-message-dispatcher-add-message *lisplet-messages* "it" "NAME" "Nome") +(simple-message-dispatcher-add-message *lisplet-messages* "it" "SURNAME" "Cognome") + (defvar *test-lisplet*) -(setf *test-lisplet* (make-instance 'lisplet :realm "test1" :base-path "/test")) +(setf *test-lisplet* (make-instance 'lisplet :realm "test1" :base-path "/test" + ));:message-dispatcher *lisplet-messages*)) (defvar *test-lisplet2*) -(setf *test-lisplet2* (make-instance 'lisplet :realm "test2" :base-path "/test2")) +(setf *test-lisplet2* (make-instance 'lisplet :realm "test2" :base-path "/test2" + ));:message-dispatcher *lisplet-messages*)) ;;(defparameter *clawserver* (make-instance 'clawserver :port 4242)) @@ -312,6 +323,7 @@ :colors nil :gender '("M") :age 1800 + :message-dispatcher *lisplet-messages* :user (make-instance 'user))) (defmethod form-page-update-user ((form-page form-page)) @@ -341,8 +353,8 @@ :validator #'(lambda (value) (validator-required (page-current-component o) value)) :accessor 'form-page-name)"*")) - (tr> - (td> "Surname") + (tr> :id "messaged" + (td> (with-message "SURNAME" "it")) (td> (cinput> :id "surname" :type "text"
participants (1)
-
achiumenti＠common-lisp.net