diff --git a/lib/resource/scandinavian/SyntaxScand.gf b/lib/resource/scandinavian/SyntaxScand.gf index cac9050a3..f67166720 100644 --- a/lib/resource/scandinavian/SyntaxScand.gf +++ b/lib/resource/scandinavian/SyntaxScand.gf @@ -754,7 +754,7 @@ oper love ; reflTransVerb : TransVerb -> VerbGroup = \se -> - useVerb se (\\_,n,p => se.s1 ++ {-strPrep-} se.s2 ++ reflPron n p) ; + useVerb se (\\_,n,p => {-strPrep-} se.s2 ++ reflPron n p) ; reflPron : Number -> Person -> Str ; @@ -771,7 +771,7 @@ oper DitransVerb -> NounPhrase -> NounPhrase -> VerbGroup = \ge,dig,vin -> useVerb ge - (\\_,_,_ => ge.s1 ++ ge.s2 ++ dig.s ! PAcc ++ ge.s3 ++ vin.s ! PAcc) ; + (\\_,_,_ => ge.s2 ++ dig.s ! PAcc ++ ge.s3 ++ vin.s ! PAcc) ; -- Adjective-complement ditransitive verbs. @@ -784,7 +784,7 @@ oper DitransAdjVerb -> NounPhrase -> AdjPhrase -> VerbGroup = \gor,dig,sur -> useVerb gor - (\\_,_,_ => gor.s1 ++ {-strPrep-} gor.s2 ++ dig.s ! PAcc ++ + (\\_,_,_ => {-strPrep-} gor.s2 ++ dig.s ! PAcc ++ sur.s ! predFormAdj dig.g dig.n ! Nom) ; complAdjVerb : @@ -1011,20 +1011,20 @@ oper SentenceVerb : Type = Verb ; complSentVerb : SentenceVerb -> Sentence -> VerbGroup = \se,duler -> - useVerb se (\\_,_,_ => se.s1 ++ optStr infinAtt ++ duler.s ! Sub) ; + useVerb se (\\_,_,_ => optStr infinAtt ++ duler.s ! Sub) ; complQuestVerb : SentenceVerb -> QuestionSent -> VerbGroup = \se,omduler -> - useVerb se (\\_,_,_ => se.s1 ++ omduler.s ! IndirQ) ; + useVerb se (\\_,_,_ => omduler.s ! IndirQ) ; complDitransSentVerb : TransVerb -> NounPhrase -> Sentence -> VerbGroup = \sa,honom,duler -> useVerb sa - (\\_,_,_ => sa.s1 ++ {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ optStr infinAtt ++ duler.s ! Main) ; + (\\_,_,_ => {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ optStr infinAtt ++ duler.s ! Main) ; complDitransQuestVerb : TransVerb -> NounPhrase -> QuestionSent -> VerbGroup = \sa,honom,omduler -> useVerb sa - (\\_,_,_ => sa.s1 ++ {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ omduler.s ! IndirQ) ; + (\\_,_,_ => {-strPrep-} sa.s2 ++ honom.s ! PAcc ++ omduler.s ! IndirQ) ; --3 Verb-complement verbs -- @@ -1038,14 +1038,12 @@ oper complVerbVerb : VerbVerb -> VerbPhrase -> VerbGroup = \vilja, simma -> useVerb vilja (\\g,n,p => - vilja.s1 ++ if_then_Str vilja.isAux [] infinAtt ++ ---- vilja.s3 ++ simma.s ! VIInfinit ! g ! n ! p) ; transVerbVerb : VerbVerb -> TransVerb -> TransVerb = \vilja,hitta -> {s = vilja.s ; - s1 = vilja.s1 ++ - if_then_Str vilja.isAux [] infinAtt ++ ---- vilja.s3 ++ + s1 = if_then_Str vilja.isAux [] infinAtt ++ ---- vilja.s3 ++ hitta.s ! VI (Inf Act) ++ hitta.s1 ; s2 = hitta.s2 } ; @@ -1065,7 +1063,7 @@ oper Bool -> DitransVerbVerb -> NounPhrase -> VerbPhrase -> VerbGroup = \obj,be,dig,simma -> useVerb be - (\\g,n,p => be.s1 ++ {-strPrep-} be.s2 ++ dig.s ! PAcc ++ be.s3 ++ + (\\g,n,p => {-strPrep-} be.s2 ++ dig.s ! PAcc ++ be.s3 ++ if_then_Str obj (simma.s ! VIInfinit ! dig.g ! dig.n ! dig.p) (simma.s ! VIInfinit ! g ! n ! p) @@ -1098,14 +1096,13 @@ oper slashTransVerb : NounPhrase -> TransVerb -> ClauseSlashNounPhrase = \jag, se -> - predVerbGroupClause jag (useVerb se (\\_,_,_ => se.s1)) ** {s2 = se.s2} ; + predVerbGroupClause jag (useVerb se (\\_,_,_ => [])) ** {s2 = se.s2} ; --- this does not give negative or anterior forms slashVerbVerb : NounPhrase -> VerbVerb -> TransVerb -> ClauseSlashNounPhrase = \jag,vilja,se -> predVerbGroupClause jag (useVerb vilja (\\g,n,p => - vilja.s1 ++ if_then_Str vilja.isAux [] infinAtt ++ ---- vilja.s3 ++ se.s ! VI (Inf Act)) ) ** {s2 = se.s2} ; diff --git a/lib/resource/swedish/SyntaxSwe.gf b/lib/resource/swedish/SyntaxSwe.gf index 9b478e81c..554604341 100644 --- a/lib/resource/swedish/SyntaxSwe.gf +++ b/lib/resource/swedish/SyntaxSwe.gf @@ -11,7 +11,15 @@ instance SyntaxSwe of SyntaxScand = TypesSwe ** oper - npMan : NounPhrase = nameNounPhrase (mkProperName "man" (NUtr Masc)) ; + npMan : NounPhrase = { + s = table { + PNom => "man" ; + PAcc => "en" ; + PGen _ => "ens" + } ; + g = Utr ; n = Sg ; p = P3 + } ; + npDet : NounPhrase = nameNounPhrase (mkProperName "det" NNeutr) ; mkAdjForm : Species -> Number -> NounGender -> AdjFormPos = \b,n,g -> diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs index 8419038b6..9f7315c56 100644 --- a/src/GF/Shell/CommandL.hs +++ b/src/GF/Shell/CommandL.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/24 11:46:36 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.14 $ +-- > CVS $Date: 2005/03/10 11:14:11 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.15 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -77,13 +77,19 @@ getCommand = do -- | decodes UTF8 if u==False, i.e. if the grammar does not use UTF8; -- used in the Java GUI, which always uses UTF8 -getCommandUTF :: Bool -> IO Command +getCommandUTF :: Bool -> IO (String,Command) getCommandUTF u = do s <- getLine - return $ pCommand $ if u then s else decodeUTF8 s + return $ pCommandMsg $ if u then s else decodeUTF8 s pCommand :: String -> Command -pCommand = pCommandWords . words where +pCommand = snd . pCommandMsg + +pCommandMsg :: String -> (String,Command) +pCommandMsg s = (m,pCommandWords $ words c) where + (m,c) = case s of + '[':s2 -> let (a,b) = span (/=']') s2 in (a,drop 1 b) + _ -> ("",s) pCommandWords s = case s of "n" : cat : _ -> CNewCat cat "t" : ws -> CNewTree $ unwords ws diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index 7dc93a4fe..03cd7cbe2 100644 --- a/src/GF/Shell/Commands.hs +++ b/src/GF/Shell/Commands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/24 11:46:36 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.35 $ +-- > CVS $Date: 2005/03/10 11:14:11 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.36 $ -- -- temporary hacks for GF 2.0 -- @@ -449,9 +449,10 @@ displaySStateIn env state = (tree',msg,menu) where separ = singleton . map unlines . intersperse [replicate 72 '*'] -- | the Boolean is a temporary hack to have two parallel GUIs -displaySStateJavaX :: Bool -> CEnv -> SState -> String -displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $ - unlines $ tagXML "gfedit" $ concat [ +displaySStateJavaX :: Bool -> CEnv -> SState -> String -> String +displaySStateJavaX isNew env state m = encodeUTF8 $ mkUnicode $ + unlines $ tagXML "gfedit" $ concat [ + if null m then [] else tagXML "hmsg" [m], tagXML "linearizations" (concat [tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]), tagXML "tree" tree, diff --git a/src/GF/Shell/JGF.hs b/src/GF/Shell/JGF.hs index 9404ababc..e3438a33c 100644 --- a/src/GF/Shell/JGF.hs +++ b/src/GF/Shell/JGF.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/24 11:46:37 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.10 $ +-- > CVS $Date: 2005/03/10 11:14:11 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.11 $ -- -- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001 ----------------------------------------------------------------------------- @@ -43,20 +43,20 @@ sessionLineJ isNew env = do -- the Boolean is a temporary hack to have two parallel GUIs editLoopJnewX :: Bool -> CEnv -> SState -> IO () editLoopJnewX isNew env state = do - c <- getCommandUTF (isCEnvUTF8 env state) ---- + (m,c) <- getCommandUTF (isCEnvUTF8 env state) ---- case c of CQuit -> return () c -> do (env',state') <- execCommand env c state - let inits = initAndEditMsgJavaX isNew env' state' + let inits = initAndEditMsgJavaX isNew env' state' m let package = case c of CCEnvImport _ -> inits CCEnvEmptyAndImport _ -> inits CCEnvOpenTerm _ -> inits CCEnvOpenString _ -> inits CCEnvEmpty -> initEditMsgJavaX env' - _ -> displaySStateJavaX isNew env' state' + _ -> displaySStateJavaX isNew env' state' m putStrLnFlush package editLoopJnewX isNew env' state' @@ -74,6 +74,6 @@ initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $ (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)] -initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -initAndEditMsgJavaX isNew env state = - initEditMsgJavaX env ++++ displaySStateJavaX isNew env state +initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -> String +initAndEditMsgJavaX isNew env state m = + initEditMsgJavaX env ++++ displaySStateJavaX isNew env state m