diff options
| -rw-r--r-- | Pancake.hs | 12 | ||||
| -rw-r--r-- | Pancake/Command.hs | 12 | ||||
| -rw-r--r-- | Pancake/Printing.hs | 29 | ||||
| -rw-r--r-- | README | 7 | ||||
| -rw-r--r-- | pancake.el | 61 |
5 files changed, 93 insertions, 28 deletions
@@ -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] @@ -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 -------- @@ -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'.") |