Add preview to /c

doc/cmds_window.adoc

@@ -5,6 +5,9 @@
 
 Set the current focused window.
 
+When the `+/c+` alias is used,
+shows a list of applicable window names while typing the argument.
+
 See also: focus
 
 === Examples

glirc.cabal

@@ -106,6 +106,7 @@ library
     Client.Hook.Znc.Buffextras
     Client.Hooks
     Client.Image
+    Client.Image.Focus
     Client.Image.Layout
     Client.Image.LineWrap
     Client.Image.Message
@@ -148,6 +149,7 @@ library
     Client.View.UserList
     Client.View.Who
     Client.View.Windows
+    Client.View.WindowSwitch
 
   other-modules:
     ContextFilter

src/Client/Commands.hs

@@ -63,7 +63,7 @@ import Client.Commands.Queries (queryCommands)
 import Client.Commands.TabCompletion
 import Client.Commands.Toggles (togglesCommands)
 import Client.Commands.Types
-import Client.Commands.Window (windowCommands, parseFocus, focusNames)
+import Client.Commands.Window (windowCommands, focusNames)
 import Client.Commands.ZNC (zncCommands)
 
 -- | Interpret the given chat message or command. Leading @/@ indicates a

src/Client/Commands/Window.hs

@@ -259,19 +259,6 @@ withSplitFocuses st str k =
            (parseFocus (views clientFocus focusNetwork st))
            (words str)
 
--- | Parses a single focus name given a default network.
-parseFocus ::
-  Maybe Text {- ^ default network    -} ->
-  String {- ^ @[network:]target@ -} ->
-  Maybe Focus
-parseFocus mbNet x =
-  case break (==':') x of
-    ("*","")     -> pure Unfocused
-    (net,_:"")   -> pure (NetworkFocus (Text.pack net))
-    (net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))
-    (chan,"")    -> mbNet <&> \net ->
-                    ChannelFocus net (mkId (Text.pack chan))
-
 cmdFocus :: ClientCommand (String, Maybe String)
 cmdFocus st (network, mbChannel)
   | network == "*" = commandSuccess (changeFocus Unfocused st)

src/Client/Image/Focus.hs

@@ -0,0 +1,86 @@
+{-# Language OverloadedStrings, BangPatterns #-}
+{-|
+Module      : Client.Image.Focus
+Description : Renderer for focus labels
+Copyright   : (c) Eric Mertens, 2016
+License     : ISC
+Maintainer  : emertens@gmail.com
+
+This module provides image renderers used to construct
+the labels for window names and activity boxes.
+-}
+module Client.Image.Focus
+  ( FocusLabelType (..)
+  , focusLabel
+  , windowLabel
+  ) where
+
+import Client.Image.Message (cleanChar, cleanText, IdentifierColorMode (NormalIdentifier), coloredIdentifier, modesImage)
+import Client.Image.PackedImage
+import Client.Image.Palette
+import Client.State
+import Client.State.Channel (chanModes, chanUsers)
+import Client.State.Focus (focusNetwork, Focus(..))
+import Client.State.Network
+import Client.State.Window
+import Control.Lens (view, preview, Ixed(ix))
+import Data.Map.Strict qualified as Map
+import qualified Data.HashMap.Strict as HashMap
+import Graphics.Vty.Attributes (defAttr)
+
+windowLabel :: ClientState -> (Focus, Window) -> Image'
+windowLabel st (focus, w) =
+  jumpLabel <>
+  focusLabel FocusLabelJump st focus <>
+  activity
+  where
+    jumpLabel =
+      case view winName w of
+        Nothing   -> mempty
+        Just name -> char (view palWindowName pal) name <>
+                     char defAttr ':'
+    n   = view winUnread w
+    pal = clientPalette st
+    activity
+      | n == 0 = mempty
+      | view winMention w == WLImportant = char defAttr ' ' <> string (view palMention pal) (show n)
+      | otherwise = char defAttr ' ' <> string (view palActivity pal) (show n)
+
+data FocusLabelType = FocusLabelJump | FocusLabelShort | FocusLabelLong
+
+focusLabel :: FocusLabelType -> ClientState -> Focus -> Image'
+focusLabel labelType st focus =
+  let
+    !pal = clientPalette st
+    netpal = clientNetworkPalette st
+    colon = char defAttr ':'
+    networkLabel network = text' (view palLabel pal) (cleanText network)
+    channelLabel         = coloredIdentifier pal NormalIdentifier HashMap.empty
+  in case (focus, labelType) of
+    (Unfocused, _) ->
+      char (view palError pal) '*'
+    (NetworkFocus network, FocusLabelJump) -> networkLabel network <> colon
+    (NetworkFocus network, _) -> networkLabel network
+    (ChannelFocus network channel, FocusLabelJump)
+      | Just network == focusNetwork (view clientFocus st) -> channelLabel channel
+    (ChannelFocus network channel, FocusLabelLong) ->
+      networkLabel network <>
+      colon <>
+      string (view palSigil pal) (cleanChar <$> sigils) <>
+      channelLabel channel <>
+      channelModes
+      where
+        (sigils, channelModes) =
+          case preview (clientConnection network) st of
+            Just cs ->
+               ( let nick = view csNick cs in
+                 view (csChannels . ix channel . chanUsers . ix nick) cs
+               , case preview (csChannels . ix channel . chanModes) cs of
+                    Just modeMap | not (null modeMap) ->
+                        " " <> modesImage (view palModes pal) (view palCModes netpal) ('+':Map.keys modeMap)
+                    _ -> mempty
+               )
+            _ -> ("", mempty)
+    (ChannelFocus network channel, _) ->
+      networkLabel network <> colon <> channelLabel channel
+

src/Client/Image/StatusLine.hs

@@ -17,6 +17,7 @@ module Client.Image.StatusLine
   , clientTitle
   ) where
 
+import Client.Image.Focus
 import Client.Image.Message (cleanChar, cleanText, IdentifierColorMode (NormalIdentifier), coloredIdentifier, modesImage)
 import Client.Image.PackedImage
 import Client.Image.Palette
@@ -247,29 +248,17 @@ activityBarImages st
   $ Map.toAscList
   $ view clientWindows st
   where
-    baraux (focus,w)
+    baraux pair@(_,w)
       | view winActivityFilter w == AFSilent = Nothing
       | n == 0 = Nothing -- todo: make configurable
-      | otherwise = Just
-                  $ unpackImage bar Vty.<|>
-                    Vty.char defAttr '[' Vty.<|>
-                    jumpLabel Vty.<|>
-                    unpackImage (focusLabel FocusLabelJump st focus) Vty.<|>
-                    Vty.char defAttr ' ' Vty.<|>
-                    Vty.string attr (show n) Vty.<|>
-                    Vty.char defAttr ']'
+      | otherwise = Just $
+        unpackImage bar Vty.<|>
+        Vty.char defAttr '[' Vty.<|>
+        unpackImage (windowLabel' pair) Vty.<|>
+        Vty.char defAttr ']'
       where
-        jumpLabel =
-          case view winName w of
-            Nothing   -> mempty
-            Just name -> Vty.char (view palWindowName pal) name Vty.<|>
-                         Vty.char defAttr ':'
-        n   = view winUnread w
-        pal = clientPalette st
-        attr = case view winMention w of
-                 WLImportant -> view palMention pal
-                 _           -> view palActivity pal
-
+        windowLabel' = windowLabel st
+        n = view winUnread w
 
 -- | Pack a list of images into a single image spanning possibly many lines.
 -- The images will stack upward with the first element of the list being in
@@ -294,7 +283,6 @@ makeLines w (x:xs) = go x xs
       where
         fillsize = max 0 (w - Vty.imageWidth acc)
 
-
 myNickImage :: ClientState -> Vty.Image
 myNickImage st =
   case view clientFocus st of
@@ -327,44 +315,6 @@ myNickImage st =
 parens :: Attr -> Vty.Image -> Vty.Image
 parens attr i = Vty.char attr '(' Vty.<|> i Vty.<|> Vty.char attr ')'
 
-data FocusLabelType = FocusLabelJump | FocusLabelShort | FocusLabelLong
-
-focusLabel :: FocusLabelType -> ClientState -> Focus -> Image'
-focusLabel labelType st focus =
-  let
-    !pal = clientPalette st
-    netpal = clientNetworkPalette st
-    colon = char defAttr ':'
-    networkLabel network = text' (view palLabel pal) (cleanText network)
-    channelLabel         = coloredIdentifier pal NormalIdentifier HashMap.empty
-  in case (focus, labelType) of
-    (Unfocused, _) ->
-      char (view palError pal) '*'
-    (NetworkFocus network, FocusLabelJump) -> networkLabel network <> colon
-    (NetworkFocus network, _) -> networkLabel network
-    (ChannelFocus network channel, FocusLabelJump)
-      | Just network == focusNetwork (view clientFocus st) -> channelLabel channel
-    (ChannelFocus network channel, FocusLabelLong) ->
-      networkLabel network <>
-      colon <>
-      string (view palSigil pal) (cleanChar <$> sigils) <>
-      channelLabel channel <>
-      channelModes
-      where
-        (sigils, channelModes) =
-          case preview (clientConnection network) st of
-            Just cs ->
-               ( let nick = view csNick cs in
-                 view (csChannels . ix channel . chanUsers . ix nick) cs
-               , case preview (csChannels . ix channel . chanModes) cs of
-                    Just modeMap | not (null modeMap) ->
-                        " " <> modesImage (view palModes pal) (view palCModes netpal) ('+':Map.keys modeMap)
-                    _ -> mempty
-               )
-            _ -> ("", mempty)
-    (ChannelFocus network channel, _) ->
-      networkLabel network <> colon <> channelLabel channel
-
 currentViewImage :: Bool -> ClientState -> Subfocus -> Focus -> Image'
 currentViewImage showFull st subfocus focus =
   case subfocus of

src/Client/State/Focus.hs

@@ -19,18 +19,21 @@ module Client.State.Focus
   , WindowsFilter(..)
 
   -- * Focus operations
+  , parseFocus
   , focusNetwork
   , actualFocus
+  , isPrefixOfFocus
 
   -- * Focus Prisms
   , _ChannelFocus
   , _NetworkFocus
   , _Unfocused
   ) where
 
-import Control.Lens (makePrisms)
-import Data.Text (Text)
-import Irc.Identifier (Identifier)
+import           Control.Lens (makePrisms, (<&>))
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Irc.Identifier (Identifier, idPrefix, mkId)
 
 -- | Currently focused window
 data Focus
@@ -90,6 +93,31 @@ actualFocus sf = case sf of
   FocusWho net          -> const (NetworkFocus net)
   _ -> id
 
+-- | Parses a single focus name given a default network.
+parseFocus ::
+  Maybe Text {- ^ default network    -} ->
+  String {- ^ @[network:]target@ -} ->
+  Maybe Focus
+parseFocus mbNet x =
+  case break (==':') x of
+    ("*","")     -> pure Unfocused
+    (net,_:"")   -> pure (NetworkFocus (Text.pack net))
+    (net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))
+    (chan,"")    -> mbNet <&> \net ->
+                    ChannelFocus net (mkId (Text.pack chan))
+
+isPrefixOfFocus :: String -> Focus -> Bool
+isPrefixOfFocus prefix focus = case break (==':') prefix of
+  ("","")  -> True
+  ("*","") -> focus == Unfocused
+  (chan,"") -> case focus of 
+    ChannelFocus _    chanF -> idPrefix (mkId $ Text.pack chan) chanF
+    NetworkFocus netF       -> Text.isPrefixOf (Text.pack chan) netF
+    Unfocused               -> False
+  (net,_:chan) -> case focus of
+    ChannelFocus netF chanF -> netF == Text.pack net && idPrefix (mkId $ Text.pack chan) chanF
+    _ -> False
+
 -- | Filter argument for 'FocusWindows'
 data WindowsFilter
   = AllWindows     -- ^ no filter

src/Client/View.hs

@@ -32,13 +32,16 @@ import Client.View.UrlSelection (urlSelectionView)
 import Client.View.UserList (userInfoImages, userListImages)
 import Client.View.Who (whoLines)
 import Client.View.Windows (windowsImages)
+import Client.View.WindowSwitch (windowSwitchImages)
 import Control.Lens (view)
 
 viewLines :: Focus -> Subfocus -> Int -> ClientState -> [Image']
 viewLines focus subfocus w !st =
   case subfocus of
     _ | Just ("url",arg) <- clientActiveCommand st ->
       urlSelectionView w focus' arg st
+    _ | Just ("c",arg) <- clientActiveCommand st ->
+      windowSwitchImages arg w st
     FocusInfo network channel ->
       channelInfoImages network channel st
     FocusUsers network channel

src/Client/View/WindowSwitch.hs

@@ -0,0 +1,40 @@
+{-# Language OverloadedStrings #-}
+{-|
+Module      : Client.View.WindowSwitch
+Description : Line renderers for window switcher
+Copyright   : (c) TheDaemoness, 2024
+License     : ISC
+Maintainer  : emertens@gmail.com
+
+This module renders lines used in the preview for /c
+-}
+module Client.View.WindowSwitch ( windowSwitchImages ) where
+
+import           Client.Image.Focus (windowLabel)
+import           Client.Image.PackedImage
+import           Client.State
+import           Client.State.Focus
+import           Client.State.Window (winMention)
+import           Control.Lens
+import qualified Data.Map.Strict as Map
+import           Data.List
+import           Data.List.Split
+import           Graphics.Vty (defAttr)
+
+-- | Render the lines used by the @/c@ command.
+windowSwitchImages ::
+  String      {- ^ filter       -} ->
+  Int         {- ^ window width -} ->
+  ClientState {- ^ client state -} ->
+  [Image']
+windowSwitchImages arg w st = reverse [mconcat (intersperse gap row) | row <- chunksOf columns paddedNames]
+  where
+    paddedNames = map (resizeImage maxWidth) nameImages
+    nameImages = map (windowLabel st) windowList
+    maxWidth   = maximum (map imageWidth nameImages)
+    columns    = max 1 ((w+1) `quot` (maxWidth+2))
+    gap = string defAttr "  "
+    windowList = sortBy activity . filter filterByFocus . Map.toAscList $ view clientWindows st
+      where
+        filterByFocus (focus,_) = isPrefixOfFocus arg focus
+        activity (_,wa) (_,wb) = compare (view winMention wa) (view winMention wb)