Changeset 18181 in project


Ignore:
Timestamp:
05/23/10 13:23:21 (11 years ago)
Author:
azul
Message:

Lots of additional functionality.

File:
1 edited

Legend:

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

    r12899 r18181  
    9898;;; Translating strings
    9999
     100(define (string-canonical str)
     101  (stream-drop-while
     102    char-whitespace?
     103    (stream-fold-right-delay
     104      (lambda (c rest)
     105        (cond
     106          ((not (char-whitespace? c))
     107           (stream-cons c rest))
     108          ((or (stream-null? rest)
     109               (char-whitespace? (stream-car rest)))
     110           rest)
     111          (else (stream-cons #\space rest))))
     112      stream-null
     113      (if (string? str) (string->stream str) str))))
     114
     115(test-group string-canonical
     116  (test (stream->string (string-canonical (string->stream "  hey\nthere    you  \n  boy   ")))
     117        "hey there you boy"))
     118
    100119(define (get-trans env src)
    101120  (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))))
     121    (let ((dst (translations-db-run env "SELECT destination FROM translations WHERE path = ? AND source = ?;" translations-path (string-canonical src))))
    103122      (and (not (stream-null? dst))
    104123           (string->stream (vector-ref (stream-car dst) 0))))))
     
    106125(define (translate-str env text)
    107126  (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)
     127    (when (stream-null? (translations-db-run env "SELECT path FROM dependencies WHERE path = ? AND string = ?;" path (string-canonical text)))
     128      (translations-db-run env "INSERT INTO dependencies VALUES ( ?, ? );" path (string-canonical text)))
     129    (let ((trans (get-trans env text)))
     130      (html-stream
     131        (format "<translation original='~A' translated=~A>" (url-encode (stream->string text)) (if trans "true" "false"))
     132        (or trans text)
     133        "</translation>"))))
     134
     135(define (translation env)
     136  (let-from-environment env (text parse-paragraph path path-in translations-path params)
     137    (let ((container (format #f "untranslated-~A" (random 1000000)))
     138          (original (cdr (or (assoc 'original params) (cons #f text))))
     139          (translated (stream= char=? (cdr (or (assoc 'translated params) (cons #f stream-null))) (string->stream "true"))))
     140      (html-stream
     141        ((span class (if translated "translationdone" "translation") id container)
     142         (parse-paragraph text)
     143         ((span class "translatelink")
     144          " ["
     145          ((a href (format #f "~A~A?action=edit&section=~A&create=true"
     146                           (get-props-parents-first "svnwiki:application-url:http" path-in path #f)
     147                           translations-path
     148                           (stream->string (string-canonical original)))
     149              onclick (format #f "if (typeof(svnwikiInlineEdit) == 'object') { return !svnwikiInlineEdit.loadForm('~A', '~A', '~A', true); } return true;"
     150                              (url-encode container)
     151                              (stream->string (string-canonical original))
     152                              (url-encode translations-path (list #\. #\/))))
     153           (if translated
     154             "Edit translation"
     155             "Add translation"))
     156          "]"))))))
     157
     158(svnwiki-extension-define 'code-span 'translation translation)
    129159
    130160;;; Generating translated files
     
    152182
    153183
     184(define (translatable? env)
     185  (let-from-environment env (path)
     186    (not (or (directory? (svnwiki-repository-path env))
     187             (string=? (svnwiki-basename (svnwiki-dirname path)) "xsvnwiki-translations")
     188             (svnwiki-file-language path)
     189             (get-props-parents-first-boolean env "svnwiki:translations:ignore" #f)
     190             (not (svnwiki-render-file-contents (environment env ((path-out-real path)))))))))
     191
    154192(define (translations-update env)
    155193  (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)))
     194    (when (translatable? env)
     195      (let* ((translations-path (find-translations-path env))
     196             (languages (list->stream (directory (svnwiki-make-pathname (list path-in translations-path) "xsvnwiki-translations")))))
    162197        (when translations-path
    163           (for-each
     198          (stream-for-each
    164199            (lambda (lang)
    165200              (svnwiki-report-progress env (svnwiki-translate env "Generating translation to ~A for: ~A~%") lang path)
     
    170205                  (render-file
    171206                    (environment env ((path-out-real path-out-real)
     207                                      (translations-path (svnwiki-make-pathname (list translations-path "xsvnwiki-translations") lang))
    172208                                      (translate
    173209                                        (cut translate-str
     
    176212                                             <...>))))
    177213                    'view))))
    178             (directory (svnwiki-make-pathname (list path-in translations-path) "xsvnwiki-translations"))))))))
     214            languages)
     215          (render-translations-status env translations-path languages))))))
    179216
    180217(svnwiki-extension-define 'update-notify-recursive 'translations translations-update)
     218
     219;;; Status of translations
     220
     221(define (render-translations-status env translations-path languages)
     222  (let-from-environment env (path-in path path-out)
     223    (svnwiki-report-progress env (svnwiki-translate env "Generating report of translations status for: ~A~%") path)
     224    (let ((path-out-real (svnwiki-make-pathname (list (svnwiki-dirname path) "xsvnwiki-translations-status") (svnwiki-basename path))))
     225      (write-file-with-tmp path-out-real "text/html" path-out
     226        (render-template
     227          (environment env ((path-out-real path-out-real)))
     228          "Translations: "
     229          (html-stream
     230            (p "The following is the translation status for this file:")
     231            (table
     232              (tr
     233                (td "Original")
     234                (stream-concatenate
     235                  (stream-map
     236                    (lambda (lang)
     237                      (html-stream
     238                        (td
     239                          ((a href (make-link-url path-out-real (svnwiki-make-pathname #f path lang) #f)) lang)
     240                          " ["
     241                          ((a href (make-link-url path-out-real (svnwiki-make-pathname (list translations-path "xsvnwiki-translations") lang) #f)) "catalog")
     242                          "]")))
     243                    languages)))
     244              (stream-concatenate
     245                (stream-map
     246                  (lambda (str)
     247                    (html-stream
     248                      (tr
     249                        (td (vector-ref str 0))
     250                        (stream-concatenate
     251                          (stream-map
     252                            (lambda (lang)
     253                              (html-stream
     254                                (td
     255                                  (let ((text (translations-db-run env "SELECT destination FROM translations WHERE path = ? AND source = ?;"
     256                                                                   (svnwiki-make-pathname (list translations-path "xsvnwiki-translations") lang)
     257                                                                   (string-canonical (vector-ref str 0)))))
     258                                    (if (stream-null? text)
     259                                      "Missing"
     260                                      (svnwiki-stream-cut-with-ellipsis (vector-ref (stream-car text) 0) 40)))
     261                                  " ["
     262                                  ((a href (format #f "~A~A?action=edit&section=~A&create=true"
     263                                                   (get-props-parents-first "svnwiki:application-url:http" path-in path #f)
     264                                                   (svnwiki-make-pathname (list translations-path "xsvnwiki-translations") lang)
     265                                                   (stream->string (string-canonical (vector-ref str 0)))))
     266                                   "Edit")
     267                                  "]")))
     268                            languages)))))
     269                  (translations-db-run env "SELECT string FROM dependencies WHERE path = ?;" path)))))
     270          'view)))))
     271
     272(define (translations-actions-links env)
     273  (when (translatable? env)
     274    (let-from-environment env (path path-out-real)
     275      (unless (string=? (svnwiki-basename (svnwiki-dirname path-out-real))
     276                        "xsvnwiki-translations-status")
     277        (svnwiki-file-action-link
     278          env
     279          (svnwiki-make-pathname "xsvnwiki-translations-status" (svnwiki-basename path))
     280          "Translations")))))
     281
     282(svnwiki-extension-define 'files-actions-links 'translations translations-actions-links)
    181283
    182284;;; Updating lists of translations
     
    202304                (stream-for-each
    203305                  (compose regenerate-page (cut vector-ref <> 0))
    204                   (translations-db-run env "SELECT path FROM dependencies WHERE string = ?;" (car data))))))
     306                  (translations-db-run env "SELECT path FROM dependencies WHERE string = ?;" (string-canonical (car data)))))))
    205307          new-translations)
    206308        ; Remove old translations
     
    209311        (stream-for-each
    210312          (lambda (data)
    211             (translations-db-run env "INSERT INTO translations VALUES ( ?, ?, ? );" path (car data) (cadr data)))
     313            (translations-db-run env "INSERT INTO translations VALUES ( ?, ?, ? );" path (string-canonical (car data)) (cadr data)))
    212314          new-translations)))))
    213315
    214316(svnwiki-extension-define 'update-notify-recursive-meta 'translations translations-update-catalog)
     317
     318;;; List of dependencies on translations
     319
     320(define (translations-footer env)
     321  (let-from-environment env (path-in path return name path-out-real)
     322    (when (string=? (svnwiki-basename (svnwiki-dirname path)) "xsvnwiki-translations")
     323      (let ((deps (translations-db-run env "SELECT path FROM dependencies WHERE string = ?;" (string-canonical name))))
     324        (return
     325          (if (stream-null? deps)
     326            (html-stream (p "No pages depend on this translation."))
     327            (html-stream
     328              (p "The following pages depend on this translation:")
     329              (stream->html-ul
     330                (stream-map
     331                  (lambda (data)
     332                    (svnwiki-get-title-html (environment env ((path (vector-ref data 0))))))
     333                  deps)))))))))
     334
     335(svnwiki-extension-define 'section-footer 'translations translations-footer)
     336
     337(define (translations-catalog? env)
     338  (let-from-environment env (path)
     339    (string=? (svnwiki-basename (svnwiki-dirname path)) "xsvnwiki-translations")))
     340
     341(test-group translations-catalog?
     342  (test (translations-catalog? (environment ((path "foo/xsvnwiki-translations/en")))))
     343  (test (translations-catalog? (environment ((path "xsvnwiki-translations/en")))))
     344  (test (not (translations-catalog? (environment ((path "foo/xsvnwiki-translations"))))))
     345  (test (not (translations-catalog? (environment ((path "foo/bar")))))))
     346
     347(define (edit-form-instructions env)
     348  (when (translations-catalog? env)
     349    (let-from-environment env (path return user-input)
     350      (return
     351        (let ((section (user-input 'section stream-null)))
     352          (if (stream-null? section)
     353            (html-stream
     354              (p "You are editing a catalog of translations to " (tt (svnwiki-basename path))
     355                 " ("
     356                 (cadr (or (assoc (string->symbol (svnwiki-basename path)) *languages*) (list #f "Unknown")))
     357                 "):"))
     358            (html-stream
     359              (p "You are editing the " (tt (svnwiki-basename path))
     360                 " ("
     361                 (cadr (or (assoc (string->symbol (svnwiki-basename path)) *languages*) (list #f "Unknown")))
     362                 ")"
     363                 " translation for the string:")
     364              (blockquote (i section)))))))))
     365
     366(svnwiki-extension-define 'edit-form-instructions 'translations edit-form-instructions)
     367
     368(define (translations-hide-title env)
     369  (when (translations-catalog? env)
     370    (let-from-environment env (return)
     371      (return #t))))
     372
     373(svnwiki-extension-define 'edit-form-section-title-hide 'translations translations-hide-title)
     374
     375(define (body-default env)
     376  (when (translations-catalog? env)
     377    (let-from-environment env (return section)
     378      (return (html-stream "== " section "\n\n" section)))))
     379
     380(svnwiki-extension-define 'edit-form-section-body-default 'translations body-default)
Note: See TracChangeset for help on using the changeset viewer.