translate.lisp 4.81 KB
Newer Older
Daniel Kochmański committed
1 2 3 4 5 6 7 8 9 10 11 12 13
;;;; 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")

14 15 16 17 18 19 20 21 22 23 24
 ;; utilities
(defmacro with-language (name (dict miss m-fn) &body body)
  "Conveniance macro which creates lexical invironment composed of
  macro symbols which resolve to language list."
  (let ((lang-entry (gensym)))
    `(symbol-macrolet ((,lang-entry (getf *translations* ,name))
                       (,dict (first  ,lang-entry))
                       (,miss (second ,lang-entry))
                       (,m-fn (third  ,lang-entry)))
       ,@body)))

Daniel Kochmański committed
25 26 27 28
 ;; creation
(defun define-language (name &rest translations)
  "Define language NAME with provided TRANSLATIONS

29 30 31 32
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 committed
33 34 35 36 37 38 39 40 41 42 43
  (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))

44 45 46 47 48 49 50 51 52 53 54 55 56
(defun ensure-language (name &optional cerror-p)
  "If NAME isn't NIL and language doesn't exist - define it. If
  CERROR-P non-NIL, then signal a condition if it doesn't exist,
  otherwise just emmit a warning."
  (when name
    (with-language name (dict miss m-fn)
      (unless dict
        (if cerror-p
            (cerror "Create language."
                    "Language ~A doesn't exist." name)
            (warn "Implicitly creating language ~A." name))
        (define-language name)))))

Daniel Kochmański committed
57 58 59
(defun add-single-translation (language phrase translation)
  "Add TRANSLATION of PHRASE for given LANGUAGE

60 61
If LANGUAGE doesn't exist, it is implicitly created and a warning is
emmited."
Daniel Kochmański committed
62
  (check-type phrase string)
63 64 65
  (ensure-language language)
  (with-language language (dict miss miss-fn)
    (declare (ignore miss-fn))
Daniel Kochmański committed
66
    (format t "[~a] ~a -> ~a~%" language phrase translation)
67 68
    (setf miss (remove phrase miss :test #'equal :count 1)
          (gethash phrase dict) translation)))
Daniel Kochmański committed
69 70

(defun add-translations (language &rest translations)
71
  "Add any number of TRANSLATIONS for the given LANGUAGE"
Daniel Kochmański committed
72 73 74 75 76 77 78 79
  (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*))
80
  "Find the translation of PHRASE in the store associated with LANGUAGE
Daniel Kochmański committed
81

82 83 84 85 86
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 committed
87
  (check-type phrase string)
88 89 90
  (cond
    ((null language) phrase)
    (T (ensure-language language T)
Daniel Kochmański committed
91
       (with-language language (dictionary missing missing-fn)
Daniel Kochmański committed
92 93 94 95 96
          (declare (ignore missing))
          (multiple-value-bind (result found?)
              (gethash phrase dictionary
                       (funcall missing-fn phrase))
            (unless found?
Daniel Kochmański committed
97
              (pushnew phrase missing :test 'equal)
Daniel Kochmański committed
98 99
              (warn "Phrase \"~A\" isn't defined for language ~A."
                    phrase language))
100
            result)))))
Daniel Kochmański committed
101 102 103 104 105 106 107 108 109 110 111 112 113

(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 ()
114 115
  "Creates a list of phrases which aren't translated for the defined
languages. Returns a list of form: ({(LANG ({PHRASE}*))}*)"
Daniel Kochmański committed
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
  (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)))))