summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Shell/SubShell.hs
blob: 5ef0459e5485be3a8718906d4f92086af4fbe560 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
----------------------------------------------------------------------
-- |
-- Module      : SubShell
-- Maintainer  : AR
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:46:12 $ 
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.9 $
--
-- (Description of the module)
-----------------------------------------------------------------------------

module GF.Shell.SubShell where

import GF.Data.Operations
import GF.Infra.UseIO
import GF.Compile.ShellState
import GF.Infra.Option
import GF.API

import GF.Shell.CommandL
import GF.System.ArchEdit

import Data.List

-- AR 20/4/2000 -- 12/11/2001

editSession :: Options -> ShellState -> IO ()
editSession opts st
  | oElem makeFudget opts = fudlogueEdit font st'
  | otherwise             = initEditLoop st' (return ())
 where
   st'   = addGlobalOptions opts st
   font  = maybe myUniFont mkOptFont $ getOptVal opts useFont

myUniFont :: String
myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1"

mkOptFont :: String -> String
mkOptFont = id

translateSession :: Options -> ShellState -> IO ()
translateSession opts st = do
  let grs   = allStateGrammars st
      cat   = firstCatOpts opts (firstStateGrammar st)
      trans s = unlines $ 
                if oElem showLang opts then 
                  sort $ [l +++ ":" +++ s | (l,s) <- zip (map (prIdent . cncId) grs) 
                                                     (translateBetweenAll grs cat s)]
                  else translateBetweenAll grs cat s
  translateLoop opts trans

translateLoop :: Options -> (String -> String) -> IO ()
translateLoop opts trans = do
  let fud  = oElem makeFudget opts
      font = maybe myUniFont mkOptFont $ getOptVal opts useFont
  if fud then fudlogueWrite font trans else loopLine
 where
   loopLine = do
     putStrFlush "trans> "
     s <- getLine
     if s == "." then return () else do
       putStrLnFlush $ trans s
       loopLine