summaryrefslogtreecommitdiff
path: root/Pancake
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-11-28 07:07:58 +0300
committerdefanor <defanor@uberspace.net>2017-11-28 07:07:58 +0300
commit51146403e0e7b9d49efe8592ac8380f785ce9cf3 (patch)
tree380666e46e05906c586db0b5090ff360235d3b7c /Pancake
parent6d6696fc45013f88c63decab3e53b8ee26dde1b4 (diff)
Introduce initial image support
Pancake reports saved files to Emacs, Emacs inserts them into appropriate positions if they are images; `pancake-load-images' just sends "save" commands for all the images. `pancake-display-hook' was added as well, so that image loading can be requested automatically, among other things. There is a few things to improve: currently the images don't get sliced, there's no caching or parallelization, and no tracking of explicitly requested images.
Diffstat (limited to 'Pancake')
-rw-r--r--Pancake/Command.hs12
-rw-r--r--Pancake/Printing.hs29
2 files changed, 23 insertions, 18 deletions
diff --git a/Pancake/Command.hs b/Pancake/Command.hs
index e0c76f6..028012a 100644
--- a/Pancake/Command.hs
+++ b/Pancake/Command.hs
@@ -109,20 +109,20 @@ pFilePath = do
-- | 'Save' command parser for 'RURI'.
save :: Parser Command
save = Save
- <$> (string "save" *> spaces *> (RURI <$> pURI))
- <*> (spaces *> optionMaybe pFilePath)
+ <$> (string "save" *> space *> (RURI <$> pURI))
+ <*> optionMaybe (space *> pFilePath)
<* eof
-- | 'Save' command parser for 'RNumber'.
saveRef :: String -> Parser Command
saveRef digits = Save
- <$> (string "save" *> spaces *> (RNumber <$> pNumber digits))
- <*> (spaces *> optionMaybe pFilePath) <* eof
+ <$> (string "save" *> space *> (RNumber <$> pNumber digits))
+ <*> optionMaybe (space *> pFilePath) <* eof
-- | 'Save' command parser for 'RCurrent'.
saveCurrent :: Parser Command
-saveCurrent = Save RCurrent <$> (string "save" *> spaces *> char ','
- *> spaces *> optionMaybe pFilePath <* eof)
+saveCurrent = Save RCurrent <$> (string "save" *> space *> char ','
+ *> optionMaybe (space *> pFilePath) <* eof)
-- | 'GoTo' command parser for 'RURI'.
goTo :: Parser Command
diff --git a/Pancake/Printing.hs b/Pancake/Printing.hs
index 8ed38d4..4248ceb 100644
--- a/Pancake/Printing.hs
+++ b/Pancake/Printing.hs
@@ -26,6 +26,7 @@ Renderer output printing facilities.
module Pancake.Printing ( showLines
, putSexpLn
+ , encodeSexpStr
, showSexps
) where
@@ -72,6 +73,15 @@ putSexpLn s = liftIO $ do
putStrLn $ list s
hFlush stdout
+-- | Encodes a string for use in s-expressions.
+encodeSexpStr :: String -> String
+encodeSexpStr s = concat ["\"", concatMap escape s, "\""]
+ where
+ escape '\\' = "\\\\"
+ escape '"' = "\\\""
+ escape '\n' = "\\n"
+ escape other = pure other
+
-- | Prints rendered lines as s-expressions.
showSexps :: MonadIO m => URI -> [RendererOutput] -> m ()
showSexps uri ro =
@@ -82,18 +92,13 @@ showSexps uri ro =
map (list . pure . unwords . map showSexp . mergeStyled)
(rLines ro)
, list $ "identifiers"
- : map (\(i, l) -> list [encodeStr i, show l]) (rIdentifiers ro)
+ : map (\(i, l) -> list [encodeSexpStr i, show l]) (rIdentifiers ro)
, list $ "links"
- : map (\u -> encodeStr $ uriToString id u "") (rLinks ro)
- , list ["uri", ".", encodeStr $ uriToString id uri ""]]
+ : map (\u -> encodeSexpStr $ uriToString id u "") (rLinks ro)
+ , list ["uri", ".", encodeSexpStr $ uriToString id uri ""]]
where
- encodeStr s = concat ["\"", concatMap escape s, "\""]
- escape '\\' = "\\\\"
- escape '"' = "\\\""
- escape '\n' = "\\n"
- escape other = pure other
showSexp :: Styled -> String
- showSexp (Plain s) = encodeStr s
+ showSexp (Plain s) = encodeSexpStr s
showSexp (Fg clr s) = list ["fg", show clr, showSexp s]
showSexp (Bold s) = list ["style", "bold", showSexp s]
showSexp (Underline s) = list ["style", "underline", showSexp s]
@@ -105,9 +110,9 @@ showSexps uri ro =
, showDenotation d
, showSexp s]
showDenotation :: Denotation -> String
- showDenotation (Link u) = list ["link", ".", encodeStr $ show u]
- showDenotation (Image u) = list ["image", ".", encodeStr $ show u]
- showDenotation (Math m) = list ["math", ".", encodeStr m]
+ showDenotation (Link u) = list ["link", ".", encodeSexpStr $ show u]
+ showDenotation (Image u) = list ["image", ".", encodeSexpStr $ show u]
+ showDenotation (Math m) = list ["math", ".", encodeSexpStr m]
showDenotation (Heading l) = list ["heading", ".", show l]
mergeStyled :: [Styled] -> [Styled]