summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-14 19:21:27 +0300
committerdefanor <defanor@uberspace.net>2017-12-14 19:21:27 +0300
commitb58e342bf414e869bf772fb3a38691fa4a604978 (patch)
treed6b057c6f6252a60a882f5f4703d5b20cfbd0fa0
parente1151532a46a7ce2c59a8bc86088063cb03c4438 (diff)
downloadpancake-b58e342bf414e869bf772fb3a38691fa4a604978.zip
pancake-b58e342bf414e869bf772fb3a38691fa4a604978.tar.gz
pancake-b58e342bf414e869bf772fb3a38691fa4a604978.tar.bz2
Add the "set width" command
This is mostly needed for embedding, since there doesn't seem to be any practical (let alone portable) standard way to notify pancake of emacs window size changes. In pancake.el, width adjustment is now getting done automatically whenever any other command gets issued.
-rw-r--r--Pancake.hs6
-rw-r--r--Pancake/Command.hs12
-rw-r--r--README1
-rw-r--r--pancake.12
-rw-r--r--pancake.el13
5 files changed, 30 insertions, 4 deletions
diff --git a/Pancake.hs b/Pancake.hs
index 129585d..5d49b1a 100644
--- a/Pancake.hs
+++ b/Pancake.hs
@@ -74,6 +74,7 @@ data LoopState = LS { history :: Sliding (URI, P.Pandoc)
, embedded :: Bool
, interrupted :: Bool
, unclutterRegexps :: [(Regex, String)]
+ , columns :: Maybe Int
}
-- | Renders a parsed document.
@@ -81,7 +82,7 @@ printDoc :: MonadIO m => URI -> P.Pandoc -> StateT LoopState m ()
printDoc uri doc = do
term <- liftIO setupTermFromEnv
st <- get
- let cols = fromMaybe 80 $ getCapability term termColumns
+ let cols = fromMaybe 80 $ columns st <|> getCapability term termColumns
l = renderDoc cols (conf st) doc
textLines = rLines l
modify (\s -> s { rendered = l })
@@ -315,6 +316,7 @@ command Quit = liftIO $ do
when exists $ removeDirectoryRecursive dir
command Interrupt =
putErrLn "Received SIGINT. Interrupt twice in a row to quit."
+command (SetWidth w) = modify $ \s -> s { columns = w }
-- | Reads commands, runs them.
eventLoop :: MonadIO m => StateT LoopState m ()
@@ -353,7 +355,7 @@ main = do
tid <- myThreadId
_ <- installHandler sigINT (Catch (throwTo tid UserInterrupt)) Nothing
let run e = runStateT (updateConfig >> eventLoop)
- (LS ([],[]) 0 [] def e False [])
+ (LS ([],[]) 0 [] def e False [] Nothing)
>> pure ()
case getOpt Permute options args of
([], [], []) -> run False
diff --git a/Pancake/Command.hs b/Pancake/Command.hs
index c385dc2..5126146 100644
--- a/Pancake/Command.hs
+++ b/Pancake/Command.hs
@@ -60,6 +60,7 @@ data Command = Quit
| ShowCurrent
| Shortcut String String
| ReloadConfig
+ | SetWidth (Maybe Int)
deriving (Show, Eq)
-- | Parses a user command.
@@ -141,6 +142,16 @@ shortcut m = do
q <- manyTill anyChar eof
pure $ Shortcut u q
+-- | A natural numbers parser.
+pNat :: Read i => Parser i
+pNat = read <$> many1 digit
+
+-- | 'SetWidth' command parser.
+setWidth :: Parser Command
+setWidth = string "set width"
+ *> (SetWidth <$> optionMaybe (spaces *> pNat))
+ <* eof
+
-- | Command parser.
command :: Config -> Parser Command
command c =
@@ -152,5 +163,6 @@ command c =
, saveRef (referenceDigits c) <?> "save ref"
, saveCurrent <?> "save current"
, save <?> "save"
+ , setWidth <?> "set width"
, goTo <?> "follow uri"
])
diff --git a/README b/README
index 92d7240..7cabedf 100644
--- a/README
+++ b/README
@@ -73,6 +73,7 @@ Commands
:save ,[ <path>]: save current document
:<shortcut> <query>: run a query using a shortcut defined in the
configuration (e.g., search)
+:set width[ <columns>]: set terminal/window width manually
pancake-mode provides additional aliases and commands, see built-in
emacs documentation (``C-h m``) for those.
diff --git a/pancake.1 b/pancake.1
index 66b038f..f5daeaf 100644
--- a/pancake.1
+++ b/pancake.1
@@ -57,6 +57,8 @@ save current document
.IP "\fIshortcut\fR \fIquery\fR"
run a query using a shortcut defined in the configuration (e.g.,
search)
+.IP "\fBset width\fR[ \fIcolumns\fR]"
+set terminal/window width manually
.SH DEFAULT SHORTCUTS
.IP "\fBg\fR"
diff --git a/pancake.el b/pancake.el
index 98aab6d..6429f67 100644
--- a/pancake.el
+++ b/pancake.el
@@ -174,8 +174,7 @@ if no URL is provided."
(current-buffer)
(car pancake-buffers))))
(with-current-buffer buffer
- (when url
- (process-send-string pancake-process (concat url "\n")))
+ (when url (pancake-process-send url))
(display-buffer (current-buffer)))))
(defun pancake-translate-color (name attr)
@@ -356,8 +355,18 @@ property. Returns a list of collected values."
(interactive)
(funcall (pancake-input (gui-get-primary-selection))))
+(defun pancake-width-adjust (&optional width)
+ "Sets the width (in columns) that the pancake process should
+use. Current window width is used if none is provided."
+ (interactive)
+ ;; Not using `pancake-process-send' here, since it itself would call
+ ;; this function.
+ (process-send-string pancake-process
+ (format "set width %d\n" (or width (window-width)))))
+
(defun pancake-process-send (line)
"Send LINE to the pancake process."
+ (pancake-width-adjust)
(process-send-string pancake-process (concat line "\n")))
(defun pancake-go-backward ()