Changeset 12899 in project


Ignore:
Timestamp:
12/28/08 02:55:21 (11 years ago)
Author:
azul
Message:

Lots of new functionality.

Location:
release/3/svnwiki-translations/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/svnwiki-translations/trunk/svnwiki-translations.meta

    r12533 r12899  
    66 (synopsis "Support for translating wiki pages to multiple languages (eg. including links in a page to all the languages it is available on).")
    77 (category web)
    8  (needs svnwiki-extensions  svnwiki-extensions iconv stream-ext srfi-1 srfi-40 orders format-modular html-stream)
     8 (needs content-type format-modular html-stream iconv orders posix srfi-1 srfi-40 stream-base64 stream-ext svn-client svnwiki-extensions-support url embedded-test)
    99 (license "GPL-3"))
  • release/3/svnwiki-translations/trunk/svnwiki-translations.scm

    r12533 r12899  
    44
    55(declare (export))
    6 (use svnwiki-extensions-support iconv stream-ext srfi-1 srfi-40 orders format-modular html-stream posix)
     6(use content-type format-modular html-stream iconv orders posix srfi-1 srfi-40 stream-base64 stream-ext svn-client svnwiki-extensions-support url embedded-test)
    77
    88(define *languages*
     
    6767
    6868(svnwiki-extension-define 'code-break 'translations translations-links)
     69
     70;;; Database handling
     71
     72(define *translations-db* #f)
     73
     74(define (translations-db-run env query . params)
     75  (let-from-environment env (data)
     76    (unless *translations-db*
     77      (let* ((db-path (svnwiki-make-pathname data "translations" "db"))
     78             (existed (file-exists? db-path)))
     79        (format (current-error-port) "Opening DB: ~A~%" db-path)
     80        (set! *translations-db* (sqlite3:open db-path))
     81        (unless existed
     82          (format (current-error-port) "Creating initial tables in DB: ~A~%" db-path)
     83          (translations-db-create env))))
     84    (let ((result
     85            (iterator->stream
     86              (lambda (capture stop)
     87                (receive (stmt rest)
     88                         (sqlite3:prepare *translations-db* query)
     89                  (apply (stream-wrap-proc-string sqlite3:for-each-row) (compose capture vector) stmt params)
     90                  (sqlite3:finalize! stmt))))))
     91      (stream-length result) ; force execution
     92      result)))
     93
     94(define (translations-db-create env)
     95  (translations-db-run env "CREATE TABLE dependencies ( path varchar, string varchar );")
     96  (translations-db-run env "CREATE TABLE translations ( path varchar, source varchar, destination varchar );"))
     97
     98;;; Translating strings
     99
     100(define (get-trans env src)
     101  (let-from-environment env (translations-path)
     102    (let ((dst (translations-db-run env "SELECT destination FROM translations WHERE path = ? AND source = ?;" translations-path (stream->string src))))
     103      (and (not (stream-null? dst))
     104           (string->stream (vector-ref (stream-car dst) 0))))))
     105
     106(define (translate-str env text)
     107  (let-from-environment env (path-in path)
     108    (translations-db-run env "INSERT INTO dependencies VALUES ( ?, ? );" path text)
     109    (or (get-trans env text)
     110        (html-stream "<untranslated>" text "</untranslated>"))))
     111
     112(define (untranslated env)
     113  (let-from-environment env (text parse-paragraph path path-in)
     114    (html-stream
     115      ((span class "untranslated")
     116       (parse-paragraph text)
     117       ((span class "translatelink")
     118        " ["
     119        ((a href (format #f "#~A~A?action=edit&section=~A&create=true"
     120                         (get-props-parents-first "svnwiki:application-url:http" path-in path #f)
     121                         path
     122                         text
     123                         (url-encode (stream->string text)))
     124            onclick "alert('Ooops, not implemented yet. Sorry.');")
     125         "translate"))
     126       "]"))))
     127
     128(svnwiki-extension-define 'code-span 'untranslated untranslated)
     129
     130;;; Generating translated files
     131
     132(define (find-translations-path env . rest)
     133  (let-from-environment env (path-in path)
     134    (let-optionals rest ((my-directory? directory?))
     135      (let loop ((path path))
     136        (if (my-directory? (svnwiki-make-pathname (list path-in path) "xsvnwiki-translations"))
     137          path
     138          (and (not (string=? path ""))
     139               (loop (svnwiki-dirname path))))))))
     140
     141(test-group find-translations-path
     142  (test (find-translations-path (environment ((path-in "/path-in") (path "foo/bar/hey")))
     143                                (lambda (str)
     144                                  (string=? str "/path-in/xsvnwiki-translations")))
     145        "")
     146
     147  (test (find-translations-path (environment ((path-in "/path-in") (path "foo/bar/hey")))
     148                                (lambda (str)
     149                                  (or (string=? str "/path-in/foo/bar/xsvnwiki-translations")
     150                                      (string=? str "/path-in/xsvnwiki-translations"))))
     151        "foo/bar"))
     152
     153
     154(define (translations-update env)
     155  (let-from-environment env (path-in path path-out)
     156    (unless (or (directory? (svnwiki-repository-path env))
     157                (string=? (svnwiki-basename (svnwiki-dirname path)) "xsvnwiki-translations")
     158                (svnwiki-file-language path)
     159                (get-props-parents-first-boolean env "svnwiki:translations:ignore" #f)
     160                (not (svnwiki-render-file-contents (environment env ((path-out-real path))))))
     161      (let ((translations-path (find-translations-path env)))
     162        (when translations-path
     163          (for-each
     164            (lambda (lang)
     165              (svnwiki-report-progress env (svnwiki-translate env "Generating translation to ~A for: ~A~%") lang path)
     166              (translations-db-run env "DELETE FROM dependencies WHERE path = ?;" path)
     167              (let ((content-type (render-file-mime-type env))
     168                    (path-out-real (format #f "~A.~A" path lang)))
     169                (write-file-with-tmp path-out-real content-type path-out
     170                  (render-file
     171                    (environment env ((path-out-real path-out-real)
     172                                      (translate
     173                                        (cut translate-str
     174                                             (environment env
     175                                               ((translations-path (svnwiki-make-pathname (list translations-path "xsvnwiki-translations") lang))))
     176                                             <...>))))
     177                    'view))))
     178            (directory (svnwiki-make-pathname (list path-in translations-path) "xsvnwiki-translations"))))))))
     179
     180(svnwiki-extension-define 'update-notify-recursive 'translations translations-update)
     181
     182;;; Updating lists of translations
     183
     184; Return a stream of elements of the form (src dst), where both src and dst are
     185; streams of characters.  Each corresponds to one translation of the string
     186; 'src' to the string 'dst' found in the file specified (by path-in and path).
     187
     188(define (get-translations-from-file env)
     189  (let-from-environment env (path-in path)
     190    (wiki-translations (wiki-open path-in path))))
     191
     192(define (translations-update-catalog env)
     193  (let-from-environment env (path-in path path-out regenerate-page)
     194    (when (string=? (svnwiki-basename (svnwiki-dirname path)) "xsvnwiki-translations")
     195      (svnwiki-report-progress env (svnwiki-translate env "Updating cache of translations: ~A~%") path)
     196      (let ((new-translations (get-translations-from-file env)))
     197        ; Regenerate pages that depend on translations that changed:
     198        (stream-for-each
     199          (lambda (data)
     200            (let ((old (get-trans (environment env ((translations-path path))) (car data))))
     201              (unless (and old (stream= char=? old (cadr data)))
     202                (stream-for-each
     203                  (compose regenerate-page (cut vector-ref <> 0))
     204                  (translations-db-run env "SELECT path FROM dependencies WHERE string = ?;" (car data))))))
     205          new-translations)
     206        ; Remove old translations
     207        (translations-db-run env "DELETE FROM translations WHERE path = ?;" path)
     208        ; Store new translations
     209        (stream-for-each
     210          (lambda (data)
     211            (translations-db-run env "INSERT INTO translations VALUES ( ?, ?, ? );" path (car data) (cadr data)))
     212          new-translations)))))
     213
     214(svnwiki-extension-define 'update-notify-recursive-meta 'translations translations-update-catalog)
Note: See TracChangeset for help on using the changeset viewer.