More info list buffers

yi-misc-modes/src/Yi/Mode/Buffers.hs

@@ -13,12 +13,21 @@
 module Yi.Mode.Buffers (listBuffers) where
 
 import           Control.Category    ((>>>))
-import           Lens.Micro.Platform ((.=), (%~), (.~))
-import           Data.List.NonEmpty  (toList)
-import qualified Data.Text           as T (intercalate, pack)
-import           System.FilePath     (takeFileName)
+import           Control.Monad       (forM_, mapM_, unless, when
+                                     ,replicateM_)
+import           Data.Functor        (void)
+import           Lens.Micro.Platform ((.=), (%~), (.~), (%=), to, use)
+import           Data.List.NonEmpty  (NonEmpty( (:|) ))
+import qualified Data.Text           as T (intercalate, pack, append, Text
+                                          , justifyLeft)
 import           Yi.Buffer
 import           Yi.Editor
+import           Yi.Types            ( FBuffer(attributes)
+                                     , Attributes(readOnly))
+import           Yi.Buffer.Misc      (isUnchangedBuffer, replaceCharB
+                                     ,gotoLnFrom, rightB )
+import           Yi.Buffer.HighLevel (moveToSol, lineStreamB, topB)
+import           Yi.Buffer.Basic      (Direction(..), BufferRef(..))
 import           Yi.Keymap           (Keymap, YiM, topKeymapA)
 import           Yi.Keymap.Keys
 import qualified Yi.Rope             as R (fromText, toString)
@@ -28,23 +37,94 @@ import qualified Yi.Rope             as R (fromText, toString)
 listBuffers :: YiM ()
 listBuffers = do
   withEditor $ do
-    bs <- toList <$> getBufferStack
-    let bufferList = R.fromText . T.intercalate "\n" $ map identString bs
-    bufRef <- stringToNewBuffer (MemBuffer "Buffer List") bufferList
+    -- Delete previous lists of buffers. TODO: what happens with a
+    -- buffer named *Buffer List*?
+    use (to (findBufferWithName listBuffersName)) >>= mapM_ deleteBuffer
+    --
+    br <- use (to bufferStack)
+    bs <- getBufferStack
+    let bufferList = R.fromText . T.intercalate "\n" $ bufferProperties br bs
+    bufRef <- stringToNewBuffer (MemBuffer listBuffersName) bufferList
     switchToBufferE bufRef
   withCurrentBuffer $ do
     modifyMode $ modeKeymapA .~ topKeymapA %~ bufferKeymap
                  >>> modeNameA .~ "buffers"
     readOnlyA .= True
+  where
+    listBuffersName :: T.Text
+    listBuffersName = "Buffer List"
+
+-- | Add Emacs-like properties to the list of buffers. Currently the
+--   flags .%* means that . is the current buffer, % that is read only and *
+--   that has been modified.
+bufferProperties :: NonEmpty BufferRef -> NonEmpty FBuffer -> [T.Text]
+bufferProperties (curRef :| extraRef) (curBuf :| extraBufs) =
+  characterize '.' curRef curBuf
+  : map (uncurry (characterize ' ')) (zip extraRef extraBufs)
+  where
+    characterize :: Char -> BufferRef -> FBuffer -> T.Text
+    characterize cur ref buf | attr <- attributes buf =
+        let roChar = if readOnly attr then '%' else ' '
+            modChar = if isUnchangedBuffer buf then ' ' else '*'
+        in T.pack [cur, roChar, modChar, ' ']
+           `T.append` fourSpaceRef ref `T.append` " "
+           `T.append` identString buf
+
+    fourSpaceRef :: BufferRef -> T.Text
+    fourSpaceRef (BufferRef i) = T.justifyLeft 4 ' ' (T.pack (show i))
+
+
+-- | Auxiliar function to extract the `BufferRef` from the format used in
+--   this mode
+extractBufferRef :: String -> BufferRef
+extractBufferRef l = let ref' = read $ words (drop 4 l) !! 0
+                     in  BufferRef ref'
 
 -- | Switch to the buffer with name at current name. If it it starts
 -- with a @/@ then assume it's a file and try to open it that way.
 switch :: YiM ()
 switch = do
-  -- the YiString -> FilePath -> Text conversion sucks
   s <- R.toString <$> withCurrentBuffer readLnB
-  let short = T.pack $ if take 1 s == "/" then takeFileName s else s
-  withEditor $ switchToBufferWithNameE short
+  let ref = extractBufferRef s
+  withEditor $ switchToBufferE ref
+
+-- | `setFlag offset char move` puts on the current line at the given
+--   `offset` from the beginning the character `char` and depending on move
+--   whether we move down a line. This is a general template for all the
+--   setting moves on the list buffer.
+setFlag :: Int -> Char -> Bool -> BufferM ()
+setFlag n c move = do
+  readOnlyA .= False
+  moveToSol >> replicateM_ n rightB >> replaceCharB c
+  readOnlyA .= True
+  isLast <- atLastLine
+  unless (isLast || not move) (void (gotoLnFrom 1))
+
+setDeleteFlag,unsetDeleteFlag :: BufferM ()
+setDeleteFlag = setFlag 0 'D' True
+unsetDeleteFlag = setFlag 0 ' ' True
+
+-- | Alternate the readonly status of a buffer on the list.
+flipROFlag :: EditorM ()
+flipROFlag = do
+  s <- R.toString <$> withCurrentBuffer readLnB
+  let ref = extractBufferRef s
+      symbol = if s !! 1 == ' ' then '%' else ' '
+  withGivenBuffer ref (readOnlyA %= not)
+  withCurrentBuffer (setFlag 1 symbol False)
+
+-- | eXecute the flagged for deletion files on the list buffer. Then
+--   refresh the list.
+executeDelete :: YiM ()
+executeDelete = do
+  bLines <- withCurrentBuffer (topB *> lineStreamB Forward)
+  forM_ bLines $ \l ->
+      let (flags, rest) = splitAt 4 (R.toString l)
+          d:_ = flags
+          ref' = read (words rest !! 0)
+          ref = BufferRef ref'
+      in when (d == 'D') (deleteBuffer ref)
+  listBuffers
 
 -- | Keymap for the buffer mode.
 --
@@ -53,13 +133,22 @@ switch = do
 -- __n__ or __SPACE__ → line down
 -- __ENTER__ or __f__ → open buffer
 -- __v__              → open buffer as read-only
+-- __g__              → reload buffer list
+-- __d__              → flag this file for deletion
+-- __x__              → delete files flagged for deletion
+-- __%__              → set/unset files as read-only
 -- @
 bufferKeymap :: Keymap -> Keymap
 bufferKeymap = important $ choice
   [ char 'p'                        ?>>! lineUp
   , oneOf [ char 'n', char ' ' ]    >>! lineDown
-  , oneOf [ spec KEnter, char 'f' ] >>! (switch >> setReadOnly False)
+  , oneOf [ spec KEnter, char 'f' ] >>! switch
   , char 'v'                        ?>>! (switch >> setReadOnly True)
+  , char 'g'                        ?>>! listBuffers
+  , char 'd'                        ?>>! setDeleteFlag
+  , char 'x'                        ?>>! executeDelete
+  , char 'u'                        ?>>! unsetDeleteFlag
+  , char '%'                        ?>>! flipROFlag
   ]
   where
     setReadOnly = withCurrentBuffer . (.=) readOnlyA