ftranslate.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

' Gambas class file

PRIVATE CONST MODE_NONE AS Integer = 0
PRIVATE CONST MODE_MSGID AS Integer = 1
PRIVATE CONST MODE_MSGSTR AS Integer = 2

PRIVATE CONST TABLE_HEIGHT_MAX AS Integer = 256

PRIVATE $sLang AS String
PRIVATE $sPath AS String
PRIVATE $sHeader AS String
PRIVATE $bModify AS Boolean
PRIVATE $bIgnore AS Boolean
PRIVATE $nTrans AS Integer
PRIVATE $sErrMerge AS String

STATIC PUBLIC SUB Run()

  IF Project.GetClasses().Count = 0 THEN
    Message(("The project is void. There is nothing to translate."))
    RETURN
  ENDIF

  FTranslate.ShowModal

END


PUBLIC SUB _new()

  DIM sLang AS String
  DIM iIndex AS Integer

  WITH cvwTranslate
    .Columns.Count = 3
    .Columns[0].Text = ("Untranslated")
    .Columns[2].Text = ("Comment")
  END WITH

  FOR EACH sLang IN Language.GetAll()
    sLang = Language.ToName(sLang)
    'IF Exist(File.Dir(Project.Path) &/ ".lang" &/ sLang & ".po") THEN
    '  sLang = sLang & "*"
    'ENDIF
    cmbLang.Add(sLang)
  NEXT

  sLang = System.Language
  iIndex = cmbLang.Find(Language.ToName(sLang))
  IF iIndex < 0 THEN iIndex = cmbLang.Find(Language.ToName("fr"))
  cmbLang.Index = cmbLang.Find(Language.ToName(sLang))

END


PRIVATE SUB SetLang(sLang AS String)

  DIM sDir AS String
  DIM sPath AS String
  DIM hFic AS File
  DIM sLig AS String
  DIM bFuzzy AS Boolean
  DIM bHeader AS Boolean
  DIM iMode AS Integer
  DIM sMsgId AS String
  DIM sMsgStr AS String
  DIM sMsgComment AS String
  DIM iIndex AS Integer

  INC Application.Busy

  sDir = Project.Dir &/ ".lang"
  sPath =  sDir &/ sLang & ".po"

  IF NOT Exist(sPath) THEN
    SHELL "cp " & Project.Quote(sDir &/ ".pot") & " " & Project.Quote(sPath) WAIT
  ELSE
    MergeMessage(sPath, "-o " & Project.Quote(sPath & ".new") & " " & Project.Quote(sPath) & " " & Project.Quote(sDir &/ ".pot"))
'     SHELL "msgmerge -o " & Project.Quote(sPath & ".new") & " " & Project.Quote(sPath) & " " & Project.Quote(sDir &/ ".pot") & " > " & Project.Quote(sTemp) & " 2>&1" WAIT
'     IF Exist(sPath & ".new") THEN
'       KILL sPath
'       RENAME sPath & ".new" AS sPath
'     ELSE
'       PRINT "msgmerge -o " & Project.Quote(sPath & ".new") & " " & Project.Quote(sPath) & " " & Project.Quote(sDir &/ ".pot") & " > " & Project.Quote(sTemp) & " 2>&1"
'       PRINT File.Load(sTemp)
'       Error.Raise(("The 'msgmerge' command has failed"))
'     ENDIF
'     TRY KILL sTemp
  ENDIF

  cvwTranslate.Clear
  cvwTranslate.Columns[2].AutoResize = FALSE

  $sHeader = ""

  'PRINT "Loading "; sPath

  OPEN sPath FOR READ AS #hFic

  WHILE NOT Eof(hFic)
    LINE INPUT #hFic, sLig
    IF NOT sLig THEN BREAK
    $sHeader = $sHeader & sLig & "\n"
  WEND

  $bIgnore = TRUE
  $nTrans = 0

  DO

    IF NOT Eof(hFic) THEN

      LINE INPUT #hFic, sLig

      IF Left$(sLig) = "#" THEN

        IF Left$(sLig, 2) = "#:" THEN
          sMsgComment = Trim(Mid$(sLig, 3))
          CONTINUE
        ENDIF

        IF Left$(sLig, 2) = "#," THEN
          IF Instr(sLig, "fuzzy") THEN
            bFuzzy = TRUE
            CONTINUE
          ENDIF
        ENDIF

      ENDIF

      IF Left$(sLig, 6) = "msgid " THEN
        sMsgId = Mid$(sLig, 8, -1)
        iMode = MODE_MSGID
        CONTINUE
      ENDIF

      IF Left$(sLig, 7) = "msgstr " THEN
        sMsgStr = Mid$(sLig, 9, -1)
        iMode = MODE_MSGSTR
        CONTINUE
      ENDIF

      IF Left$(sLig) = Chr$(34) THEN
        IF iMode = MODE_MSGID THEN
          sMsgId = sMsgId & Mid$(sLig, 2, -1)
        ELSE IF iMode = MODE_MSGSTR THEN
          sMsgStr = sMsgStr & Mid$(sLig, 2, -1)
        ENDIF
        CONTINUE
      ENDIF

    ENDIF

    IF Trim(sMsgId) THEN

      INC iIndex

      IF sMsgStr = "-\\n" THEN sMsgStr = "-"

      cvwTranslate.Add(iIndex, sMsgId)
      IF bFuzzy THEN
        bFuzzy = FALSE
      ELSE
        cvwTranslate[iIndex][1] = sMsgStr
        IF sMsgStr THEN INC $nTrans
      ENDIF
      cvwTranslate[iIndex][2] = sMsgComment

      sMsgId = ""
      sMsgComment = ""
      sMsgStr = ""

    ENDIF

    IF Eof(hFic) THEN BREAK

  LOOP

  CLOSE #hFic

  ResizeTable

  cvwTranslate.Columns[1].Text = Language.ToName(sLang)

  DisplayTrans

  txtOrig.Text = ""
  txtTranslate.Text = ""

  $bIgnore = FALSE

  cvwTranslate.MoveFirst
  cvwTranslate.Item.Selected = TRUE

  $sLang = sLang
  $sPath = sPath
  $bModify = FALSE

FINALLY

  DEC Application.Busy

CATCH

  Message.Error(Subst(("Cannot read translation file for language '&1'"), Language.ToName(sLang)) & "\n\n" & Error.Text & $sErrMerge)
  $bIgnore = FALSE

END


PUBLIC SUB btnOK_Click()

  SaveTranslate

  ME.Close

END

PUBLIC SUB cvwTranslate_Select()

  WITH cvwTranslate

    txtOrig.Text = .Current[0]
    $bIgnore = TRUE
    txtTranslate.Text = .Current[1]
    $bIgnore = FALSE
    lblComment.Text = .Current[2]

  END WITH

  txtTranslate.SetFocus

END

PUBLIC SUB txtTranslate_Change()

  DIM nTransOld AS Integer

  IF $bIgnore THEN RETURN

  nTransOld = $nTrans
  IF cvwTranslate.Current[1] THEN DEC $nTrans
  cvwTranslate.Current[1] = txtTranslate.Text
  IF cvwTranslate.Current[1] THEN INC $nTrans

  IF $nTrans <> nTransOld THEN DisplayTrans

  $bModify = TRUE

END


PRIVATE SUB SaveTranslate()

  DIM hFic AS File
  DIM bTrans AS Boolean
  DIM sStr AS String

  IF NOT $sLang THEN RETURN
  'IF NOT bModify THEN RETURN

  INC Application.Busy

  'PRINT "Saving "; $sPath

  OPEN $sPath & ".new" FOR CREATE AS #hFic

  PRINT #hFic, $sHeader

  WITH cvwTranslate

    .MoveFirst()

    WHILE .Available

      sStr = .Item[1]

      IF sStr THEN
        IF Right$(.Item[0], 2) = "\\n" THEN
          IF Right$(sStr, 2) <> "\\n" THEN
            sStr = sStr & "\\n"
          ENDIF
        ENDIF
      ENDIF

      PRINT #hFic,"#: "; .Item[2]
      PRINT #hFic,"msgid "; Quote(.Item[0])
      PRINT #hFic,"msgstr "; Quote(sStr)
      PRINT #hFic

      IF sStr THEN bTrans = TRUE

      .MoveNext()
    WEND

  END WITH

  CLOSE #hFic

  TRY KILL $sPath

  IF bTrans THEN

    RENAME $sPath & ".new" AS $sPath

    SHELL "msgfmt -o " & Project.Quote(Left$($sPath, -3) & ".mo") & " " & Project.Quote($sPath)

  ELSE

    'PRINT "Void translation"

    TRY KILL $sPath & ".new"
    TRY KILL Left$($sPath, -3) & ".mo"

  ENDIF

  $bModify = FALSE

FINALLY

  DEC Application.Busy

CATCH

  Message.Error(("Cannot save translation.") & "\n\n" & Error.Text)

END


PRIVATE FUNCTION Quote(sStr AS String) AS String

  sStr = Replace(sStr, "\n", "")
  sStr = Replace(sStr, "\\" & Chr$(34), "\n")
  sStr = Replace(sStr, Chr$(34), "\\" & Chr$(34))
  sStr = Replace(sStr, "\n", "\\" & Chr$(34))

  RETURN Chr$(34) & sStr & Chr$(34)

END

PUBLIC SUB btnSave_Click()

  SaveTranslate

END

PUBLIC SUB btnCopy_Click()

  'IF NOT txtTranslate.Text THEN
    txtTranslate.Text = txtOrig.Text
  'ENDIF

END

PUBLIC SUB btnFind_Click()

  DIM sStr AS String
  DIM sFind AS String
  DIM sKey AS String

  sFind = LCase(txtFind.Text)
  IF NOT sFind THEN RETURN
  IF cvwTranslate.Count = 0 THEN RETURN

  WITH cvwTranslate

    sKey = .Key

    DO

      .MoveNext()
      IF NOT .Available THEN
        .MoveFirst()
      ENDIF

      sStr = LCase(.Item[0] & "\n" & .Item[1])
      IF Instr(sStr, sFind) THEN
        .Item.EnsureVisible
        .Item.Selected = TRUE
        RETURN
      ENDIF

      IF .Item.Key = sKey THEN
        Message(("Search string cannot be found."))
        RETURN
      ENDIF

    LOOP

  END WITH

END

PUBLIC SUB txtFind_Activate()

  btnFind_Click

END

PUBLIC SUB cmbLang_Click()

  DIM sLang AS String

  SaveTranslate
  sLang = Language.FromName(cmbLang.Text)
  'Project.Config.WriteString("/Language", sLang)
  SetLang(sLang)

END


PUBLIC SUB btnDelete_Click()

  IF Message.Delete(("Do you really want to delete this translation ?"), ("Delete"), ("Cancel")) = 2 THEN RETURN

  WITH cvwTranslate

    .MoveFirst()
    WHILE .Available
      .Item[1] = ""
      .MoveNext()
    WEND

    .MoveFirst()
    .Item.Selected = TRUE
    .Item.EnsureVisible()

  END WITH

  $bModify = TRUE

END

PUBLIC SUB btnOpen_Click()

  DIM sLang AS String

  sLang = FLanguage.Run()
  IF NOT sLang THEN RETURN

  IF sLang = $sLang THEN
    Message(("This is the same translation !"))
    RETURN
  ENDIF

  IF Message.Question(("Do you really want to replace this translation ?"), ("Replace"), ("Cancel")) = 2 THEN RETURN

  'TRY KILL Project.Dir &/ $sLang & ".po"
  SHELL "cp -f " & Project.Quote(Project.Dir &/ ".lang" &/ sLang & ".po") & " " & Project.Quote(Project.Dir &/ ".lang" &/ $sLang & ".po") WAIT

  SetLang($sLang)

END

PUBLIC SUB txtTranslate_KeyPress()

  IF Key.Alt THEN

    WITH cvwTranslate

      IF Key.Code = Key["Up"] THEN
        .MoveTo(.Key)
        .MoveAbove()
        IF .Available THEN
          .Item.Selected = TRUE
          .Item.EnsureVisible()
        ENDIF
      ELSE IF Key.Code = Key["Down"] THEN
        .MoveTo(.Key)
        .MoveBelow()
        IF .Available THEN
          .Item.Selected = TRUE
          .Item.EnsureVisible()
        ENDIF
      ENDIF

    END WITH

  ELSE IF Key.Normal THEN

    IF Key.Code = Key.F3 THEN
      btnFind_Click
    ELSE IF Key.Code = Key.F4 THEN
      btnFindNextUntranslated_Click
    ENDIF

  ENDIF

END

PUBLIC SUB btnUndo_Click()

  IF Message.Question(("Do you really want to reload this translation ?"), ("Reload"), ("Cancel")) = 2 THEN RETURN

  SetLang($sLang)

END

PUBLIC SUB btnClear_Click()

  txtTranslate.Clear

END

PUBLIC SUB btnExport_Click()

  Dialog.Title = ("Export a translation")
  Dialog.Path = System.Home &/ Project.Name & "-" & $sLang & "-" & Project.MajorVersion & "." & Project.MinorVersion & ".po"
  Dialog.Filter = [ ("Translation files") & " (*.po)" ]
  IF Dialog.SaveFile() THEN RETURN

  SaveTranslate
  SHELL "cp -f " & Project.Quote(Project.Dir &/ ".lang" &/ $sLang & ".po") & " " & Project.Quote(Dialog.Path) WAIT

END

PUBLIC SUB btnImport_Click()

  DIM sPath AS String

  Dialog.Title = ("Import a translation")
  Dialog.Path = System.Home
  Dialog.Filter = [ ("Translation files") & " (*.po)", ("All files") & " (*)" ]
  IF Dialog.OpenFile() THEN RETURN

  IF NOT (File.BaseName(Dialog.Path) LIKE (Project.Name & "-" & $sLang & "-*")) THEN
    IF Message.Warning(("Warning ! The translation file does not match the current language."), ("Continue"), ("Cancel")) <> 1 THEN
      RETURN
    ENDIF
  ENDIF

  sPath = Project.Dir &/ ".lang" &/ $sLang & ".po"

  'SHELL "msgmerge -o " & Project.Quote(sPath & ".new") & " " & Project.Quote(Dialog.Path) & " " & Project.Quote(sPath) & " 2>/dev/null" WAIT
  MergeMessage(sPath, "-o " & Project.Quote(sPath & ".new") & " " & Project.Quote(Dialog.Path) & " " & Project.Quote(sPath))
  SetLang($sLang)

'   IF Exist(sPath & ".new") THEN
'     KILL sPath
'     RENAME sPath & ".new" AS sPath
'   ELSE
'     Error.Raise(("The 'msgmerge' command has failed"))
'   ENDIF

CATCH

  Message.Error(("Cannot import translation file.") & "\n\n" & Error.Text & $sErrMerge)

END

PRIVATE FUNCTION GetSymbols(sStr AS String) AS String

  DIM sSym AS String
  DIM iInd AS Integer
  DIM sCar AS String
  DIM bGetNext AS Boolean

  FOR iInd = 1 TO Len(sStr)

    sCar = Mid$(sStr, iInd, 1)
    IF bGetNext THEN
      sSym = sSym & sCar
      bGetNext = FALSE
    ELSE IF Asc(sCar) < 128 THEN
      IF Instr("abcdefghijklmnopqrstuvwxyz- ',;:", LCase(sCar)) = 0 THEN
        sSym = sSym & sCar
        IF sCar = "\\" THEN bGetNext = TRUE
      ENDIF
    ENDIF

  NEXT

  RETURN sSym

END


PUBLIC SUB btnVerify_Click()

  DIM sKey AS String
  DIM sOrig AS String
  DIM sTrans AS String

  IF NOT cvwTranslate.Key THEN RETURN

  WITH cvwTranslate

    sKey = .Key

    DO

      IF .Item[1] THEN
        IF .Item[1] <> "-" THEN

          IF GetSymbols(.Item[0]) <> GetSymbols(.Item[1]) THEN
            .Item.EnsureVisible
            .Item.Selected = TRUE
            Message(("Translated string symbols do not match untranslated string ones."))
            RETURN
          ENDIF

        ENDIF
      ENDIF

      .MoveNext()
      IF NOT .Available THEN
        .MoveFirst()
      ENDIF

      IF .Item.Key = sKey THEN
        Message(("Everything seems to be correct."))
        RETURN
      ENDIF

    LOOP

  END WITH

END

PUBLIC SUB btnDoNotTranslate_Click()

  txtTranslate.Text = "-"

END

PRIVATE SUB DisplayTrans()

  lblInfo.Text = Subst(("&1 strings (&2 not translated) - &3 % done"), cvwTranslate.Count, cvwTranslate.Count - $nTrans, $nTrans * 100 \ cvwTranslate.Count)
  btnFindNextUntranslated.Enabled = cvwTranslate.Count - $nTrans

END

PUBLIC SUB Form_Resize()

  DIM H AS Integer
  DIM D AS Integer

  D = ME.ClientH - cvwTranslate.Y - 120

  H = (D - TABLE_HEIGHT_MAX) \ 2
  IF H < 48 THEN
    cvwTranslate.H = D - 48 * 2
    H = (D - cvwTranslate.H) \ 2
  ELSE
    cvwTranslate.H = TABLE_HEIGHT_MAX
  ENDIF

  cvwTranslate.W = ME.ClientW - 16
  ResizeTable

  lblOrig.Move(8, cvwTranslate.Y + cvwTranslate.H + 8)
  lblComment.Move(lblOrig.X + lblOrig.W, lblOrig.Y)
  lblComment.W = ME.ClientW - lblComment.X - 8
  txtOrig.Move(8, lblOrig.Y + lblOrig.H, cvwTranslate.W, H)

  panTranslate.Move(ME.ClientW - panTranslate.W, txtOrig.Y + txtOrig.H + 8)
  lblTranslation.Y = panTranslate.Y + 8
  txtTranslate.Move(8, lblTranslation.Y + lblTranslation.H, cvwTranslate.W, H)
  lblInfo.Y = ME.ClientH - lblInfo.H - 8
  btnOK.Move(ME.CLientW - btnOK.W - 8, ME.CLientH - btnOK.H - 8)


END

PRIVATE SUB ResizeTable()

  WITH cvwTranslate
    .Columns[0].Width = .ClientW \ 2
    .Columns[1].Width = .ClientW - .Columns[0].Width '- 16
    .Columns[2].Width = 0 ' = TRUE
    '.Columns.Adjust
  END WITH

END

PUBLIC SUB btnFindNextUntranslated_Click()

  DIM sKey AS String

  WITH cvwTranslate

    sKey = .Key

    DO

      .MoveNext()
      IF NOT .Available THEN
        .MoveFirst()
      ENDIF

      IF NOT .Item[1] THEN
        .Item.EnsureVisible
        .Item.Selected = TRUE
        RETURN
      ENDIF

      IF .Item.Key = sKey THEN RETURN

    LOOP

  END WITH

END

PRIVATE SUB MergeMessage(sPath AS String, sOption AS String)

  DIM sTemp AS String
  DIM sErr AS String

  sTemp = Temp$

  SHELL "msgmerge " & sOption & " > " & Project.Quote(sTemp) & " 2>&1" WAIT
  IF Exist(sPath & ".new") THEN
    KILL sPath
    RENAME sPath & ".new" AS sPath
    $sErrMerge = ""
    TRY KILL sTemp
  ELSE
    'PRINT "msgmerge -o " & sOption
    $sErrMerge = "\n\n" & Conv(File.Load(sTemp), System.Charset, Desktop.Charset)
    TRY KILL sTemp
    Error.Raise(("The 'msgmerge' command has failed"))
  ENDIF

END

PUBLIC SUB Form_Close()

  IF $bModify THEN
    SaveTranslate
  ENDIF

END