summaryrefslogtreecommitdiffstats
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
parent6d6696fc45013f88c63decab3e53b8ee26dde1b4 (diff)
downloadpancake-51146403e0e7b9d49efe8592ac8380f785ce9cf3.zip
pancake-51146403e0e7b9d49efe8592ac8380f785ce9cf3.tar.gz
pancake-51146403e0e7b9d49efe8592ac8380f785ce9cf3.tar.bz2
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.
-rw-r--r--Pancake.hs12
-rw-r--r--Pancake/Command.hs12
-rw-r--r--Pancake/Printing.hs29
-rw-r--r--README7
-rw-r--r--pancake.el61
5 files changed, 93 insertions, 28 deletions
diff --git a/Pancake.hs b/Pancake.hs
index 74990fa..0c9db1e 100644
--- a/Pancake.hs
+++ b/Pancake.hs
@@ -179,6 +179,7 @@ goTo t u' = do
command :: MonadIO m => Command -> StateT LoopState m ()
command (Save (RURI uri') p) = do
(uri, mraw) <- loadRaw uri'
+ st <- get
case mraw of
Nothing -> pure ()
Just (raw, euri, _) -> liftIO $ do
@@ -202,10 +203,15 @@ command (Save (RURI uri') p) = do
targetFileName = fromMaybe remoteFileName mTargetName
targetPath = targetDir </> targetFileName
e <- try $ BS.writeFile targetPath raw
- putErrLn $ unwords $ case e of
+ case e of
Left (err :: SomeException) ->
- ["Failed to write", targetPath ++ ":", show err]
- Right _ -> ["Saved", remoteURIStr, "as", targetPath]
+ putErrLn $ unwords ["Failed to write", targetPath ++ ":", show err]
+ Right () -> do
+ when (embedded st) $
+ putSexpLn [ "saved"
+ , encodeSexpStr $ uriToString id uri' ""
+ , encodeSexpStr targetPath]
+ putErrLn $ unwords ["Saved", remoteURIStr, "as", targetPath]
where
escapeURI c
| isPathSeparator c = '-'
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]
diff --git a/README b/README
index c7c10f8..0c39678 100644
--- a/README
+++ b/README
@@ -45,6 +45,13 @@ your default emacs browser::
(require 'pancake)
(setq browse-url-browser-function 'pancake-browse-url)
+To load and show all images automatically (not just after saving them
+manually)::
+
+ (add-hook 'pancake-display-hook 'pancake-load-images)
+
+Though it might be desirable to write a wrapper to only show those on
+specific websites, e.g. webcomics, and perhaps specific images only.
Commands
--------
diff --git a/pancake.el b/pancake.el
index d217c4a..443b62a 100644
--- a/pancake.el
+++ b/pancake.el
@@ -100,6 +100,12 @@
(defcustom pancake-command '("pancake" "--embedded")
"A command that runs pancake, along with its arguments"
+ :type '(list string)
+ :group 'pancake)
+
+(defcustom pancake-display-hook nil
+ "Hook run after displaying a page in pancake."
+ :type 'hook
:group 'pancake)
(defvar pancake-buffers '()
@@ -175,7 +181,8 @@
(defun pancake-button-action (button)
"An action to be invoked on button activation."
- (funcall 'browse-url (button-get button 'pancake-uri)))
+ (funcall 'browse-url (or (button-get button 'pancake-link)
+ (button-get button 'pancake-image))))
(defun pancake-print-elem (element)
"Translate ELEMENT into a string."
@@ -204,16 +211,14 @@
(`(denotation (link . ,uri) . ,rest)
(pancake-print-line rest)
(make-text-button start (point)
- 'pancake-uri uri
- 'pancake-type 'link
+ 'pancake-link uri
'help-echo uri
'follow-link t
'action #'pancake-button-action))
(`(denotation (image . ,uri) . ,rest)
(pancake-print-line rest)
(make-text-button start (point)
- 'pancake-uri uri
- 'pancake-type 'image
+ 'pancake-image uri
'help-echo uri
'follow-link t
'action #'pancake-button-action))
@@ -240,6 +245,42 @@ the list's `car' if it is already present."
pancake-uri-history))
history-length)))
+(defun pancake-traverse-image-buttons (function)
+ "Traverse image buttons, applying FUNCTION to each. The
+function arguments must be a button and its pancake-image
+property. Returns a list of collected values."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (ret nil)
+ (btn (next-button (point) t)))
+ (while btn
+ (let ((btn-image (button-get btn 'pancake-image)))
+ (goto-char btn)
+ (when btn-image
+ (push (apply function (list btn btn-image)) ret)))
+ (setq btn (next-button (point))))
+ (reverse ret))))
+
+(defun pancake-insert-image (uri path)
+ "Inserts a saved image."
+ (pancake-traverse-image-buttons
+ (lambda (btn btn-image)
+ (when (string-equal btn-image uri)
+ (let ((img (create-image path)))
+ ;; todo: might be better to slice images, but it seems to be
+ ;; a bit glitchy and breaks line numbering. Handling local
+ ;; references completely in emacs would help with the latter.
+ (insert-image img))))))
+
+(defun pancake-load-images ()
+ "Requests all the images to be loaded."
+ (interactive)
+ (mapc (lambda (uri) (pancake-process-send (concat "save " uri)))
+ (seq-uniq (pancake-traverse-image-buttons
+ (lambda (btn btn-image) btn-image))
+ 'string-equal)))
+
(defun pancake-process-filter (proc string)
"Pancake process filter for stdout."
(when (buffer-live-p (process-buffer proc))
@@ -261,8 +302,13 @@ the list's `car' if it is already present."
(dolist (line (alist-get 'lines alist))
(pancake-print-line line)
(newline))
- (goto-char (point-min))))
- (`(goto ,line) (goto-line line))))))
+ (goto-char (point-min)))
+ (run-hooks 'pancake-display-hook))
+ (`(goto ,line) (goto-line line))
+ ;; todo: check if the images were requested
+ ;; explicitly, don't just show all the images that get
+ ;; saved
+ (`(saved ,uri ,path) (pancake-insert-image uri path))))))
(setq pancake-process-output "")))))
(defun pancake-process-stderr-filter (proc string)
@@ -410,6 +456,7 @@ it to `pancake-process' as input."
(define-key map (kbd "F") 'pancake-go-forward)
(define-key map (kbd "Q") 'pancake-quit)
(define-key map (kbd "R") 'pancake-reload)
+ (define-key map (kbd "I") 'pancake-load-images)
map)
"Keymap for `pancake-mode'.")