manatee-processmanager 0.0.2 → 0.0.3
raw patch · 5 files changed
+88/−22 lines, 5 filesdep ~manatee-coresetup-changed
Dependency ranges changed: manatee-core
Files
- Main.hs +2/−1
- Manatee/Extension/ProcessManager/ProcessBuffer.hs +34/−10
- Manatee/Extension/ProcessManager/ProcessView.hs +18/−9
- Setup.hs +23/−0
- manatee-processmanager.cabal +11/−2
Main.hs view
@@ -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)
Manatee/Extension/ProcessManager/ProcessBuffer.hs view
@@ -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)+
Manatee/Extension/ProcessManager/ProcessView.hs view
@@ -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 ()
Setup.hs view
@@ -1,3 +1,21 @@+-- Author: Andy Stewart <lazycat.manatee@gmail.com>+-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+ 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))+ }
manatee-processmanager.cabal view
@@ -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 <http://haskell.org/haskellwiki/Manatee>+ .+ Screenshot at <http://goo.gl/MkVw>+ .+ IRC channel: + .+ irc.freenode.net 6667 <##manatee>+ . author: Andy Stewart maintainer: Andy Stewart <lazycat.manatee@gmail.com> 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: