diff --git a/BoundedBSChan.hs b/BoundedBSChan.hs --- a/BoundedBSChan.hs +++ b/BoundedBSChan.hs @@ -10,6 +10,7 @@ -- |Wrapper around `Chan ByteString` which bounds the total size of the -- bytestring in the queue. +-- Handles ^C in interleaved IO by truncating. -- -- WARNING: this is not a general solution, you probably do not want to use -- this in your project! It handles only the simplest case of a single reader @@ -33,10 +34,11 @@ import Control.Concurrent import Control.Monad -import Data.Maybe (fromMaybe) -import System.IO.Unsafe (unsafeInterleaveIO) +import Data.Maybe (fromMaybe) +import System.Console.Haskeline (handleInterrupt) +import System.IO.Unsafe (unsafeInterleaveIO) -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS data BoundedBSChan = BoundedBSChan Int -- ^bound @@ -57,7 +59,7 @@ unless done $ writeBSChan c b readBSChan :: BoundedBSChan -> IO BS.ByteString -readBSChan (BoundedBSChan _ _ rv ch) = do +readBSChan (BoundedBSChan _ _ rv ch) = handleInterrupt (return BS.empty) $ do b <- readChan ch r <- fromMaybe 0 <$> tryTakeMVar rv putMVar rv $ r + BS.length b diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,21 +2,25 @@ This file covers only non-trivial user-visible changes; see the git log for full gory details. -## 0.1.6.1 +# 0.1.7 +* Handle ^C during streaming by truncating the stream +* Always request when going to uris using an identity + +# 0.1.6.1 * Use canonical notBefore (00:00:00 1 Jan 1950) in client certs * Add --prompt option, enabling usual command prompt after -e/-f * Fix query escaping * Fix colouring of wrapped link descriptions being lost when paging * Fix --ghost not affecting queue loading -## 0.1.6 +# 0.1.6 * New command "query" for e.g. convenient use of search engines * Allow IRIs in user input (converted to URIs) * Implement SOCKS5 support (-S and -P options) * Fix bug triggered by /home being a symlink * Fix bug with connecting to literal IPv6 addresses -## 0.1.5 +# 0.1.5 * Align and wrap link lines; add option to print description first * Use reverse video in prompt for added visibility (thanks Ben) * Try all addresses when making connections (thanks rwv) @@ -24,20 +28,20 @@ * Fix X.509 version and use dummy notAfter in generated client certificates * Fix bugs in wrapping and relative link display -## 0.1.4 +# 0.1.4 * Indicate links to cached history items * Retry with full handshake if session resume fails * Recommend trust for new certificate signed by previous certificate * Increase client cert validity to 50y * Make ghost mode even more spectral -## 0.1.3 +# 0.1.3 * Allow trusting certificates just for the current session * Don't require tail certificates to be v3 * Add uri of any request to log, even if request fails * Just show fingerprint of known cert rather than picture -## 0.1.2 +# 0.1.2 * Add @ target modifier for history root * Understand e.g. ~< * Suppress alt text by default diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -VERSION=0.1.6.1 +VERSION=0.1.7 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -16,4 +16,4 @@ programName = "diohsc" version :: String -version = "0.1.6.1" +version = "0.1.7" diff --git a/diohsc.cabal b/diohsc.cabal --- a/diohsc.cabal +++ b/diohsc.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: diohsc -version: 0.1.6.1 +version: 0.1.7 license: GPL-3 license-file: COPYING maintainer: mbays@sdf.org diff --git a/diohsc.hs b/diohsc.hs --- a/diohsc.hs +++ b/diohsc.hs @@ -492,7 +492,8 @@ let scheme = uriScheme uri handled = scheme `elem` ["gemini","file"] || M.member scheme proxies inHistory = isJust $ curr >>= flip pathItemByUri uri - col = if inHistory then BoldBlue else case (isVisited uri,handled) of + activeId = isJust $ idAtUri ais uri + col = if inHistory && not activeId then BoldBlue else case (isVisited uri,handled) of (True,True) -> Yellow (False,True) -> BoldYellow (True,False) -> Red @@ -992,20 +993,23 @@ goHistory i = setCurr i >> showUri (historyUri i) goUri :: Bool -> Maybe HistoryOrigin -> URI -> ClientM () - goUri forceRequest origin uri = dropUriFromQueue uri >> case curr >>= flip pathItemByUri uri of - Just i' | not forceRequest -> goHistory i' - _ -> doRequestUri uri $ \item -> do - maybe (printErr "Bad default action!") ($ item) $ actionOfCommand defaultAction - liftIO . slurpNoisily (historyRequestTime item) . mimedBody $ historyMimedData item - let updateParent i = - -- Lazily recursively update the links in the doubly linked list - let i' = i { historyParent = updateParent . updateChild i' <$> historyParent i } - in i' - updateChild i' i = i { historyChild = setChild <$> historyChild i } - where setChild c = c { childItem = i' } - glueOrigin (HistoryOrigin o l) = updateParent $ o { historyChild = Just $ HistoryChild item' l } - item' = item { historyParent = glueOrigin <$> origin } - setCurr item' + goUri forceRequest origin uri = do + dropUriFromQueue uri + activeId <- gets $ isJust . (`idAtUri` uri) . clientActiveIdentities + case curr >>= flip pathItemByUri uri of + Just i' | not (activeId || forceRequest) -> goHistory i' + _ -> doRequestUri uri $ \item -> do + maybe (printErr "Bad default action!") ($ item) $ actionOfCommand defaultAction + liftIO . slurpNoisily (historyRequestTime item) . mimedBody $ historyMimedData item + let updateParent i = + -- Lazily recursively update the links in the doubly linked list + let i' = i { historyParent = updateParent . updateChild i' <$> historyParent i } + in i' + updateChild i' i = i { historyChild = setChild <$> historyChild i } + where setChild c = c { childItem = i' } + glueOrigin (HistoryOrigin o l) = updateParent $ o { historyChild = Just $ HistoryChild item' l } + item' = item { historyParent = glueOrigin <$> origin } + setCurr item' doRequestUri :: URI -> CommandAction -> ClientM () doRequestUri uri0 action = doRequestUri' 0 uri0