translate.lisp 4.36 KB
Newer Older
Daniel Kochmański's avatar
Daniel Kochmański committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
;;;; cl-translate.lisp

(in-package #:translate)

 ;; global variables
(defparameter *language* nil
  "Language for which the translation is done")
(defparameter *translations* nil
  "Table containing further translation tables")
(defparameter *resolution-time* :run-time
  "Controlls translation resulution time - maybe be either :run-time
or :load-time")

 ;; creation
(defun define-language (name &rest translations)
  "Define language NAME with provided TRANSLATIONS

18 19 20 21
If LANGUAGE exists, a continuable error is signalled, which allows
either dropping the operation or superseding the language which is
already defined. TRANSLATIONS are alternating phrases and their
corresponding objects."
Daniel Kochmański's avatar
Daniel Kochmański committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35
  (when (getf *translations* name)
    (cerror "Supersede language."
            "Language ~A is already defined." name))
  (setf (getf *translations* name)
        (list (make-hash-table :test 'equal)
              nil
              #'(lambda (str)
                  (concatenate 'string
                               "{" str "}"))))
  (apply #'add-translations name translations))

(defun add-single-translation (language phrase translation)
  "Add TRANSLATION of PHRASE for given LANGUAGE

36 37
If LANGUAGE doesn't exist, it is implicitly created and a warning is
emmited."
Daniel Kochmański's avatar
Daniel Kochmański committed
38
  (check-type phrase string)
39 40 41 42
  (symbol-macrolet ((lang-entry (getf *translations* language)))
    (unless lang-entry
      (warn "Implicitly creating language ~A." language)
      (define-language language))
Daniel Kochmański's avatar
Daniel Kochmański committed
43
    (format t "[~a] ~a -> ~a~%" language phrase translation)
44 45 46 47 48
    (setf (second lang-entry) (remove phrase
                                      (second lang-entry)
                                      :test #'equal
                                      :count 1)
          (gethash phrase (first lang-entry)) translation)))
Daniel Kochmański's avatar
Daniel Kochmański committed
49 50

(defun add-translations (language &rest translations)
51
  "Add any number of TRANSLATIONS for the given LANGUAGE"
Daniel Kochmański's avatar
Daniel Kochmański committed
52 53 54 55 56 57 58 59
  (do* ((tr translations (cddr tr)))
       ((endp tr) T)
    (destructuring-bind (phrase trans &rest ign) tr
      (declare (ignore ign))
      (add-single-translation language phrase trans))))

 ;; resolution
(defun translate (phrase &optional (language *language*))
60
  "Find the translation of PHRASE in the store associated with LANGUAGE
Daniel Kochmański's avatar
Daniel Kochmański committed
61

62 63 64 65 66
If LANGUAGE is NIL, then this is the same as the the IDENTITY
function. If the provided LANGUAGE isn't defined, the store is
explicitly created. If no PHRASE is defined for a given language, it
is stored for later translation and replaced by PHRASE surrunded by
curly brackets."
Daniel Kochmański's avatar
Daniel Kochmański committed
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
  (check-type phrase string)
  (if language
      (let ((lang
             (or (getf *translations* language)
                 (progn (cerror "Create language."
                                "Language ~A doesn't exist." language)
                        (define-language language)
                        (getf *translations* language)))))
        (destructuring-bind (dictionary missing missing-fn) lang
          (declare (ignore missing))
          (multiple-value-bind (result found?)
              (gethash phrase dictionary
                       (funcall missing-fn phrase))
            (unless found?
              (pushnew phrase (second lang) :test 'equal)
              (warn "Phrase \"~A\" isn't defined for language ~A."
                    phrase language))
            result)))
      phrase))

(set-dispatch-macro-character
 #\# #\t
 #'(lambda (stream char1 char2)
     (declare (ignore char1 char2))
     (let ((phrase (read stream)))
       (check-type phrase string)
       (if (eql *resolution-time* :load-time)
	   (translate phrase)
	   `(translate ,phrase)))))

 ;; missing translations
(defun missing-translations ()
99 100
  "Creates a list of phrases which aren't translated for the defined
languages. Returns a list of form: ({(LANG ({PHRASE}*))}*)"
Daniel Kochmański's avatar
Daniel Kochmański committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
  (do* (acc
        (reminder *translations* (cddr reminder))
        (elt (second (cadr reminder))
             (second (cadr reminder))))
      ((null reminder) acc)
    (when elt
      (push (list (car reminder)
                  elt)
            acc))))

#+(or)
(defun missing-translations-template ()
  `(block nil
     ,@(let (acc)
         (dolist (tr (missing-translations) acc)
           (push
            `(add-translations ,(car tr)
                               ,@(mapcar #'(lambda (elt)
                                             (list elt "{FILL-ME}"))
                                         (second tr)))
            acc)))))