X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Main.hs;h=53ea09d136ceae2f5b56a8de29f2d0f62985e53e;hb=267658a1fd09986a654a1750eaf3ae995fb7dab4;hp=2aa225ead5154a711fbbc957f3036ad552c0abda;hpb=fd788a2053b4f32bd80d002329d64272af23759d;p=yawbih.git

diff --git a/Main.hs b/Main.hs
index 2aa225e..53ea09d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -56,6 +56,16 @@ showPage db key = do
 				p $ tt $ text $ "Last edited: "++date
 		footer db key
 
+showLatex db key = do
+	s <- io $ getCurrent db key 
+	standardQuery key $ do
+		case s of
+			Nothing -> text "No text added for this keyword"
+			Just (full, date) -> do
+				parseLatex full	
+				p $ tt $ text $ "Last edited: "++date
+		footer db key
+
 parseText full = case parse wikiParser "" full of
 	Right n -> toWash n	
 	Left e -> do
@@ -63,12 +73,19 @@ parseText full = case parse wikiParser "" full of
 		text (show e)
 		p $ text full
 
+parseLatex full = case parse wikiParser "" full of
+	Right n -> pre $ text $ toLatex n	
+	Left e -> do
+		text "PARSE ERROR: "
+		text (show e)
+
 footer db key = do
 	hr empty
 	table $ tr $ do
 		td $ submitLink0 (showPage db "itproj3") (text "Back to main page")
 		when (e key) $ td $ submitLink0 (editPage db key) (text "Edit this keyword")
 		when (e key) $ td $ submitLink0 (listRevs db key) (text "List old versions")
+		when (e key) $ td $ submitLink0 (showLatex db key) (text "Output latex")
 		td $ submitLink0 (listKeywords db) (text "List all keywords")
 		td $ text "Keyword: " 
 		td $ activate (showPage db) textInputField empty
@@ -128,20 +145,8 @@ toWash ((Text s):xs) = do
 toWash ((Link l d):xs) = do
 	hlink (URL {unURL = ("wiki?"++l)}) (text d)
 	toWash xs
-toWash ((Bold d):xs) = do
-	b (toWash d)
-	toWash xs
-toWash ((Emph d):xs) = do
-	em (toWash d)
-	toWash xs
-toWash ((Mono d):xs) = do
-	tt (toWash d)
-	toWash xs
-toWash ((Underline d):xs) = do
-	u (toWash d)
-	toWash xs
-toWash ((Strike d):xs) = do
-	strike (toWash d)
+toWash ((Font o d):xs) = do
+	fontOp o (toWash d)
 	toWash xs
 toWash ((Heading n d):xs) = do
 	heading n $ toWash d
@@ -162,6 +167,12 @@ listType False = ul
 stripMailto ('m':'a':'i':'l':'t':'o':':':xs) = xs
 stripMailto xs = xs
 
+fontOp Bold = b
+fontOp Emph = em
+fontOp Mono = tt
+fontOp Underline = u
+fontOp Strike = strike
+
 heading 1 = h1
 heading 2 = h2
 heading 3 = h3