diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -28,4 +28,5 @@ -- | Irc client render process. main :: IO () main = - startupRender (\ pagePath client pageId -> PageBufferWrap <$> processBufferNew pagePath client pageId) + startupRender (\ pagePath options client pageId -> + PageBufferWrap <$> processBufferNew pagePath options client pageId) diff --git a/Manatee/Extension/ProcessManager/ProcessBuffer.hs b/Manatee/Extension/ProcessManager/ProcessBuffer.hs --- a/Manatee/Extension/ProcessManager/ProcessBuffer.hs +++ b/Manatee/Extension/ProcessManager/ProcessBuffer.hs @@ -20,11 +20,13 @@ module Manatee.Extension.ProcessManager.ProcessBuffer where import Control.Applicative +import Control.Arrow import Control.Concurrent import Control.Concurrent.STM import Control.Monad import DBus.Client hiding (Signal) import Data.Ord +import Data.List import Data.Typeable import Graphics.UI.Gtk.General.Enums import Graphics.UI.Gtk.General.General @@ -51,7 +53,7 @@ deriving Typeable data ProcTChanSignal = Empty - | UpdateProcesses + | UpdateProcesses ([ProcStatus], [ProcStatus], [ProcStatus]) | KillProcess Int deriving (Show, Eq, Ord) @@ -115,8 +117,8 @@ getCellText MPriority info = showPriority $ psNice info getCellText MThreads info = show $ psNumThreads info getCellText MCPUPercent info = show (psCpuPercent info) ++ "%" - getCellText MVirtualMemory info = (formatFileSizeForDisplay . fromIntegral) $ psVirtualMem info - getCellText MResidentMemory info = (formatFileSizeForDisplay . fromIntegral) $ psResidentMem info + getCellText MVirtualMemory info = formatFileSizeForDisplay (fromIntegral $ psVirtualMem info) 2 + getCellText MResidentMemory info = formatFileSizeForDisplay (fromIntegral $ psResidentMem info) 2 getCellText MCmdline info = psCmdline info getCellText MUser info = psUsername info @@ -149,8 +151,8 @@ compareRow MUser row1 row2 = return $ comparing psUsername row1 row2 -- | Create process buffer. -processBufferNew :: FilePath -> Client -> PageId -> IO ProcessBuffer -processBufferNew path client pageId = do +processBufferNew :: FilePath -> [String] -> Client -> PageId -> IO ProcessBuffer +processBufferNew path _ client pageId = do -- Get process status. infos <- procGetAllProcessStatus @@ -182,11 +184,22 @@ -- Just update status when proces view is running. when (counter > 0) $ do forkIO $ do - infos <- procGetAllProcessStatus - writeTVarIO (processBufferStatus buffer) infos - writeTChanIO (processBufferBroadcastChannel buffer) UpdateProcesses - counter <- readTVarIO $ processBufferViewCounter buffer - when (counter > 0) $ processBufferUpdate buffer + -- Update process status. + infos <- procGetAllProcessStatus + oldInfos <- readTVarIO (processBufferStatus buffer) + -- Get update process status. + let (deleteInfos, restInfos) = + partition (\x -> psProcessId x `notElem` map psProcessId infos) oldInfos + (addInfos, diffInfos) = diffProcessStatus infos restInfos + -- Update status in ProcessBuffer. + writeTVarIO (processBufferStatus buffer) infos + -- Update status in ProcessView. + writeTChanIO (processBufferBroadcastChannel buffer) + (UpdateProcesses (addInfos, deleteInfos, diffInfos)) + + -- Just continue update process status when have view display. + counter <- readTVarIO $ processBufferViewCounter buffer + when (counter > 0) $ processBufferUpdate buffer return () return False) priorityHigh @@ -200,3 +213,14 @@ | priority > -5 = "Normal" | otherwise = "High" +-- | Diff process status. +-- Return new (add, change) status. +diffProcessStatus :: [ProcStatus] -> [ProcStatus] -> ([ProcStatus], [ProcStatus]) +diffProcessStatus [] _ = ([], []) +diffProcessStatus (x:xs) oldStatus = + let (add, diff) = + case find (\y -> psProcessId x == psProcessId y) oldStatus of + Just a -> if x == a then ([], []) else ([], [x]) + Nothing -> ([x], []) + in ((++) add *** (++) diff) (diffProcessStatus xs oldStatus) + diff --git a/Manatee/Extension/ProcessManager/ProcessView.hs b/Manatee/Extension/ProcessManager/ProcessView.hs --- a/Manatee/Extension/ProcessManager/ProcessView.hs +++ b/Manatee/Extension/ProcessManager/ProcessView.hs @@ -122,7 +122,7 @@ case signal of KillProcess index -> listStoreRemove (processViewListStore view) index - UpdateProcesses -> do + UpdateProcesses updateInfos -> do -- Get selected process id before update. pid <- treeViewGetSelectedValue (processViewTreeView view) @@ -132,7 +132,7 @@ return $ Just $ psProcessId info -- Update process view. - processViewUpdate view + processViewUpdate view updateInfos -- Restore select path after update. pid ?>= \id -> do @@ -173,17 +173,26 @@ return () -- | Update process view. -processViewUpdate :: ProcessView -> IO () -processViewUpdate view = do +processViewUpdate :: ProcessView -> ([ProcStatus], [ProcStatus], [ProcStatus]) -> IO () +processViewUpdate view (addInfos, deleteInfos, diffInfos) = do -- Get value. let store = processViewListStore view - fileInfos <- readTVarIO $ processBufferStatus $ processViewBuffer view - -- Append to list store. - listStoreClear store - forM_ fileInfos (listStoreAppend store) + -- Delete old process first. + forM_ deleteInfos $ \deleteItem -> do + list <- listStoreToList (processViewListStore view) + findIndex (\x -> psProcessId x == psProcessId deleteItem) list ?>= \ i -> + listStoreRemove store i - return () + -- Update change value. + forM_ diffInfos $ \diffItem -> do + list <- listStoreToList (processViewListStore view) + findIndex (\x -> psProcessId x == psProcessId diffItem) list ?>= \ i -> + listStoreSetValue store i diffItem + + -- Add new process. + forM_ addInfos $ \addItem -> + listStoreAppend store addItem -- | Internal sort function. processViewSortInternal :: ProcessView -> (ProcOption, SortType) -> IO () diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,21 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + import Distribution.Simple import Manatee.Core.Config import Manatee.Core.Types @@ -16,4 +34,9 @@ writeConfig pageModeRulePath (PageModeRule (M.insert "PageProcessManager" (Left $ pageModeName processManagerMode) modeRule)) + -- Update ExtensionGloalKeymap. + (ExtensionGloalKeymap keymap) <- readConfig extensionGlobalKeymapPath (ExtensionGloalKeymap M.empty) + writeConfig extensionGlobalKeymapPath (ExtensionGloalKeymap + (M.insert "F2" ("PageProcessManager", "ProcessManager", []) keymap)) + } diff --git a/manatee-processmanager.cabal b/manatee-processmanager.cabal --- a/manatee-processmanager.cabal +++ b/manatee-processmanager.cabal @@ -1,11 +1,20 @@ name: manatee-processmanager -version: 0.0.2 +version: 0.0.3 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE copyright: (c) 2009 ~ 2010 Andy Stewart synopsis: Process manager extension for Manatee. description: manatee-processmanager is process manager extension for Manatee (Haskell/Gtk+ Integrated Live Environment) + . + Manual look + . + Screenshot at + . + IRC channel: + . + irc.freenode.net 6667 <##manatee> + . author: Andy Stewart maintainer: Andy Stewart stability: provisional @@ -19,7 +28,7 @@ location: http://patch-tag.com/r/AndyStewart/manatee-processmanager Library - build-depends: base >= 4 && < 5, manatee-core >= 0.0.2, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, + build-depends: base >= 4 && < 5, manatee-core >= 0.0.3, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, containers >= 0.3.0.0, gtk-serialized-event >= 0.12.0, gtk >= 0.12.0, text >= 0.7.1.0, proc >= 0.0.8 exposed-modules: