diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +This file covers only non-trivial user-visible changes; +see the git log for full gory details. + +## 0.1.2 +- Add @ target modifier for history root +- Understand e.g. ~< +- Suppress alt text by default +- Fix: uri quoting for queries and file:// was incorrect +- Fix: queue was not appended to on exit in non-interactive mode diff --git a/Command.hs b/Command.hs --- a/Command.hs +++ b/Command.hs @@ -164,6 +164,7 @@ , " > , {-forward} : location of which base is the origin (if any)" , " ] : link after \">\"" , " [ : link before \">\"" + , " @ : root of base (i.e. recursive origin)" , " The \"origin\" of a location reached via a link is the link's source." , " Similarly for relative URIs. Other locations have no origin." , "" @@ -177,6 +178,7 @@ , " 7 : Go to link 7 from B. Call this location C." , " <<] : Go to link 4 from 'ex?foo. C is now set as the jump mark \"''\"." , " ''<] : Go to link 8 from B." + , " @/bar : Go to `ex/bar" , "" , "Numbered, range, and search targets:" , " The specifiers \"$\", \"~\", \"<\", \">\", \"[\" and \"]\" all accept" diff --git a/CommandLine.hs b/CommandLine.hs --- a/CommandLine.hs +++ b/CommandLine.hs @@ -75,6 +75,7 @@ | PTargetAbs String | PTargetLog ElemsSpecs | PTargetQueue ElemsSpecs + | PTargetRoot PTarget | PTargetAncestors PTarget ElemsSpecs | PTargetDescendants PTarget ElemsSpecs | PTargetChild @@ -184,7 +185,8 @@ targetMod :: Parser (PTarget -> PTarget) targetMod = choice - [ flip PTargetAncestors <$> elemsSpecsBy (string "<") + [ char '@' >> return PTargetRoot + , flip PTargetAncestors <$> elemsSpecsBy (string "<") , flip PTargetDescendants <$> elemsSpecsBy (string ">") , flip (PTargetChild True False) <$> elemsSpecsBy (string "]") , flip (PTargetChild True True) <$> elemsSpecsBy (string "}") diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -VERSION=0.1.1 +VERSION=0.1.2 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa diff --git a/Request.hs b/Request.hs --- a/Request.hs +++ b/Request.hs @@ -17,7 +17,7 @@ import Safe (lastMay, readMay) import System.FilePath (FilePath) -import URI (URI, escapeUriString, nullUri, parseAbsoluteUri) +import URI (URI, escapePathString, nullUri, parseAbsoluteUri) data Host = Host {hostName :: String, hostPort :: Int} deriving (Eq,Ord,Show) @@ -40,4 +40,4 @@ requestUri :: Request -> URI requestUri (NetworkRequest _ uri) = uri requestUri (LocalFileRequest abspath) = - fromMaybe nullUri . parseAbsoluteUri $ "file://" <> escapeUriString abspath + fromMaybe nullUri . parseAbsoluteUri $ "file://" <> escapePathString abspath diff --git a/URI.hs b/URI.hs --- a/URI.hs +++ b/URI.hs @@ -14,7 +14,7 @@ module URI ( URI , URIRef - , escapeUriString + , escapePathString , escapeQuery , escapeQueryPart , nullUri @@ -142,14 +142,14 @@ readPort (':':n) = readMay n readPort _ = Nothing -escapeUriString :: String -> String -escapeUriString = NU.escapeURIString NU.isUnescapedInURI +escapePathString :: String -> String +escapePathString = NU.escapeURIString (\c -> NU.isUnreserved c || c == '/') unescapeUriString :: String -> String unescapeUriString = NU.unEscapeString escapeQuery :: String -> String -escapeQuery = NU.escapeURIString NU.isUnescapedInURIComponent . withEscapes +escapeQuery = NU.escapeURIString NU.isUnescapedInURI . withEscapes where withEscapes "" = "" withEscapes ('\\':'\\':s) = '\\':withEscapes s 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.1" +version = "0.1.2" diff --git a/diohsc.1.md b/diohsc.1.md --- a/diohsc.1.md +++ b/diohsc.1.md @@ -97,6 +97,11 @@ : Contains client certificates and corresponding private RSA keys for named : cryptographic identities, as produced by the "identify" command. +~/.diohsc/queue +: Contains URIs, one per line. On startup and before processing each command, +: the contents of this file is added to the queue and the file is deleted. On +: exit, any remaining queue items are appended to this file. + # ENVIRONMENT BROWSER : Default browser used by "browse" command without an argument. diff --git a/diohsc.cabal b/diohsc.cabal --- a/diohsc.cabal +++ b/diohsc.cabal @@ -1,5 +1,5 @@ name: diohsc -version: 0.1.1 +version: 0.1.2 synopsis: Gemini client homepage: https://mbays.sdf.org/diohsc category: Browser @@ -9,7 +9,7 @@ maintainer: mbays@sdf.org build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md, THANKS, diohscrc.sample, Makefile, diohsc.1.md +extra-source-files: README.md, THANKS, diohscrc.sample, Makefile, diohsc.1.md, CHANGELOG.md description: Line-based command-oriented interactive client for the gemini protocol. @@ -96,12 +96,12 @@ CPP-Options: -DWINDOWS else build-depends: - unix + unix < 2.8 if flag(Magic) CPP-Options: -DMAGIC build-depends: - magic + magic < 1.2 if ! os(windows) || flag(Libiconv) CPP-Options: -DICONV build-depends: - iconv + iconv < 0.5 diff --git a/diohsc.hs b/diohsc.hs --- a/diohsc.hs +++ b/diohsc.hs @@ -147,7 +147,7 @@ } defaultClientConfig :: ClientConfig -defaultClientConfig = ClientConfig ("page", []) M.empty [] Nothing PreOptBoth 1000 80 False +defaultClientConfig = ClientConfig ("page", []) M.empty [] Nothing PreOptPre 1000 80 False data QueueItem = QueueItem { queueOrigin :: Maybe HistoryOrigin @@ -218,7 +218,7 @@ let interactive = null optCommands || Interactive `elem` opts let argToUri arg = doesPathExist arg >>= \case - True -> Just . ("file://" <>) . escapeUriString <$> makeAbsolute arg + True -> Just . ("file://" <>) . escapePathString <$> makeAbsolute arg False | Just uri <- parseUriAsAbsolute arg -> return $ Just $ show uri _ -> printErrOpt ansi ("No such URI / file: " <> arg) >> return Nothing argCommand <- join <$> mapM argToUri (listToMaybe args) @@ -291,6 +291,7 @@ lift addToQueueFromFile mapM_ handleLine' initialCommands when interactive lineClient' + unless ghost $ lift appendQueueToFile where handleLine' :: String -> HL.InputT ClientM Bool handleLine' line = lift get >>= \s -> handleLine cOpts s line @@ -309,7 +310,6 @@ then printErrOpt ansi "Use \"quit\" to quit" >> return False else return True Just line -> handleLine' line - when (quit && not ghost) $ lift appendQueueToFile unless quit lineClient' addToQueueFromFile :: ClientM () @@ -569,14 +569,27 @@ queueTarget (QueueItem Nothing uri) = TargetUri uri queueTarget (QueueItem (Just o) uri) = TargetFrom o uri + resolveTarget (PTargetRoot base) = + (rootOf <$>) <$> resolveTarget base + where + rootOf :: Target -> Target + rootOf (TargetHistory item) = rootOfItem item + rootOf (TargetFrom (HistoryOrigin item _) _) = rootOfItem item + rootOf t = t + rootOfItem item = TargetHistory . lastDef item $ historyAncestors item + resolveTarget (PTargetAncestors base specs) = concat <$> (mapM resolveAncestors =<< resolveTarget base) where resolveAncestors :: Target -> Either String [Target] - resolveAncestors (TargetHistory item) = (TargetHistory <$>) <$> - resolveElemsSpecs "ancestor" (matchPatternOn $ show . historyUri) - (historyAncestors item) specs + resolveAncestors (TargetHistory item) = + resolveAncestors' $ historyAncestors item + resolveAncestors (TargetFrom (HistoryOrigin item _) _) = + resolveAncestors' $ item : historyAncestors item resolveAncestors _ = Left "No history" + resolveAncestors' hist = (TargetHistory <$>) <$> + resolveElemsSpecs "ancestor" (matchPatternOn $ show . historyUri) + hist specs resolveTarget (PTargetDescendants base specs) = concat <$> (mapM resolveDescendants =<< resolveTarget base) @@ -870,7 +883,7 @@ actionOfCommand ("mark", CommandArg mark _ : _) | Just n <- readMay mark :: Maybe Int = Just $ \item -> modify $ \s -> s { clientSessionMarks = M.insert n item $ clientSessionMarks s } - actionOfCommand ("mime",_) = Just $ liftIO . print . showMimeType . historyMimedData + actionOfCommand ("mime",_) = Just $ liftIO . putStrLn . showMimeType . historyMimedData actionOfCommand ("save", []) = actionOfCommand ("save", [CommandArg "" savesDir]) actionOfCommand ("save", CommandArg _ path : _) = Just $ \item -> liftIO . doRestricted . RestrictedIO $ do createDirectoryIfMissing True savesDir @@ -1042,7 +1055,7 @@ case MIME.parseMIMEType $ TS.pack s of Nothing -> printErr ("Failed to parse mimetype string: " <> s) >> return Nothing _ | s == "inode/directory" -> Just . (slashedPath,) . MimedData gemTextMimeType . - T.encodeUtf8 . T.unlines . ((("=> " <>) . T.pack . escapeUriString) <$>) <$> + T.encodeUtf8 . T.unlines . ((("=> " <>) . T.pack . escapePathString) <$>) <$> getDirectoryContents path where slashedPath | "/" `isSuffixOf` path = path | otherwise = path <> "/" @@ -1122,4 +1135,4 @@ in printGemDoc opts (showUriRefFull ansi' ais uri) $ parseGemini bodyText _ -> T.stripEnd <$> T.lines bodyText mimeType -> - return . Left $ "Display of non-text MIME type " ++ TS.unpack (MIME.showMIMEType mimeType) ++ " not supported." + return . Left $ "No geminator for " ++ TS.unpack (MIME.showMIMEType mimeType) ++ " configured. Try \"save\", \"view\", \"!\", or \"|\"?"