From 51146403e0e7b9d49efe8592ac8380f785ce9cf3 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Tue, 28 Nov 2017 07:07:58 +0300
Subject: 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.
---
 Pancake/Command.hs  | 12 ++++++------
 Pancake/Printing.hs | 29 +++++++++++++++++------------
 2 files changed, 23 insertions(+), 18 deletions(-)

(limited to 'Pancake')

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]
-- 
cgit v1.2.3