summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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 ()