diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for glirc2 +## 2.20.5 + +* Add line indicating message since previous time window was focused. + The palette for this is configurable as `line-marker` + ## 2.20.4 * Add `/query` alias for `/channel` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -33,10 +33,10 @@ $ cabal build ``` -Building with stack using ghc-8 resolver (lts-7 resolvers can work using --solver) +Building with stack ``` -$ stack init --resolver=ghc-8 +$ stack init --resolver=lts-8 --solver $ stack build ``` @@ -229,6 +229,7 @@ | `command-ready` | attr | recognized command with arguments filled | | `command-placeholder` | attr | command argument placeholder | | `window-divider` | attr | the dividing line between split windows | +| `line-marker` | attr | the dividing line for new messages | Text Attributes --------------- diff --git a/glirc.cabal b/glirc.cabal --- a/glirc.cabal +++ b/glirc.cabal @@ -1,5 +1,5 @@ name: glirc -version: 2.20.4 +version: 2.20.5 synopsis: Console IRC client description: Console IRC client . @@ -20,7 +20,7 @@ cabal-version: >=1.23 homepage: https://github.com/glguy/irc-core bug-reports: https://github.com/glguy/irc-core/issues -tested-with: GHC==8.0.1 +tested-with: GHC==8.0.2 custom-setup setup-depends: base >=4.9 && <4.11, @@ -157,5 +157,5 @@ main-is: Main.hs hs-source-dirs: test build-depends: base, glirc, - HUnit >=1.3 && <1.4 + HUnit >=1.3 && <1.7 default-language: Haskell2010 diff --git a/src/Client/Commands.hs b/src/Client/Commands.hs --- a/src/Client/Commands.hs +++ b/src/Client/Commands.hs @@ -1073,25 +1073,24 @@ renderFocus (ChannelFocus x y) = x <> ":" <> idText y - -- | Implementation of @/splits@ cmdSplits :: ClientCommand String -cmdSplits st str = commandSuccess (set clientExtraFocus extras st) +cmdSplits st str = commandSuccess (setExtraFocus extras st) where extras = nub (parseFocuses str) -- | Implementation of @/splits+@ cmdSplitsAdd :: ClientCommand String -cmdSplitsAdd st str = commandSuccess (over clientExtraFocus extras st) +cmdSplitsAdd st str = commandSuccess (setExtraFocus extras st) where - extras prev = nub (parseFocuses str ++ prev) + extras = nub (parseFocuses str ++ view clientExtraFocus st) -- | Implementation of @/splits-@ cmdSplitsDel :: ClientCommand String -cmdSplitsDel st str = commandSuccess (over clientExtraFocus extras st) +cmdSplitsDel st str = commandSuccess (setExtraFocus extras st) where - extras prev = prev \\ parseFocuses str + extras = view clientExtraFocus st \\ parseFocuses str tabHelp :: Bool -> ClientCommand String diff --git a/src/Client/Image/Palette.hs b/src/Client/Image/Palette.hs --- a/src/Client/Image/Palette.hs +++ b/src/Client/Image/Palette.hs @@ -33,6 +33,7 @@ , palCommandPrefix , palCommandError , palWindowDivider + , palLineMarker , paletteMap @@ -66,6 +67,7 @@ , _palCommandError :: Attr -- ^ unknown command , _palCommandPlaceholder :: Attr -- ^ command argument placeholder , _palWindowDivider :: Attr -- ^ Divider between split windows + , _palLineMarker :: Attr -- ^ Divider between new and old messages } deriving Show @@ -93,6 +95,7 @@ , _palCommandError = withForeColor defAttr red , _palCommandPlaceholder = withStyle defAttr reverseVideo , _palWindowDivider = withStyle defAttr reverseVideo + , _palLineMarker = defAttr } -- | Default nick highlighting colors that look nice in my dark solarized @@ -103,6 +106,8 @@ [cyan, magenta, green, yellow, blue, brightCyan, brightMagenta, brightGreen, brightBlue] +-- | List of palette entry names and lenses for accessing that component +-- of the palette. paletteMap :: [(Text, ReifiedLens' Palette Attr)] paletteMap = [ ("self" , Lens palSelf) @@ -123,4 +128,5 @@ , ("command-prefix" , Lens palCommandPrefix) , ("command-error" , Lens palCommandError) , ("window-divider" , Lens palWindowDivider) + , ("line-marker" , Lens palLineMarker) ] diff --git a/src/Client/Image/StatusLine.hs b/src/Client/Image/StatusLine.hs --- a/src/Client/Image/StatusLine.hs +++ b/src/Client/Image/StatusLine.hs @@ -156,13 +156,13 @@ indicators = foldr aux [] (zip winNames windows) windows = views clientWindows Map.elems st - aux (i,w) rest - | view winUnread w == 0 = rest - | otherwise = char attr i : rest + aux (i,w) rest = + case view winMention w of + WLImportant -> char (view palMention pal) i : rest + WLNormal -> char (view palActivity pal) i : rest + WLBoring -> rest where pal = clientPalette st - attr | view winMention w = view palMention pal - | otherwise = view palActivity pal -- | Multi-line activity information enabled by F3 activityBarImages :: ClientState -> [Image] @@ -189,8 +189,9 @@ where n = view winUnread w pal = clientPalette st - attr | view winMention w = view palMention pal - | otherwise = view palActivity pal + attr = case view winMention w of + WLImportant -> view palMention pal + _ -> view palActivity pal focusText = case focus of Unfocused -> Text.pack "*" diff --git a/src/Client/State.hs b/src/Client/State.hs --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -83,6 +83,7 @@ , retreatFocus , jumpToActivity , jumpFocus + , setExtraFocus -- * Scrolling , scrollClient @@ -483,7 +484,7 @@ | otherwise = st1 - hasMention = orOf (clientWindows . folded . winMention) + hasMention = elemOf (clientWindows . folded . winMention) WLImportant toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine toWindowLine params importance msg = WindowLine @@ -565,16 +566,15 @@ views (clientConnection network . csChannels . ix channel . chanUsers) HashMap.keys --- | Returns the current filtering predicate. +-- | Returns the current filtering predicate if one is active. clientMatcher :: - ClientState {- ^ client state -} -> - Text {- ^ text to match -} -> - Bool {- ^ is match -} + ClientState {- ^ client state -} -> + Maybe (Text -> Bool) {- ^ optional predicate -} clientMatcher st = - case clientActiveRegex st of - Nothing -> const True - Just r -> matchTest r . Text.unpack + do r <- clientActiveRegex st + return (matchTest r . Text.unpack) + -- | Construct a text matching predicate used to filter the message window. clientActiveRegex :: ClientState -> Maybe Regex clientActiveRegex st = @@ -627,7 +627,7 @@ _ -> t -- | Remove a network connection and unlink it from the network map. --- This operation assumes that the networkconnection exists and should +-- This operation assumes that the network connection exists and should -- only be applied once per connection. removeNetwork :: NetworkId -> ClientState -> (NetworkState, ClientState) removeNetwork networkId st = @@ -675,7 +675,7 @@ applyMessageToClientState :: ZonedTime {- ^ timestamp -} -> - IrcMsg {- ^ message recieved -} -> + IrcMsg {- ^ message received -} -> NetworkId {- ^ message network -} -> NetworkState {- ^ network connection state -} -> ClientState {- ^ client state -} -> @@ -785,7 +785,7 @@ jumpToActivity st = changeFocus newFocus st where windowList = views clientWindows Map.toAscList st - highPriority = find (view winMention . snd) windowList + highPriority = find (\x -> WLImportant == view winMention (snd x)) windowList lowPriority = find (\x -> view winUnread (snd x) > 0) windowList newFocus = case mplus highPriority lowPriority of @@ -808,11 +808,13 @@ -- to message view, reset the scroll, remember the previous focus -- if it changed. changeFocus :: - Focus {- ^ new focus -} -> - ClientState {- ^ client state -} -> + Focus {- ^ new focus -} -> + ClientState {- ^ client state -} -> ClientState changeFocus focus st = set clientScroll 0 + . activateCurrent + . deactivatePrevious . updatePrevious . set clientFocus focus . set clientSubfocus FocusMessages @@ -823,6 +825,32 @@ updatePrevious | focus == oldFocus = id | otherwise = set clientPrevFocus oldFocus + + -- always activate the new window. If it was already active this + -- will clear the marker. + activateCurrent = over (clientWindows . ix focus) windowActivate + + -- Don't deactivate a window if it's going to stay active + deactivatePrevious + | oldFocus `elem` focus : view clientExtraFocus st = id + | otherwise = over (clientWindows . ix oldFocus) windowDeactivate + + +-- | Unified logic for assigning to the extra focuses field that activates +-- and deactivates windows as needed. +setExtraFocus :: [Focus] -> ClientState -> ClientState +setExtraFocus newFocuses st + = aux windowDeactivate newlyInactive + $ aux windowActivate newlyActive + $ set clientExtraFocus newFocuses st + where + newlyActive = newFocuses \\ (view clientFocus st : view clientExtraFocus st) + + newlyInactive = view clientExtraFocus st \\ (view clientFocus st : newFocuses) + + aux f xs st1 = + foldl' (\acc w -> overStrict (clientWindows . ix w) f acc) st1 xs + -- | Change the subfocus to the given value, preserve the focus, reset -- the scroll. diff --git a/src/Client/State/Window.hs b/src/Client/State/Window.hs --- a/src/Client/State/Window.hs +++ b/src/Client/State/Window.hs @@ -19,6 +19,7 @@ , winUnread , winTotal , winMention + , winMarker -- * Window lines , WindowLine(..) @@ -36,6 +37,8 @@ , emptyWindow , addToWindow , windowSeen + , windowActivate + , windowDeactivate ) where import Client.Image.PackedImage @@ -62,18 +65,22 @@ -- | A 'Window' tracks all of the messages and metadata for a particular -- message buffer. data Window = Window - { _winMessages :: !WindowLines -- ^ Messages to display, newest first - , _winUnread :: !Int -- ^ Messages added since buffer was visible - , _winTotal :: !Int -- ^ Messages in buffer - , _winMention :: !Bool -- ^ Indicates an important event is unread + { _winMessages :: !WindowLines -- ^ Messages to display, newest first + , _winMarker :: !(Maybe Int) -- ^ Location of line drawn to indicate newer messages + , _winUnread :: !Int -- ^ Messages added since buffer was visible + , _winTotal :: !Int -- ^ Messages in buffer + , _winMention :: !WindowLineImportance -- ^ Indicates an important event is unread } +data ActivityLevel = NoActivity | NormalActivity | HighActivity + deriving (Eq, Ord, Read, Show) + -- | Flag for the important of a message being added to a window data WindowLineImportance = WLBoring -- ^ Don't update unread count | WLNormal -- ^ Increment unread count | WLImportant -- ^ Increment unread count and set important flag - deriving (Eq, Show) + deriving (Eq, Ord, Show, Read) makeLenses ''Window makeLenses ''WindowLine @@ -94,9 +101,10 @@ emptyWindow :: Window emptyWindow = Window { _winMessages = Nil + , _winMarker = Nothing , _winUnread = 0 , _winTotal = 0 - , _winMention = False + , _winMention = WLBoring } -- | Adds a given line to a window as the newest message. Window's @@ -105,16 +113,31 @@ addToWindow !msg !win = Window { _winMessages = msg :- view winMessages win , _winTotal = view winTotal win + 1 - , _winUnread = view winUnread win - + (if view wlImportance msg == WLBoring then 0 else 1) - , _winMention = view winMention win - || view wlImportance msg == WLImportant + , _winMarker = do i <- view winMarker win; return $! i+1 + , _winUnread = if view wlImportance msg == WLBoring + then view winUnread win + else view winUnread win + 1 + , _winMention = max (view winMention win) (view wlImportance msg) } -- | Update the window clearing the unread count and important flag. windowSeen :: Window -> Window windowSeen = set winUnread 0 - . set winMention False + . set winMention WLBoring + + +-- | Update the window when it first becomes active. If only /boring/ +-- messages have been added since last time the marker will be hidden. +windowActivate :: Window -> Window +windowActivate win + | view winUnread win == 0 = set winMarker Nothing win + | otherwise = win + + +-- | Update the window when it becomes inactive. This resets the activity +-- marker to the bottom of the window. +windowDeactivate :: Window -> Window +windowDeactivate = set winMarker (Just 0) instance Each WindowLines WindowLines WindowLine WindowLine where diff --git a/src/Client/View/Digraphs.hs b/src/Client/View/Digraphs.hs --- a/src/Client/View/Digraphs.hs +++ b/src/Client/View/Digraphs.hs @@ -29,12 +29,12 @@ = map (horizCat . intersperse sep) $ chunksOf entriesPerLine $ map (text' defAttr) - $ filter matcher + $ matcher $ map (Text.pack . drawEntry) $ digraphListToList digraphs where w = view clientWidth st - matcher = clientMatcher st + matcher = maybe id filter (clientMatcher st) entriesPerLine = max 1 -- just in case? $ (w + sepWidth) `quot` (entryWidth + sepWidth) diff --git a/src/Client/View/MaskList.hs b/src/Client/View/MaskList.hs --- a/src/Client/View/MaskList.hs +++ b/src/Client/View/MaskList.hs @@ -22,6 +22,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.List import Data.Ord +import Data.Maybe import Data.Text (Text) import Data.Time import Graphics.Vty.Attributes @@ -57,7 +58,7 @@ char (view palLabel pal) '/' <|> string defAttr (show (HashMap.size entries)) - matcher = clientMatcher st + matcher = fromMaybe (const True) (clientMatcher st) matcher' (mask,entry) = matcher mask || matcher (view maskListSetter entry) diff --git a/src/Client/View/Messages.hs b/src/Client/View/Messages.hs --- a/src/Client/View/Messages.hs +++ b/src/Client/View/Messages.hs @@ -32,17 +32,27 @@ chatMessageImages :: Focus -> ClientState -> [Image] -chatMessageImages focus st = windowLineProcessor focusedMessages - where - matcher = clientMatcher st - - focusedMessages - = toListOf ( clientWindows . ix focus - . winMessages . each - . filtered (views wlText matcher)) st +chatMessageImages focus st = + case preview (clientWindows . ix focus) st of + Nothing -> [] + Just win -> + let msgs = toListOf each (view winMessages win) in + case clientMatcher st of + Just matcher -> windowLineProcessor (filter (views wlText matcher) msgs) + Nothing -> + case view winMarker win of + Nothing -> windowLineProcessor msgs + Just n -> + windowLineProcessor l ++ + [marker] ++ + windowLineProcessor r + where + (l,r) = splitAt n msgs + where + palette = clientPalette st + marker = string (view palLineMarker palette) (replicate (view clientWidth st) '-') windowLineProcessor - | view clientDetailView st = if view clientShowMetadata st then map (view wlFullImage) diff --git a/src/Client/View/UserList.hs b/src/Client/View/UserList.hs --- a/src/Client/View/UserList.hs +++ b/src/Client/View/UserList.hs @@ -22,6 +22,7 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import Data.List +import Data.Maybe import Data.Ord import Data.Text (Text) import qualified Data.Text as Text @@ -52,7 +53,7 @@ countImage = text' (view palLabel pal) "Users:" <|> sigilCountImage - matcher = clientMatcher st + matcher = fromMaybe (const True) (clientMatcher st) myNicks = clientHighlights cs st @@ -100,7 +101,7 @@ userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image] userInfoImages' cs channel st = renderEntry <$> usersList where - matcher = clientMatcher st + matcher = fromMaybe (const True) (clientMatcher st) myNicks = clientHighlights cs st diff --git a/src/Client/View/Windows.hs b/src/Client/View/Windows.hs --- a/src/Client/View/Windows.hs +++ b/src/Client/View/Windows.hs @@ -95,6 +95,7 @@ char defAttr '/' <|> string (view palActivity pal) (views winTotal show win) where - newMsgAttrLens - | view winMention win = palMention - | otherwise = palActivity + newMsgAttrLens = + case view winMention win of + WLImportant -> palMention + _ -> palActivity