diff --git a/Manatee/Core/Config.hs b/Manatee/Core/Config.hs --- a/Manatee/Core/Config.hs +++ b/Manatee/Core/Config.hs @@ -54,6 +54,10 @@ pageModeDuplicateList :: FilePath pageModeDuplicateList = "core/pageModeDuplicateList" +-- | Extension global keymap. +extensionGlobalKeymapPath :: FilePath +extensionGlobalKeymapPath = "core/extensionGlobalKeymap" + -- | Write config file. writeConfig :: Binary a => FilePath -> a -> IO () writeConfig path config = do diff --git a/Manatee/Core/FileOpenRule.hs b/Manatee/Core/FileOpenRule.hs --- a/Manatee/Core/FileOpenRule.hs +++ b/Manatee/Core/FileOpenRule.hs @@ -49,7 +49,7 @@ map (\ (name, pType, prefix) -> (name, \client -> - mkDaemonSignal client NewTab (NewTabArgs pType (prefix ++ filePath))) + mkDaemonSignal client NewTab (NewTabArgs pType (prefix ++ filePath) [])) ) rules else getDefalutRule xs let defaultRule = getDefalutRule rule @@ -77,4 +77,4 @@ -- | Open by default editor. openByDefaultEditor :: FilePath -> Client -> IO () openByDefaultEditor filePath client = - mkDaemonSignal client NewTab (NewTabArgs "PageEditor" filePath) + mkDaemonSignal client NewTab (NewTabArgs "PageEditor" filePath []) diff --git a/Manatee/Core/Render.hs b/Manatee/Core/Render.hs --- a/Manatee/Core/Render.hs +++ b/Manatee/Core/Render.hs @@ -55,7 +55,7 @@ -- | Render process main entry. renderMain :: SpawnProcessArgs -> PageBufferNewFun -> IO () -renderMain (SpawnRenderProcessArgs pageId pType sId pagePath) bufferNewFun = do +renderMain (SpawnRenderProcessArgs pageId pType sId pagePath options) bufferNewFun = do -- Init. unsafeInitGUIForThreadedRTS @@ -72,7 +72,7 @@ client <- mkSessionClientWithName clientName -- Create page buffer. - bufferWrap <- bufferNewFun pagePath client pageId + bufferWrap <- bufferNewFun pagePath options client pageId -- Build render client for listen dbus signal. mkRenderClient client bufferWrap processId pageList pType diff --git a/Manatee/Core/Types.hs b/Manatee/Core/Types.hs --- a/Manatee/Core/Types.hs +++ b/Manatee/Core/Types.hs @@ -91,6 +91,10 @@ | RegexpMatch String deriving (Show, Read, Eq, Ord, Typeable) +data ExtensionGloalKeymap = + ExtensionGloalKeymap (Map String (String, String, [String])) + deriving (Show, Read, Eq, Ord, Typeable) + -- | BufferList newtype BufferList = BufferList (Map PageModeName (Seq Buffer)) @@ -146,7 +150,7 @@ data PageBufferWrap = forall a . PageBuffer a => PageBufferWrap a -- | Page buffer new function. -type PageBufferNewFun = FilePath -> Client -> PageId -> IO PageBufferWrap +type PageBufferNewFun = FilePath -> [String] -> Client -> PageId -> IO PageBufferWrap -- | PageView class. class Typeable a => PageView a where @@ -246,7 +250,7 @@ | NewAnythingProcessConfirmArgs PagePlugId ProcessID | RenderProcessExitArgs PageId ProcessID | RenderProcessExceptionArgs PageId - | NewTabArgs PageType PagePath + | NewTabArgs PageType PagePath [String] | AnythingViewOutputArgs String String (Maybe Int) AnythingKeyPressId | LocalInteractivebarExitArgs | LocalOutputbarUpdateArgs PagePlugId String @@ -292,7 +296,7 @@ | InteractiveSearchArgs AnythingInteractiveType [String] deriving (Show, Eq, Ord, Read) -data SpawnProcessArgs = SpawnRenderProcessArgs PageId PageType SignalBoxId PagePath +data SpawnProcessArgs = SpawnRenderProcessArgs PageId PageType SignalBoxId PagePath [String] | SpawnAnythingProcessArgs AnythingSearchArgs deriving (Show, Eq, Ord, Read) @@ -302,3 +306,4 @@ $(derive makeBinary ''FileOpenRule) $(derive makeBinary ''PageModeRule) $(derive makeBinary ''PageModeDuplicateList) +$(derive makeBinary ''ExtensionGloalKeymap) diff --git a/Manatee/Toolkit/General/Concurrent.hs b/Manatee/Toolkit/General/Concurrent.hs --- a/Manatee/Toolkit/General/Concurrent.hs +++ b/Manatee/Toolkit/General/Concurrent.hs @@ -25,3 +25,7 @@ forkForever :: IO a -> IO () forkForever action = forkIO (forever action) >> return () + +-- | ForkIO_ +forkIO_ :: IO () -> IO () +forkIO_ action = forkIO action >> return () diff --git a/Manatee/Toolkit/General/Misc.hs b/Manatee/Toolkit/General/Misc.hs --- a/Manatee/Toolkit/General/Misc.hs +++ b/Manatee/Toolkit/General/Misc.hs @@ -21,10 +21,19 @@ import Data.List.Split (splitEvery) import Data.Text.Lazy (Text, pack) +import Language.Haskell.Exts.Parser +import Language.Haskell.Exts.Pretty import Manatee.Toolkit.General.Basic import Text.Printf import Text.Regex.TDFA +-- | Pretty show. +prettyShow :: Show a => a -> String +prettyShow = + (\s -> case parseExp s of + ParseOk x -> prettyPrint x + ParseFailed {} -> s) . show + -- | Like =~ , but don't care case sensitive. (=~^) :: (RegexLike Regex source1, RegexMaker Regex CompOption ExecOption source) => source1 -> source -> Bool source =~^ regex = matchTest (makeRegexOpts (defaultCompOpt {caseSensitive = False}) defaultExecOpt regex) source @@ -34,8 +43,9 @@ showText = pack . show -- | Format file size (bytes) to hummable size. -formatFileSizeForDisplay :: Integer -> String -formatFileSizeForDisplay size +-- Defalut use 1 bit after dot if you don't set bit number. +formatFileSizeForDisplay :: Integer -> Int -> String +formatFileSizeForDisplay size bits | size < 2 ^ 10 = humanSize 1 ++ " B" | size < 2 ^ 20 = humanSize (2 ^ 10) ++ " KB" | size < 2 ^ 30 = humanSize (2 ^ 20) ++ " MB" @@ -47,7 +57,9 @@ | size < 2 ^ 90 = humanSize (2 ^ 80) ++ " YB" | size < 2 ^ 100 = humanSize (2 ^ 90) ++ " NB" | size < 2 ^ 110 = humanSize (2 ^ 100) ++ " DB" - where humanSize base = printf "%.1f" (i2d size / base) :: String + where + formatStr = "%." ++ show bits ++ "f" + humanSize base = printf formatStr (i2d size / base) :: String -- | Format float with specify precision. formatFloatN :: Double -> Int -> Double diff --git a/Manatee/Toolkit/General/STM.hs b/Manatee/Toolkit/General/STM.hs --- a/Manatee/Toolkit/General/STM.hs +++ b/Manatee/Toolkit/General/STM.hs @@ -49,6 +49,11 @@ writeTVarIO :: TVar a -> a -> IO () writeTVarIO a b = atomically $ writeTVar a b +-- | The IO version of `writeTVar`. +writeTVarIOM :: TVar a -> IO a -> IO () +writeTVarIOM a f = + f >>= \x -> atomically $ writeTVar a x + -- | Ticket TVar. tickTVar :: TVar Int -> STM Int tickTVar x = readTVar x << modifyTVar x succ diff --git a/Manatee/Toolkit/General/Time.hs b/Manatee/Toolkit/General/Time.hs --- a/Manatee/Toolkit/General/Time.hs +++ b/Manatee/Toolkit/General/Time.hs @@ -72,3 +72,19 @@ <*> pure format <*> (utcToLocalTime <$> getCurrentTimeZone <*> pure (fromSeconds seconds)) + +-- | Convert seconds to (day/hour/min/second) time. +secondToDaytime :: Int -> String +secondToDaytime seconds = + showTime day "d" + ++ showTime hour "h" + ++ showTime min "m" + ++ showTime sec "s" + where sec = seconds `mod` 60 + min = seconds `mod` 3600 `div` 60 + hour = seconds `mod` 86400 `div` 3600 + day = seconds `div` 86400 + showTime time unit = + if time == 0 then "" else show time ++ unit + + diff --git a/Manatee/Toolkit/Gio/Gio.hs b/Manatee/Toolkit/Gio/Gio.hs --- a/Manatee/Toolkit/Gio/Gio.hs +++ b/Manatee/Toolkit/Gio/Gio.hs @@ -198,3 +198,12 @@ pixbuf <- fileInfoGetIconPixbuf info return $ M.insert fMime pixbuf database +-- | Update file icon database. +updateFileIconPixbufDatabaseWithFilePath :: FilePath -> FileIconPixbufDatabase -> IO FileIconPixbufDatabase +updateFileIconPixbufDatabaseWithFilePath filepath database = do + (_, fMime) <- contentTypeGuess filepath "" 0 + case findMinMatch database (\ mime _ -> mime == fMime) of + Just _ -> return database + Nothing -> do + pixbuf <- getIconPixbuf (contentTypeGetIcon fMime) + return $ M.insert fMime pixbuf database diff --git a/Manatee/Toolkit/Gtk/Gtk.hs b/Manatee/Toolkit/Gtk/Gtk.hs --- a/Manatee/Toolkit/Gtk/Gtk.hs +++ b/Manatee/Toolkit/Gtk/Gtk.hs @@ -128,14 +128,18 @@ -- | Create image widget with given icon name and size. imageNewFromIcon :: String -> Int -> IO Image imageNewFromIcon iconName size = do - iconTheme <- iconThemeGetDefault - pixbuf <- do - -- Function 'iconThemeLoadIcon' can scale icon with specified size. - pixbuf <- iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin - case pixbuf of - Just p -> return p - Nothing -> error $ "imageNewFromIcon : search icon " ++ iconName ++ " failed." + pixbuf <- pixbufNewFromIcon iconName size imageNewFromPixbuf pixbuf + +-- | Get pixbuf from give icon name and size. +pixbufNewFromIcon :: String -> Int -> IO Pixbuf +pixbufNewFromIcon iconName size = do + iconTheme <- iconThemeGetDefault + -- Function 'iconThemeLoadIcon' can scale icon with specified size. + pixbuf <- iconThemeLoadIcon iconTheme iconName size IconLookupUseBuiltin + case pixbuf of + Just p -> return p + Nothing -> error $ "pixbufNewFromIcon : search icon " ++ iconName ++ " failed." -- | Set position of paned. panedAdjustSize :: PanedClass self => self -> Int -> 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 main = defaultMain diff --git a/manatee-core.cabal b/manatee-core.cabal --- a/manatee-core.cabal +++ b/manatee-core.cabal @@ -1,12 +1,22 @@ name: manatee-core -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: The core of Manatee. -description: manatee-core is core package of Manatee (Haskell/Gtk+ Integrated Live Environment) - To provide basic communication protocol and toolkit. +description: manatee-core is core package of Manatee (Haskell/Gtk+ Integrated Live Environment) + . + To provide basic communication protocol and toolkit. + . + Manual look + . + Screenshot at + . + IRC channel: + . + irc.freenode.net 6667 <##manatee> + . author: Andy Stewart maintainer: Andy Stewart stability: provisional @@ -27,7 +37,7 @@ filepath >= 1.1.0.3, unix >= 2.4.0.0, process >= 1.0.1.2, array >= 0.3.0.0, old-time >= 1.0.0.3, glib >= 0.12.0, time >= 1.1.4, gtksourceview2 >= 0.12.0, Cabal >= 1.8.0.2, old-locale >= 1.0.0.2, datetime >= 0.2, bytestring, split, dataenc, - derive, gconf >= 0.12.0, binary, directory + derive, gconf >= 0.12.0, binary, directory, haskell-src-exts exposed-modules: Manatee.Core.DBus Manatee.Core.Debug