Changeset 3286

Show
Ignore:
Timestamp:
06/17/08 14:01:20 (7 months ago)
Author:
ksprotte
Message:

bos/web finished dictionary

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/payment-website/templates/da/dictionary.xml

    r3275 r3286  
     1<?xml version="1.0" encoding="UTF-8"?> 
     2 
    13<dictionary> 
    2   <title>ein dÀnischer titel</title> 
    3   <description>eine dÀnische beschreibung</description> 
     4  <!-- in /tmp/ttt.lisp  
     5       /tmp/ttt2.lisp  --> 
     6  <entry> 
     7    <key> 
     8      hallo wie gehts? 
     9    </key> 
     10    <value> 
     11    </value> 
     12  </entry> 
     13  <!-- in /tmp/ttt.lisp --> 
     14  <entry> 
     15    <key> 
     16      na? 
     17    </key> 
     18    <value> 
     19    </value> 
     20  </entry> 
     21  <!-- in NIL --> 
     22  <entry> 
     23    <key> 
     24      test 
     25    </key> 
     26    <value> 
     27    </value> 
     28  </entry> 
    429</dictionary> 

  • trunk/projects/bos/payment-website/templates/de/dictionary.xml

    r3275 r3286  
     1<?xml version="1.0" encoding="UTF-8"?> 
     2 
    13<dictionary> 
    2   <title>meint titel</title> 
    3   <description>meine beschreibung</description> 
     4  <!-- in /tmp/ttt.lisp  
     5       /tmp/ttt2.lisp  --> 
     6  <entry> 
     7    <key> 
     8      hallo wie gehts? 
     9    </key> 
     10    <value> 
     11    </value> 
     12  </entry> 
     13  <!-- in /tmp/ttt.lisp --> 
     14  <entry> 
     15    <key> 
     16      na? 
     17    </key> 
     18    <value> 
     19    </value> 
     20  </entry> 
     21  <!-- in NIL --> 
     22  <entry> 
     23    <key> 
     24      test 
     25    </key> 
     26    <value> 
     27    </value> 
     28  </entry> 
    429</dictionary> 

  • trunk/projects/bos/payment-website/templates/en/dictionary.xml

    r3275 r3286  
     1<?xml version="1.0" encoding="UTF-8"?> 
     2 
    13<dictionary> 
    2    
     4  <!-- in /tmp/ttt.lisp  
     5       /tmp/ttt2.lisp  --> 
     6  <entry> 
     7    <key> 
     8      hallo wie gehts? 
     9    </key> 
     10    <value> 
     11      hi, how are you? 
     12    </value> 
     13  </entry> 
     14  <!-- in /tmp/ttt.lisp --> 
     15  <entry> 
     16    <key> 
     17      na? 
     18    </key> 
     19    <value> 
     20    </value> 
     21  </entry> 
     22  <!-- in NIL --> 
     23  <entry> 
     24    <key> 
     25      test 
     26    </key> 
     27    <value> 
     28    </value> 
     29  </entry> 
    330</dictionary> 

  • trunk/projects/bos/web/dictionary.lisp

    r3285 r3286  
    33(defvar *dictionary* (make-hash-table :test #'equal)) 
    44(defvar *dictionary-last-reads-alist* nil) 
     5(defvar *dictionary-keys* nil 
     6  "An alist of key compile-file-pathnames pairs that is 
     7  automatically build at compile-time from all occurences of 
     8  DICTIONARY-ENTRY in user-code.") 
    59 
    6 (defparameter *dictionary-directory* *website-directory* 
     10(defmacro dictionary-directory () 
    711  "The xml files containing dictionary definitions for a 
    812  particular language are stored under 
    9   *dictionary-directory*/<language>/dictionary.xml.") 
     13  (dictionary-directory)/<language>/dictionary.xml." 
     14  '*website-directory*) 
    1015 
    1116(deftype dictionary-language () 
    …… 
    2126    (keyword language-designator))) 
    2227 
    23 (defun dictionary-entry (key language)   
     28(defun dictionary-key-occurences (key) 
     29  (cdr (assoc key *dictionary-keys* :test #'string=))) 
     30 
     31(defun (setf dictionary-key-occurences) (value key) 
     32  (let ((cons (assoc key *dictionary-keys* :test #'string=))) 
     33    (if cons 
     34        (rplacd cons value) 
     35        (push (cons key value) *dictionary-keys*)))) 
     36 
     37(defun %dictionary-entry (key language)   
    2438  (let ((language (dictionary-language language))) 
    2539    (load-dictionary-if-needed language) 
    …… 
    2741        key))) 
    2842 
    29 (defun (setf dictionary-entry) (value key language)   
     43(defun (setf %dictionary-entry) (value key language)   
    3044  (let* ((language (dictionary-language language)) 
    3145         (it (assoc language (gethash key *dictionary*)))) 
    …… 
    3347        (rplacd it value) 
    3448        (push (cons language value) (gethash key *dictionary*))))) 
     49 
     50(defmacro dictionary-entry (key language) 
     51  (flet ((pathname-equal (a b) 
     52           (equal (namestring a) (namestring b)))) 
     53    (check-type key string)   
     54    (when *compile-file-pathname* 
     55      (pushnew *compile-file-pathname* (dictionary-key-occurences key) 
     56               :test #'pathname-equal)) 
     57    `(%dictionary-entry ,key ,language))) 
    3558 
    3659(defun dictionary-clear-entries-by-language (language) 
    …… 
    6184                                  :type "xml" 
    6285                                  :directory (list :relative "templates" (string-downcase (string language)))) 
    63                    *dictionary-directory*)) 
     86                   (dictionary-directory))) 
    6487 
    6588(defun load-dictionary (language xml-path) 
    6689  (declare (dictionary-language language)) 
    67   (labels ((load-language (language xml-path)              
     90  (labels ((trim-whitespace (string) 
     91             (string-trim '(#\space #\newline #\tab) string)) 
     92           (load-language (language xml-path)              
    6893             (handler-case 
    6994                 (let ((xmls (cxml:parse-file xml-path (cxml-xmls:make-xmls-builder)))) 
    …… 
    7196                           "root element should be \"dictionary\"") 
    7297                   (dolist (element (cxml-xmls:node-children xmls)) 
    73                      (when (consp element) 
    74                        (let ((key (cxml-xmls:node-name element)) 
    75                              (value (first (cxml-xmls:node-children element))))                          
    76                          (assert (or (null value) (stringp value))) 
    77                          (when value 
    78                            (setf (dictionary-entry key language) value)))))) 
     98                     (when (consp element)                        
     99                       (assert (equal "entry" (cxml-xmls:node-name element)) nil 
     100                               "expected element \"entry\"") 
     101                       (let ((key-value (remove-if #'atom (cxml-xmls:node-children element)))) 
     102                         (assert (equal "key" (cxml-xmls:node-name (first key-value))) nil 
     103                                 "expected element \"key\"") 
     104                         (assert (equal "value" (cxml-xmls:node-name (second key-value))) nil 
     105                                 "expected element \"value\"") 
     106                         (let ((key (trim-whitespace (first (cxml-xmls:node-children (first key-value))))) 
     107                               (value (trim-whitespace (first (cxml-xmls:node-children (second key-value)))))) 
     108                           (assert (stringp key)) 
     109                           (assert (stringp value))                            
     110                           (unless (zerop (length value)) 
     111                             (setf (%dictionary-entry key language) value))))))) 
    79112               (error (c) 
    80113                 (error "Error while loading ~a:~%~a" 
    81                         (enough-namestring xml-path *dictionary-directory*) c)))))     
     114                        (enough-namestring xml-path (dictionary-directory)) c)))))     
    82115    (dictionary-clear-entries-by-language language) 
    83116    (load-language language xml-path)     
    …… 
    92125      (load-dictionary language xml-path)))) 
    93126 
     127(defun dictionary-write-template (&optional (stream *standard-output*)) 
     128  (cxml:with-xml-output (make-character-stream-sink stream :canonical nil :indentation 2) 
     129    (with-element "dictionary"        
     130      (loop for (key . paths) in (sort (copy-list *dictionary-keys*) #'string< :key #'car) 
     131         do (cxml:comment (format nil " in ~A ~{~%~8T~A  ~}" (first paths) (rest paths)))       
     132         do (with-element "entry" 
     133              (with-element "key" (text key)) 
     134              (with-element "value" (text ""))))))) 
     135