Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Daniel W. <dm...@lu...> - 2012-02-13 03:24:02
|
I am attempting to get this list functional again. I've tested all the other steps I can think of, and they individually seem to be working -- I've even got a repository that mails my personal address every time it receives a patch. But still no dice on the mailing list. The only thing I can think of now is that my emails are getting rejected from the list. This is supposed to be a minimal test of that hypothesis. Sorry for the interruption to your normal email reading routine! ~d |
|
From: Andy S. <And...@co...> - 2010-11-07 12:44:38
|
diffing dir...
Sun Nov 7 07:43:41 EST 2010 Andy Stewart <laz...@gm...>
* Support ghc-7
Ignore-this: 9b8ffc0ca7cb17e46774940c9b19b57f
{
hunk ./cairo/Gtk2HsSetup.hs 26
+#if (__GLASGOW_HASKELL__ >= 700)
+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)
+#else
hunk ./cairo/Gtk2HsSetup.hs 35
+#endif
hunk ./cairo/Gtk2HsSetup.hs 198
+#if CABAL_VERSION_CHECK(1,10,0)
+ installedPkgInfo pkg lbi inplace [packageDb]
+#else
hunk ./cairo/Gtk2HsSetup.hs 202
+#endif
hunk ./gio/Gtk2HsSetup.hs 26
+#if (__GLASGOW_HASKELL__ >= 700)
+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)
+#else
hunk ./gio/Gtk2HsSetup.hs 35
+#endif
hunk ./gio/Gtk2HsSetup.hs 198
+#if CABAL_VERSION_CHECK(1,10,0)
+ installedPkgInfo pkg lbi inplace [packageDb]
+#else
hunk ./gio/Gtk2HsSetup.hs 202
+#endif
hunk ./glib/Gtk2HsSetup.hs 26
+#if (__GLASGOW_HASKELL__ >= 700)
+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)
+#else
hunk ./glib/Gtk2HsSetup.hs 35
+#endif
hunk ./glib/Gtk2HsSetup.hs 198
+#if CABAL_VERSION_CHECK(1,10,0)
+ installedPkgInfo pkg lbi inplace [packageDb]
+#else
hunk ./glib/Gtk2HsSetup.hs 202
+#endif
hunk ./gtk/Gtk2HsSetup.hs 26
+#if (__GLASGOW_HASKELL__ >= 700)
+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)
+#else
hunk ./gtk/Gtk2HsSetup.hs 35
+#endif
hunk ./gtk/Gtk2HsSetup.hs 198
+#if CABAL_VERSION_CHECK(1,10,0)
+ installedPkgInfo pkg lbi inplace [packageDb]
+#else
hunk ./gtk/Gtk2HsSetup.hs 202
+#endif
hunk ./pango/Gtk2HsSetup.hs 26
+#if (__GLASGOW_HASKELL__ >= 700)
+#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)
+#else
hunk ./pango/Gtk2HsSetup.hs 35
+#endif
hunk ./pango/Gtk2HsSetup.hs 198
+#if CABAL_VERSION_CHECK(1,10,0)
+ installedPkgInfo pkg lbi inplace [packageDb]
+#else
hunk ./pango/Gtk2HsSetup.hs 202
+#endif
}
|
|
From: Andy S. <And...@co...> - 2010-11-04 16:40:46
|
diffing dir...
Thu Nov 4 12:39:07 EDT 2010 Andy Stewart <laz...@gm...>
* Add 'widgetGetClipboard'
Ignore-this: 60c03fd13424d6d7f2604a67f6c04a03
{
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 179
- --widgetGetClipboard,
+ widgetGetClipboard,
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 382
+import Graphics.UI.Gtk.General.DNDTypes (Atom (Atom), SelectionTag)
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 1827
+-- | Returns the clipboard object for the given selection to
+-- be used with widget. widget must have a 'Display'
+-- associated with it, so must be attached to a toplevel
+-- window.
+widgetGetClipboard :: WidgetClass self => self
+ -> SelectionTag -- ^ @selection@ a 'Atom' which identifies the clipboard
+ -- to use. 'selectionClipboard' gives the
+ -- default clipboard. Another common value
+ -- is 'selectionPrimary', which gives
+ -- the primary X selection. [_$_]
+ -> IO Clipboard -- ^ returns the appropriate clipboard object. If no
+ -- clipboard already exists, a new one will
+ -- be created. [_$_]
+widgetGetClipboard self (Atom tagPtr) = [_$_]
+ makeNewGObject mkClipboard $
+ {#call gtk_widget_get_clipboard #} [_$_]
+ (toWidget self)
+ tagPtr
+
}
|
|
From: Andy S. <And...@co...> - 2010-10-29 13:13:46
|
diffing dir...
Fri Oct 29 09:12:18 EDT 2010 Andy Stewart <laz...@gm...>
* Fix compile problem with demo/treelist/TreeSort.hs
Ignore-this: ee92209aaa6a1ab873af1e511edfe324
hunk ./gtk/demo/treelist/TreeSort.hs 21
- New.treeSortableSetDefaultSortFunc model $ \iter1 iter2 -> do
+ New.treeSortableSetDefaultSortFunc model $ Just $ \iter1 iter2 -> do
|
|
From: Andy S. <And...@co...> - 2010-10-29 04:52:23
|
diffing dir...
Thu Oct 28 23:33:26 EDT 2010 Andy Stewart <laz...@gm...>
* fileFromParseName should use 'String -> File'
Ignore-this: 2ca279d7428b547676673a49ba113c27
* Convert between 'ByteString' and 'File'
** fileFromPath :: ByteString -> File
** filePath :: File -> ByteString
* Convert between 'UTF8 String' and 'File'
** fileFromParseName :: String -> File
** fileParseName :: File -> String
{
hunk ./gio/System/GIO/File/File.chs 295
-fileFromParseName :: ByteString -> File
+fileFromParseName :: String -> File
hunk ./gio/System/GIO/File/File.chs 298
- useAsCString parseName $ \cParseName -> {# call file_parse_name #} cParseName [_$_]
+ withUTFString parseName $ \cParseName -> {# call file_parse_name #} cParseName [_$_]
}
|
|
From: Andy S. <And...@co...> - 2010-10-27 00:07:09
|
diffing dir...
Tue Oct 26 19:43:06 EDT 2010 Andy Stewart <laz...@gm...>
* I think 'fileInfoNew' and 'fileInfoDup' won't cause segfault with 'wrapNewGObject'
Ignore-this: 8d2da9ae90b808cf67052aa40c1fb5ba
{
hunk ./gio/System/GIO/File/FileInfo.chs 153
- makeNewGObject mkFileInfo $
+ wrapNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/FileInfo.chs 159
- makeNewGObject mkFileInfo $
+ wrapNewGObject mkFileInfo $
}
|
|
From: Andy S. <And...@co...> - 2010-10-27 00:07:07
|
diffing dir...
Tue Oct 26 16:37:23 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] revert to makeNewGObject for mkFileInfo
Ignore-this: faefc792ce9f84f85c0063e1d213555b
{
hunk ./gio/System/GIO/File/File.chs 761
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/File.chs 803
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/File.chs 879
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/File.chs 918
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/FileEnumerator.chs 153
- mapM (wrapNewGObject mkFileInfo . return) infoPtrs
+ mapM (makeNewGObject mkFileInfo . return) infoPtrs
hunk ./gio/System/GIO/File/FileInfo.chs 153
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
hunk ./gio/System/GIO/File/FileInfo.chs 159
- wrapNewGObject mkFileInfo $
+ makeNewGObject mkFileInfo $
}
|
|
From: Andy S. <laz...@gm...> - 2010-10-26 15:45:33
|
Axel Simon <Axe...@in...> writes: > No no no! > > Andy, > > these examples all use the new TreeModel modules! They just live in that directory for historic > reasons! > > I guess I have to unrecord these changes... Oh sorry, i have revert the changes for ./demo/treelist Anyway, TreeList modules should go, i have ask Duncan in #haskell, he said it's no problem to his project, he will stick on old gtk2hs. -- Andy |
|
From: Andy S. <And...@co...> - 2010-10-26 15:44:47
|
diffing dir...
Tue Oct 26 11:41:21 EDT 2010 Andy Stewart <laz...@gm...>
* Use 'treelist' as directory name for historic reason
Ignore-this: 82ca5bc77bbefaea65e0dd4a9d888368
{
binary ./gtk/demo/modelview/resListDND/desktop.png
rmfile ./gtk/demo/modelview/resListDND/desktop.png
binary ./gtk/demo/modelview/resListDND/laptop.png
rmfile ./gtk/demo/modelview/resListDND/laptop.png
binary ./gtk/demo/modelview/resListDND/laptopSmall.png
rmfile ./gtk/demo/modelview/resListDND/laptopSmall.png
binary ./gtk/demo/modelview/resListDND/printer.png
rmfile ./gtk/demo/modelview/resListDND/printer.png
binary ./gtk/demo/modelview/resListDND/server.png
rmfile ./gtk/demo/modelview/resListDND/server.png
binary ./gtk/demo/modelview/resListDND/tower.png
rmfile ./gtk/demo/modelview/resListDND/tower.png
rmdir ./gtk/demo/modelview/resListDND
hunk ./gtk/demo/modelview/Completion.hs 1
--- Demo to show off entry completion.
-
-import Graphics.UI.Gtk
-import Data.Char
-import Data.List
-
-data ColorDesc = ColorDesc {
- cdColor :: Color,
- cdName :: String
- } deriving Show
-
-compareCol :: ColumnId ColorDesc String
-compareCol = makeColumnIdString 0
-
-invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b)
---Color (65535-r) (65535-g) (65535-b)
-
-parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name))
- where
- s1 = dropWhile isSpace s
- (s2,s3) = span isDigit s1
- s4 = dropWhile isSpace s3
- (s5,s6) = span isDigit s4
- s7 = dropWhile isSpace s6
- (s8,s9) = span isDigit s7
- n1 = read ('0':s2)
- n2 = read ('0':s5)
- n3 = read ('0':s8)
- c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3)
- name = dropWhile isSpace s9
- upperToSpace [] = []
- upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs
- | otherwise = x:upperToSpace xs
-
-main =
- do
- initGUI
- window <- windowNew
-
- contents <- readFile "rgb.txt"
- let killDups [] = []
- killDups [x] = [x]
- killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs)
- | otherwise = x:killDups (y:xs)
- cols = killDups $ map parseColor (drop 1 (lines contents))
- store <- listStoreNew cols
- customStoreSetColumn store compareCol cdName
-
- entry <- entryNew
- completion <- entryCompletionNew
- entrySetCompletion entry completion
-
- set completion [entryCompletionModel := Just store]
- cell <- cellRendererTextNew
- set cell [cellTextBackgroundSet := True,
- cellTextForegroundSet := True]
- cellLayoutPackStart completion cell True
- cellLayoutSetAttributes completion cell store
- (\cd -> [cellText := cdName cd,
- cellTextBackgroundColor := cdColor cd,
- cellTextForegroundColor := invertColor (cdColor cd)])
- entryCompletionSetMatchFunc completion (matchFunc store)
- on completion matchSelected $ \model iter -> do
- color <- treeModelGetValue model iter compareCol
- entrySetText entry color
- return True
- set window [containerChild := entry]
- widgetShowAll window
- onDestroy window mainQuit
- mainGUI
-
-matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool
-matchFunc model str iter = do
- --putStrLn ("iter is "++show iter)
- tp <- treeModelGetPath model iter
- r <- case tp of
- (i:_) -> do row <- listStoreGetValue model i
- return $ any (isPrefixOf (map toLower str))
- (words (map toLower (cdName row)))
- otherwise -> return False
- return r
rmfile ./gtk/demo/modelview/Completion.hs
hunk ./gtk/demo/modelview/DirList.hs 1
-{-# OPTIONS -cpp #-}
--- Test file for the ListView widget.
-module Main(main) where
-
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.ModelView as New
-
-import Control.Exception
-import System.Directory
-import System.IO
-import System.Locale
-import System.Time
-
-data FileInfo = FileInfo {
- fName :: String,
- fSize :: Integer,
- fTime :: ClockTime
-}
-
-main = do
- initGUI
- win <- windowNew
- win `onDestroy` mainQuit
-
- curDir <- getCurrentDirectory
- files <- getDirectoryContents curDir
- fInfos <- (flip mapM) files $ \f -> do
- s <- handle (\e ->
-#if __GLASGOW_HASKELL__>=610
- case e :: SomeException of
- e ->
-#endif
- return 0) $ do
- h <- openFile f ReadMode
- s <- hFileSize h
- hClose h
- return s
- t <- getModificationTime f
- return FileInfo { fName = f
- , fSize = s
- , fTime = t }
-
- store <- New.listStoreNew fInfos
-
- tv <- New.treeViewNewWithModel store
- containerAdd win tv
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "File name"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- name <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc name True
- New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName = name } ->
- [ New.cellText := name ]
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "Size"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- size <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc size True
- New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize = size } ->
- [ New.cellText := show size ]
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "Modification time"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- time <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc time True
- New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime = time } ->
- [ New.cellText :=> do
- calTime <- toCalendarTime time
- return (formatCalendarTime defaultTimeLocale "%D %T" calTime)
- ]
-
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/modelview/DirList.hs
hunk ./gtk/demo/modelview/FilterDemo.hs 1
--- a demo that shows how to create a normal tree view and a tree view in
--- which only a chosen subset of rows are shown (namely those with upper case letters)
-module Main ( main ) where
-
-import Graphics.UI.Gtk
-import Data.List
-import Data.Char
-import Debug.Trace
-
--- | Define a virtual column of the model that determines the visibility of a row in
--- the model.
-visCol :: ColumnId String Bool
-visCol = makeColumnIdBool 0
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- content <- readFile "FilterDemo.hs"
-
- -- create a view that shows all lines
- model <- listStoreNew (lines content)
- viewAll <- treeViewNewWithModel model
- col <- treeViewColumnNew
- ren <- cellRendererTextNew
- cellLayoutPackStart col ren True
- cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
- treeViewAppendColumn viewAll col
-
- -- create a view that only shows lines with upper case characters
- fModel <- treeModelFilterNew model []
-
- -- create a virtual column 'visCol' that contains @True@ if a certain row has
- -- upper case letters. Then set this column to determine the visibility of a row.
- customStoreSetColumn model visCol (any isUpper)
- treeModelFilterSetVisibleColumn fModel visCol
-
-{-
- -- this is an alternative way to determine the visibility of a row. In this case,
- -- it is not necessary to create the column 'visCol'.
- treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do
- row <- treeModelGetRow model iter
- return (any isUpper row)
--}
- -- note: it is important to insert the model into the view after the visibility
- -- row or the visibility function have been set. Otherwise, the view is filled
- -- first and setting a new visibility column/function will not update the view.
- viewFew <- treeViewNewWithModel fModel
- col <- treeViewColumnNew
- ren <- cellRendererTextNew
- cellLayoutPackStart col ren True
- cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
-
- treeViewAppendColumn viewFew col
-
-
-
- box <- vBoxNew False 0
- swAll <- scrolledWindowNew Nothing Nothing
- containerAdd swAll viewAll
- boxPackStart box swAll PackGrow 4
-
- swFew <- scrolledWindowNew Nothing Nothing
- containerAdd swFew viewFew
- boxPackEnd box swFew PackGrow 4
-
- containerAdd win box
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/modelview/FilterDemo.hs
hunk ./gtk/demo/modelview/ListDND.hs 1
-module Main where
-
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.Gdk.EventM
-
-import System.Glib.GObject ( toGObject )
-import System.FilePath
-import Control.Concurrent.MVar
-import Control.Monad ( liftM )
-import Control.Monad.Trans ( liftIO )
-import Data.Maybe ( fromMaybe )
-import Data.List ( findIndex )
-
-roomStrCol :: ColumnId String String
-roomStrCol = makeColumnIdString 1
-
--- Define a string column and an image column on the store holding the
--- computer types.
-compPicCol :: ColumnId CompType Pixbuf
-compPicCol = makeColumnIdPixbuf 1
-
-compStrCol :: ColumnId CompType String
-compStrCol = makeColumnIdString 2
-
-data Computer = Computer {
- name :: String,
- addr :: (Int, Int, Int, Int),
- roomStore :: ListStore String,
- roomSel :: Int,
- cType :: CompType }
-
-data CompType
- = MacBookPro
- | MacBook
- | Printer
- | MacPro
- | Xserve
- | IMac
- deriving (Enum, Bounded, Show)
-
-showCT :: CompType -> String
-showCT ct = case show ct of
- 'I':xs -> 'i':xs
- xs -> xs
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- -- create a tag that we use as selection, target and selection type
- compTypeTag <- atomNew "_CompType"
-
- let pNames = map ("resListDND" </>)
- ["laptop.png","laptopSmall.png","printer.png",
- "tower.png","server.png","desktop.png"]
- pics <- mapM pixbufNewFromFile pNames
-
- smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames
-
- [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew
- [["Paul (Home)","John (Home)","Fred (Home)"],
- ["N12","S112", "S113", "S114"],
- ["Server Room Upstairs", "Server Room Downstairs"]]
-
- -- define extractor function for the string column
- treeModelSetColumn noRoom roomStrCol id
- treeModelSetColumn publicRoom roomStrCol id
- treeModelSetColumn restrictedRoom roomStrCol id
-
- let genRoomStore MacBookPro = noRoom
- genRoomStore MacBook = noRoom
- genRoomStore Printer = publicRoom
- genRoomStore MacPro = publicRoom
- genRoomStore Xserve = restrictedRoom
- genRoomStore IMac = publicRoom
-
- -- the initial computer list - it's a coincidence that there's
- -- one computer of each type
- content <- listStoreNewDND
- (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1),
- roomStore = genRoomStore t, roomSel = 0, cType = t})
- [minBound :: CompType .. maxBound])
- (Just listStoreDefaultDragSourceIface)
- (Just DragDestIface {
- treeDragDestRowDropPossible = \store path@(i:_) -> do
- mCT <- selectionDataGet compTypeTag
- case mCT :: Maybe [Int] of
- Just [ct] -> return True
- Nothing ->
- (treeDragDestRowDropPossible listStoreDefaultDragDestIface)
- store path
- _ -> return False,
- treeDragDestDragDataReceived = \store path@(i:_) -> do
- mCT <- selectionDataGet compTypeTag
- case mCT of
- Just [ct] -> do
- let t = toEnum ct
- liftIO $ listStoreInsert store i
- Computer { name = showCT t, addr = (192,168,0,254),
- roomStore = genRoomStore t, roomSel = 0,
- cType = t }
- return True
- Nothing ->
- (treeDragDestDragDataReceived listStoreDefaultDragDestIface)
- store path
- })
- -- the area with the possible computer types
- compTypes <- listStoreNewDND [minBound :: CompType .. maxBound]
- (Just DragSourceIface {
- treeDragSourceRowDraggable = \store (i:_) -> return True,
- treeDragSourceDragDataGet = \store (i:_) -> do
- ty <- selectionDataGetTarget
- ct <- liftIO $ listStoreGetValue store i
- selectionDataSet compTypeTag [fromEnum ct]
- return True,
- treeDragSourceDragDataDelete = \store path -> return True
- })
- Nothing
-
- -- define extractor functions for the two column
- treeModelSetColumn compTypes compPicCol $
- \t -> pics !! fromEnum t
- treeModelSetColumn compTypes compStrCol showCT
-
- -- create an icon view of all the computer types
- typesView <- iconViewNew
- set typesView [iconViewModel := Just compTypes,
- iconViewPixbufColumn := compPicCol,
- iconViewTextColumn := compStrCol,
- iconViewColumns := 6]
-
- -- create an editable list of computers
- inventory <- treeViewNewWithModel content
-
- tyCol <- treeViewColumnNew
- treeViewColumnSetTitle tyCol "Type"
- picRen <- cellRendererPixbufNew
- treeViewColumnPackStart tyCol picRen False
- cellLayoutSetAttributes tyCol picRen content
- (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t])
- tyRen <- cellRendererTextNew
- treeViewColumnPackStart tyCol tyRen False
- cellLayoutSetAttributes tyCol tyRen content
- (\Computer { cType = t} -> [cellText := showCT t])
- treeViewAppendColumn inventory tyCol
-
- nameCol <- treeViewColumnNew
- treeViewColumnSetTitle nameCol "Name"
- treeViewColumnSetResizable nameCol True
- treeViewColumnSetMinWidth nameCol 100
- nameRen <- cellRendererTextNew
- set nameRen [ cellTextEditable := True,
- cellTextEditableSet := True,
- cellTextEllipsize := EllipsizeEnd,
- cellTextEllipsizeSet := True]
- treeViewColumnPackStart nameCol nameRen True
- cellLayoutSetAttributes nameCol nameRen content
- (\Computer { name = n } -> [cellText := n])
- treeViewAppendColumn inventory nameCol
- on nameRen edited $ \[i] str -> do
- val <- listStoreGetValue content i
- listStoreSetValue content i val { name = str }
-
- addrCol <- treeViewColumnNew
- treeViewColumnSetTitle addrCol "Address"
- oct1 <- cellRendererTextNew
- dot1 <- cellRendererTextNew
- oct2 <- cellRendererTextNew
- dot2 <- cellRendererTextNew
- oct3 <- cellRendererTextNew
- dot3 <- cellRendererTextNew
- oct4 <- cellRendererTextNew
- mapM_ (uncurry (cellLayoutPackStart addrCol))
- [(oct1, True), (dot1, False), (oct2, True),
- (dot2, False), (oct3, True), (dot3, False), (oct4, True)]
- mapM_ (\d -> set d [cellText := ".",
- cellTextWidthChars := 0]) [dot1, dot2, dot3]
- mapM_ (\o -> set o [cellXAlign := 1.0,
- cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4]
- cellLayoutSetAttributes addrCol oct1 content
- (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1])
- cellLayoutSetAttributes addrCol oct2 content
- (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2])
- cellLayoutSetAttributes addrCol oct3 content
- (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3])
- cellLayoutSetAttributes addrCol oct4 content
- (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4])
- treeViewAppendColumn inventory addrCol
-
- roomCol <- treeViewColumnNew
- treeViewColumnSetTitle roomCol "Room"
- treeViewColumnSetResizable roomCol True
- treeViewColumnSetSizing roomCol TreeViewColumnAutosize
- roomRen <- cellRendererComboNew
- set roomRen [ cellTextEditable := True,
- cellTextEditableSet := True,
- cellComboHasEntry := True ]
- treeViewColumnPackStart roomCol roomRen True
- cellLayoutSetAttributes roomCol roomRen content
- (\Computer { roomStore = t, roomSel = idx } ->
- [cellText :=> listStoreGetValue t idx,
- cellComboTextModel := (t, roomStrCol)])
- on roomRen edited $ \[i] str -> do
- row@Computer { roomStore = t } <- listStoreGetValue content i
- elems <- listStoreToList t
- idx <- case (findIndex ((==) str) elems) of
- Just idx -> return idx
- Nothing -> listStoreAppend t str
- listStoreSetValue content i row { roomSel = idx }
- treeViewAppendColumn inventory roomCol
-
- -- make typesView a drag source for compTypeTag values
- tl <- targetListNew
- targetListAdd tl compTypeTag [TargetSameApp] 0
- iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy]
-
- -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in
- -- the DND source handler is not called unless the IconView is also
- -- set to be a DND destination. Bugzilla 550528
- tl <- targetListNew
- iconViewEnableModelDragDest typesView tl []
-
- -- make the inventory widget a drag destination for compTypeTag values
- tl <- targetListNew
- targetListAdd tl compTypeTag [TargetSameApp] 0
- targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
- treeViewEnableModelDragDest inventory tl [ActionMove]
- tl <- targetListNew
- targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
- treeViewEnableModelDragSource inventory [Button1] tl [ActionMove]
-
- -- Install drag and drop for permuting rows. This is now done above using
- -- the explicit target 'targetTreeModelRow'. Calling the function below
- -- will set a completely new 'TargetList' thereby removing our own
- -- 'compTypeTag' from the inventory widget's target list.
-
- --treeViewSetReorderable inventory True
-
- -- arrange the widgets
- v <- vPanedNew
- panedAdd1 v typesView
- panedAdd2 v inventory
- containerAdd win v
-
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/modelview/ListDND.hs
hunk ./gtk/demo/modelview/ListDemo.hs 1
-module Main where
-
-import Graphics.UI.Gtk
-import System.Glib.Signals (on)
-import Data.List ( isPrefixOf )
-import Data.Char ( toLower )
-
-data Phone = Phone { name :: String, number :: Int, marked :: Bool }
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- -- create a new list model
- model <- listStoreNew
- [Phone { name = "Foo", number = 12345, marked = False }
- ,Phone { name = "Bar", number = 67890, marked = True }
- ,Phone { name = "Baz", number = 39496, marked = False }]
- view <- treeViewNewWithModel model
-
- treeViewSetHeadersVisible view True
-
- -- add a couple columns
- col1 <- treeViewColumnNew
- col2 <- treeViewColumnNew
- col3 <- treeViewColumnNew
-
- treeViewColumnSetTitle col1 "String column"
- treeViewColumnSetTitle col2 "Int column"
- treeViewColumnSetTitle col3 "Bool column"
-
- renderer1 <- cellRendererTextNew
- renderer2 <- cellRendererTextNew
- renderer3 <- cellRendererToggleNew
-
- cellLayoutPackStart col1 renderer1 True
- cellLayoutPackStart col2 renderer2 True
- cellLayoutPackStart col3 renderer3 True
-
- cellLayoutSetAttributes col1 renderer1 model $ \row -> [ cellText := name row ]
- cellLayoutSetAttributes col2 renderer2 model $ \row -> [ cellText := show (number row) ]
- cellLayoutSetAttributes col3 renderer3 model $ \row -> [ cellToggleActive := marked row ]
-
- treeViewAppendColumn view col1
- treeViewAppendColumn view col2
- treeViewAppendColumn view col3
-
- -- update the model when the toggle buttons are activated
- on renderer3 cellToggled $ \pathStr -> do
- let (i:_) = stringToTreePath pathStr
- val <- listStoreGetValue model i
- listStoreSetValue model i val { marked = not (marked val) }
-
-
- -- enable interactive search
- treeViewSetEnableSearch view True
- treeViewSetSearchEqualFunc view $ Just $ \str iter -> do
- (i:_) <- treeModelGetPath model iter
- row <- listStoreGetValue model i
- return (map toLower str `isPrefixOf` map toLower (name row))
-
- containerAdd win view
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/modelview/ListDemo.hs
hunk ./gtk/demo/modelview/ListTest.glade 1
-<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
-<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
-
-<glade-interface>
-
-<widget class="GtkWindow" id="window">
- <property name="visible">True</property>
- <property name="title" translatable="yes">List Test</property>
- <property name="type">GTK_WINDOW_TOPLEVEL</property>
- <property name="window_position">GTK_WIN_POS_NONE</property>
- <property name="modal">False</property>
- <property name="resizable">True</property>
- <property name="destroy_with_parent">False</property>
- <property name="decorated">True</property>
- <property name="skip_taskbar_hint">False</property>
- <property name="skip_pager_hint">False</property>
- <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
- <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
- <property name="focus_on_map">True</property>
-
- <child>
- <widget class="GtkVBox" id="vbox1">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
- <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
- <property name="shadow_type">GTK_SHADOW_IN</property>
- <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
-
- <child>
- <widget class="GtkTreeView" id="view">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="headers_visible">True</property>
- <property name="rules_hint">False</property>
- <property name="reorderable">False</property>
- <property name="enable_search">True</property>
- <property name="fixed_height_mode">False</property>
- <property name="hover_selection">False</property>
- <property name="hover_expand">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox1">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox2">
- <property name="border_width">8</property>
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">12</property>
-
- <child>
- <widget class="GtkExpander" id="expander6">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkTable" id="table1">
- <property name="border_width">2</property>
- <property name="visible">True</property>
- <property name="n_rows">3</property>
- <property name="n_columns">2</property>
- <property name="homogeneous">False</property>
- <property name="row_spacing">2</property>
- <property name="column_spacing">18</property>
-
- <child>
- <widget class="GtkSpinButton" id="intValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">True</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">True</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkCheckButton" id="boolValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- <property name="active">False</property>
- <property name="inconsistent">False</property>
- <property name="draw_indicator">True</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">2</property>
- <property name="bottom_attach">3</property>
- <property name="x_options">fill</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label2">
- <property name="visible">True</property>
- <property name="label" translatable="yes">String value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">0</property>
- <property name="bottom_attach">1</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label3">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Number value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label4">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Boolean value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">2</property>
- <property name="bottom_attach">3</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkEntry" id="stringValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="editable">True</property>
- <property name="visibility">True</property>
- <property name="max_length">0</property>
- <property name="text" translatable="yes"></property>
- <property name="has_frame">True</property>
- <property name="invisible_char">*</property>
- <property name="activates_default">False</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">0</property>
- <property name="bottom_attach">1</property>
- <property name="x_options">expand|shrink|fill</property>
- <property name="y_options"></property>
- </packing>
- </child>
- </widget>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label29">
- <property name="visible">True</property>
- <property name="label" translatable="yes"><b>Value</b></property>
- <property name="use_underline">False</property>
- <property name="use_markup">True</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkExpander" id="expander5">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox7">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">2</property>
-
- <child>
- <widget class="GtkHBox" id="hbox9">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="insert">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">insert</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label23">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry at</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="newIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">4</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox7">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="prepend">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">prepend</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label21">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label30">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox8">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="append">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">append</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label22">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label31">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox6">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="update">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">update</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label20">
- <property name="visible">True</property>
- <property name="label" translatable="yes">entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="updateIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
- </widget>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label28">
- <property name="visible">True</property>
- <property name="label" translatable="yes"><b>Insert and Update</b></property>
- <property name="use_underline">False</property>
- <property name="use_markup">True</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkExpander" id="expander1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox8">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">2</property>
-
- <child>
- <widget class="GtkHBox" id="hbox5">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="remove">
- <property name="width_request">54</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">delete</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label19">
- <property name="visible">True</property>
- <property name="label" translatable="yes">entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="removeIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label32">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label33">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox10">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="clear">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">clear</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label34">
- <property name="visible">True</property>
- <property name="label" translatable="yes">all</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label35">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label36">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label37">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- ...
[truncated message content] |
|
From: Axel S. <Axe...@in...> - 2010-10-26 15:28:51
|
No no no!
Andy,
these examples all use the new TreeModel modules! They just live in
that directory for historic reasons!
I guess I have to unrecord these changes...
Axel
On 26.10.2010, at 16:41, Andy Stewart wrote:
> diffing dir...
> Tue Oct 26 10:38:51 EDT 2010 Andy Stewart <laz...@gm...>
> * Remove TreeList modules, we won't support TreeList anymore,
> please switch to Graphics.UI.Gtk.ModelView.*
> Ignore-this: ecae2baa3e98e0f7c513d0867d71c013
> {
> binary ./gtk/demo/treeList/resListDND/desktop.png
> rmfile ./gtk/demo/treeList/resListDND/desktop.png
> binary ./gtk/demo/treeList/resListDND/laptop.png
> rmfile ./gtk/demo/treeList/resListDND/laptop.png
> binary ./gtk/demo/treeList/resListDND/laptopSmall.png
> rmfile ./gtk/demo/treeList/resListDND/laptopSmall.png
> binary ./gtk/demo/treeList/resListDND/printer.png
> rmfile ./gtk/demo/treeList/resListDND/printer.png
> binary ./gtk/demo/treeList/resListDND/server.png
> rmfile ./gtk/demo/treeList/resListDND/server.png
> binary ./gtk/demo/treeList/resListDND/tower.png
> rmfile ./gtk/demo/treeList/resListDND/tower.png
> rmdir ./gtk/demo/treeList/resListDND
> hunk ./gtk/demo/treeList/Completion.hs 1
> --- Demo to show off entry completion.
> -
> -import Graphics.UI.Gtk
> -import Data.Char
> -import Data.List
> -
> -data ColorDesc = ColorDesc {
> - cdColor :: Color,
> - cdName :: String
> - } deriving Show
> -
> -compareCol :: ColumnId ColorDesc String
> -compareCol = makeColumnIdString 0
> -
> -invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b)
> ---Color (65535-r) (65535-g) (65535-b)
> -
> -parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name))
> - where
> - s1 = dropWhile isSpace s
> - (s2,s3) = span isDigit s1
> - s4 = dropWhile isSpace s3
> - (s5,s6) = span isDigit s4
> - s7 = dropWhile isSpace s6
> - (s8,s9) = span isDigit s7
> - n1 = read ('0':s2)
> - n2 = read ('0':s5)
> - n3 = read ('0':s8)
> - c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3)
> - name = dropWhile isSpace s9
> - upperToSpace [] = []
> - upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs
> - | otherwise = x:upperToSpace xs
> -
> -main =
> - do
> - initGUI
> - window <- windowNew
> -
> - contents <- readFile "rgb.txt"
> - let killDups [] = []
> - killDups [x] = [x]
> - killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs)
> - | otherwise = x:killDups (y:xs)
> - cols = killDups $ map parseColor (drop 1 (lines
> contents))
> - store <- listStoreNew cols
> - customStoreSetColumn store compareCol cdName
> -
> - entry <- entryNew
> - completion <- entryCompletionNew
> - entrySetCompletion entry completion
> -
> - set completion [entryCompletionModel := Just store]
> - cell <- cellRendererTextNew
> - set cell [cellTextBackgroundSet := True,
> - cellTextForegroundSet := True]
> - cellLayoutPackStart completion cell True
> - cellLayoutSetAttributes completion cell store
> - (\cd -> [cellText := cdName cd,
> - cellTextBackgroundColor := cdColor cd,
> - cellTextForegroundColor := invertColor (cdColor
> cd)])
> - entryCompletionSetMatchFunc completion (matchFunc store)
> - on completion matchSelected $ \model iter -> do
> - color <- treeModelGetValue model iter compareCol
> - entrySetText entry color
> - return True
> - set window [containerChild := entry]
> - widgetShowAll window
> - onDestroy window mainQuit
> - mainGUI
> -
> -matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool
> -matchFunc model str iter = do
> - --putStrLn ("iter is "++show iter)
> - tp <- treeModelGetPath model iter
> - r <- case tp of
> - (i:_) -> do row <- listStoreGetValue model i
> - return $ any (isPrefixOf (map toLower str))
> - (words (map toLower (cdName
> row)))
> - otherwise -> return False
> - return r
> rmfile ./gtk/demo/treeList/Completion.hs
> hunk ./gtk/demo/treeList/DirList.hs 1
> -{-# OPTIONS -cpp #-}
> --- Test file for the ListView widget.
> -module Main(main) where
> -
> -import Graphics.UI.Gtk
> -import Graphics.UI.Gtk.ModelView as New
> -
> -import Control.Exception
> -import System.Directory
> -import System.IO
> -import System.Locale
> -import System.Time
> -
> -data FileInfo = FileInfo {
> - fName :: String,
> - fSize :: Integer,
> - fTime :: ClockTime
> -}
> -
> -main = do
> - initGUI
> - win <- windowNew
> - win `onDestroy` mainQuit
> -
> - curDir <- getCurrentDirectory
> - files <- getDirectoryContents curDir
> - fInfos <- (flip mapM) files $ \f -> do
> - s <- handle (\e ->
> -#if __GLASGOW_HASKELL__>=610
> - case e :: SomeException of
> - e ->
> -#endif
> - return 0) $ do
> - h <- openFile f ReadMode
> - s <- hFileSize h
> - hClose h
> - return s
> - t <- getModificationTime f
> - return FileInfo { fName = f
> - , fSize = s
> - , fTime = t }
> -
> - store <- New.listStoreNew fInfos
> -
> - tv <- New.treeViewNewWithModel store
> - containerAdd win tv
> -
> - tvc <- New.treeViewColumnNew
> - set tvc [ New.treeViewColumnTitle := "File name"
> - , New.treeViewColumnResizable := True ]
> - New.treeViewAppendColumn tv tvc
> -
> - name <- New.cellRendererTextNew
> - New.treeViewColumnPackStart tvc name True
> - New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName
> = name } ->
> - [ New.cellText := name ]
> -
> - tvc <- New.treeViewColumnNew
> - set tvc [ New.treeViewColumnTitle := "Size"
> - , New.treeViewColumnResizable := True ]
> - New.treeViewAppendColumn tv tvc
> -
> - size <- New.cellRendererTextNew
> - New.treeViewColumnPackStart tvc size True
> - New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize
> = size } ->
> - [ New.cellText := show size ]
> -
> - tvc <- New.treeViewColumnNew
> - set tvc [ New.treeViewColumnTitle := "Modification time"
> - , New.treeViewColumnResizable := True ]
> - New.treeViewAppendColumn tv tvc
> -
> - time <- New.cellRendererTextNew
> - New.treeViewColumnPackStart tvc time True
> - New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime
> = time } ->
> - [ New.cellText :=> do
> - calTime <- toCalendarTime time
> - return (formatCalendarTime defaultTimeLocale "%D %T"
> calTime)
> - ]
> -
> - widgetShowAll win
> - mainGUI
> rmfile ./gtk/demo/treeList/DirList.hs
> hunk ./gtk/demo/treeList/FilterDemo.hs 1
> --- a demo that shows how to create a normal tree view and a tree
> view in
> --- which only a chosen subset of rows are shown (namely those
> with upper case letters)
> -module Main ( main ) where
> -
> -import Graphics.UI.Gtk
> -import Data.List
> -import Data.Char
> -import Debug.Trace
> -
> --- | Define a virtual column of the model that determines the
> visibility of a row in
> --- the model.
> -visCol :: ColumnId String Bool
> -visCol = makeColumnIdBool 0
> -
> -main = do
> - initGUI
> -
> - win <- windowNew
> - onDestroy win mainQuit
> -
> - content <- readFile "FilterDemo.hs"
> -
> - -- create a view that shows all lines
> - model <- listStoreNew (lines content)
> - viewAll <- treeViewNewWithModel model
> - col <- treeViewColumnNew
> - ren <- cellRendererTextNew
> - cellLayoutPackStart col ren True
> - cellLayoutSetAttributes col ren model $ \row -> [ cellText :=
> row ]
> - treeViewAppendColumn viewAll col
> -
> - -- create a view that only shows lines with upper case
> characters
> - fModel <- treeModelFilterNew model []
> -
> - -- create a virtual column 'visCol' that contains @True@ if a
> certain row has
> - -- upper case letters. Then set this column to determine the
> visibility of a row.
> - customStoreSetColumn model visCol (any isUpper)
> - treeModelFilterSetVisibleColumn fModel visCol
> -
> -{-
> - -- this is an alternative way to determine the visibility of a
> row. In this case,
> - -- it is not necessary to create the column 'visCol'.
> - treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do
> - row <- treeModelGetRow model iter
> - return (any isUpper row)
> --}
> - -- note: it is important to insert the model into the view
> after the visibility
> - -- row or the visibility function have been set. Otherwise,
> the view is filled
> - -- first and setting a new visibility column/function will not
> update the view.
> - viewFew <- treeViewNewWithModel fModel
> - col <- treeViewColumnNew
> - ren <- cellRendererTextNew
> - cellLayoutPackStart col ren True
> - cellLayoutSetAttributes col ren model $ \row -> [ cellText :=
> row ]
> -
> - treeViewAppendColumn viewFew col
> -
> -
> -
> - box <- vBoxNew False 0
> - swAll <- scrolledWindowNew Nothing Nothing
> - containerAdd swAll viewAll
> - boxPackStart box swAll PackGrow 4
> -
> - swFew <- scrolledWindowNew Nothing Nothing
> - containerAdd swFew viewFew
> - boxPackEnd box swFew PackGrow 4
> -
> - containerAdd win box
> - widgetShowAll win
> - mainGUI
> rmfile ./gtk/demo/treeList/FilterDemo.hs
> hunk ./gtk/demo/treeList/ListDND.hs 1
> -module Main where
> -
> -import Graphics.UI.Gtk
> -import Graphics.UI.Gtk.Gdk.EventM
> -
> -import System.Glib.GObject ( toGObject )
> -import System.FilePath
> -import Control.Concurrent.MVar
> -import Control.Monad ( liftM )
> -import Control.Monad.Trans ( liftIO )
> -import Data.Maybe ( fromMaybe )
> -import Data.List ( findIndex )
> -
> -roomStrCol :: ColumnId String String
> -roomStrCol = makeColumnIdString 1
> -
> --- Define a string column and an image column on the store
> holding the
> --- computer types.
> -compPicCol :: ColumnId CompType Pixbuf
> -compPicCol = makeColumnIdPixbuf 1
> -
> -compStrCol :: ColumnId CompType String
> -compStrCol = makeColumnIdString 2
> -
> -data Computer = Computer {
> - name :: String,
> - addr :: (Int, Int, Int, Int),
> - roomStore :: ListStore String,
> - roomSel :: Int,
> - cType :: CompType }
> -
> -data CompType
> - = MacBookPro
> - | MacBook
> - | Printer
> - | MacPro
> - | Xserve
> - | IMac
> - deriving (Enum, Bounded, Show)
> -
> -showCT :: CompType -> String
> -showCT ct = case show ct of
> - 'I':xs -> 'i':xs
> - xs -> xs
> -
> -main = do
> - initGUI
> -
> - win <- windowNew
> - onDestroy win mainQuit
> -
> - -- create a tag that we use as selection, target and selection
> type
> - compTypeTag <- atomNew "_CompType"
> -
> - let pNames = map ("resListDND" </>)
> - ["laptop.png","laptopSmall.png","printer.png",
> - "tower.png","server.png","desktop.png"]
> - pics <- mapM pixbufNewFromFile pNames
> -
> - smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48
> True) pNames
> -
> - [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew
> - [["Paul (Home)","John (Home)","Fred (Home)"],
> - ["N12","S112", "S113", "S114"],
> - ["Server Room Upstairs", "Server Room Downstairs"]]
> -
> - -- define extractor function for the string column
> - treeModelSetColumn noRoom roomStrCol id
> - treeModelSetColumn publicRoom roomStrCol id
> - treeModelSetColumn restrictedRoom roomStrCol id
> -
> - let genRoomStore MacBookPro = noRoom
> - genRoomStore MacBook = noRoom
> - genRoomStore Printer = publicRoom
> - genRoomStore MacPro = publicRoom
> - genRoomStore Xserve = restrictedRoom
> - genRoomStore IMac = publicRoom
> -
> - -- the initial computer list - it's a coincidence that there's
> - -- one computer of each type
> - content <- listStoreNewDND
> - (map (\t -> Computer { name = showCT t, addr =
> (192,168,0,fromEnum t+1),
> - roomStore = genRoomStore t, roomSel =
> 0, cType = t})
> - [minBound :: CompType .. maxBound])
> - (Just listStoreDefaultDragSourceIface)
> - (Just DragDestIface {
> - treeDragDestRowDropPossible = \store path@(i:_) -> do
> - mCT <- selectionDataGet compTypeTag
> - case mCT :: Maybe [Int] of
> - Just [ct] -> return True
> - Nothing ->
> - (treeDragDestRowDropPossible
> listStoreDefaultDragDestIface)
> - store path
> - _ -> return False,
> - treeDragDestDragDataReceived = \store path@(i:_) -> do
> - mCT <- selectionDataGet compTypeTag
> - case mCT of
> - Just [ct] -> do
> - let t = toEnum ct
> - liftIO $ listStoreInsert store i
> - Computer { name = showCT t, addr = (192,168,0,254),
> - roomStore = genRoomStore t, roomSel = 0,
> - cType = t }
> - return True
> - Nothing ->
> - (treeDragDestDragDataReceived
> listStoreDefaultDragDestIface)
> - store path
> - })
> - -- the area with the possible computer types
> - compTypes <- listStoreNewDND [minBound :: CompType .. maxBound]
> - (Just DragSourceIface {
> - treeDragSourceRowDraggable = \store (i:_) -> return True,
> - treeDragSourceDragDataGet = \store (i:_) -> do
> - ty <- selectionDataGetTarget
> - ct <- liftIO $ listStoreGetValue store i
> - selectionDataSet compTypeTag [fromEnum ct]
> - return True,
> - treeDragSourceDragDataDelete = \store path -> return True
> - })
> - Nothing
> -
> - -- define extractor functions for the two column
> - treeModelSetColumn compTypes compPicCol $
> - \t -> pics !! fromEnum t
> - treeModelSetColumn compTypes compStrCol showCT
> -
> - -- create an icon view of all the computer types
> - typesView <- iconViewNew
> - set typesView [iconViewModel := Just compTypes,
> - iconViewPixbufColumn := compPicCol,
> - iconViewTextColumn := compStrCol,
> - iconViewColumns := 6]
> -
> - -- create an editable list of computers
> - inventory <- treeViewNewWithModel content
> -
> - tyCol <- treeViewColumnNew
> - treeViewColumnSetTitle tyCol "Type"
> - picRen <- cellRendererPixbufNew
> - treeViewColumnPackStart tyCol picRen False
> - cellLayoutSetAttributes tyCol picRen content
> - (\Computer { cType = t} -> [cellPixbuf := smallPics !!
> fromEnum t])
> - tyRen <- cellRendererTextNew
> - treeViewColumnPackStart tyCol tyRen False
> - cellLayoutSetAttributes tyCol tyRen content
> - (\Computer { cType = t} -> [cellText := showCT t])
> - treeViewAppendColumn inventory tyCol
> -
> - nameCol <- treeViewColumnNew
> - treeViewColumnSetTitle nameCol "Name"
> - treeViewColumnSetResizable nameCol True
> - treeViewColumnSetMinWidth nameCol 100
> - nameRen <- cellRendererTextNew
> - set nameRen [ cellTextEditable := True,
> - cellTextEditableSet := True,
> - cellTextEllipsize := EllipsizeEnd,
> - cellTextEllipsizeSet := True]
> - treeViewColumnPackStart nameCol nameRen True
> - cellLayoutSetAttributes nameCol nameRen content
> - (\Computer { name = n } -> [cellText := n])
> - treeViewAppendColumn inventory nameCol
> - on nameRen edited $ \[i] str -> do
> - val <- listStoreGetValue content i
> - listStoreSetValue content i val { name = str }
> -
> - addrCol <- treeViewColumnNew
> - treeViewColumnSetTitle addrCol "Address"
> - oct1 <- cellRendererTextNew
> - dot1 <- cellRendererTextNew
> - oct2 <- cellRendererTextNew
> - dot2 <- cellRendererTextNew
> - oct3 <- cellRendererTextNew
> - dot3 <- cellRendererTextNew
> - oct4 <- cellRendererTextNew
> - mapM_ (uncurry (cellLayoutPackStart addrCol))
> - [(oct1, True), (dot1, False), (oct2, True),
> - (dot2, False), (oct3, True), (dot3, False), (oct4, True)]
> - mapM_ (\d -> set d [cellText := ".",
> - cellTextWidthChars := 0]) [dot1, dot2, dot3]
> - mapM_ (\o -> set o [cellXAlign := 1.0,
> - cellTextWidthChars := 3]) [oct1, oct2,
> oct3, oct4]
> - cellLayoutSetAttributes addrCol oct1 content
> - (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1])
> - cellLayoutSetAttributes addrCol oct2 content
> - (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2])
> - cellLayoutSetAttributes addrCol oct3 content
> - (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3])
> - cellLayoutSetAttributes addrCol oct4 content
> - (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4])
> - treeViewAppendColumn inventory addrCol
> -
> - roomCol <- treeViewColumnNew
> - treeViewColumnSetTitle roomCol "Room"
> - treeViewColumnSetResizable roomCol True
> - treeViewColumnSetSizing roomCol TreeViewColumnAutosize
> - roomRen <- cellRendererComboNew
> - set roomRen [ cellTextEditable := True,
> - cellTextEditableSet := True,
> - cellComboHasEntry := True ]
> - treeViewColumnPackStart roomCol roomRen True
> - cellLayoutSetAttributes roomCol roomRen content
> - (\Computer { roomStore = t, roomSel = idx } ->
> - [cellText :=> listStoreGetValue t idx,
> - cellComboTextModel := (t, roomStrCol)])
> - on roomRen edited $ \[i] str -> do
> - row@Computer { roomStore = t } <- listStoreGetValue content i
> - elems <- listStoreToList t
> - idx <- case (findIndex ((==) str) elems) of
> - Just idx -> return idx
> - Nothing -> listStoreAppend t str
> - listStoreSetValue content i row { roomSel = idx }
> - treeViewAppendColumn inventory roomCol
> -
> - -- make typesView a drag source for compTypeTag values
> - tl <- targetListNew
> - targetListAdd tl compTypeTag [TargetSameApp] 0
> - iconViewEnableModelDragSource typesView [Button1] tl
> [ActionCopy]
> -
> - -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler
> in
> - -- the DND source handler is not called unless the IconView is
> also
> - -- set to be a DND destination. Bugzilla 550528
> - tl <- targetListNew
> - iconViewEnableModelDragDest typesView tl []
> -
> - -- make the inventory widget a drag destination for
> compTypeTag values
> - tl <- targetListNew
> - targetListAdd tl compTypeTag [TargetSameApp] 0
> - targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
> - treeViewEnableModelDragDest inventory tl [ActionMove]
> - tl <- targetListNew
> - targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
> - treeViewEnableModelDragSource inventory [Button1] tl
> [ActionMove]
> -
> - -- Install drag and drop for permuting rows. This is now done
> above using
> - -- the explicit target 'targetTreeModelRow'. Calling the
> function below
> - -- will set a completely new 'TargetList' thereby removing our
> own
> - -- 'compTypeTag' from the inventory widget's target list.
> -
> - --treeViewSetReorderable inventory True
> -
> - -- arrange the widgets
> - v <- vPanedNew
> - panedAdd1 v typesView
> - panedAdd2 v inventory
> - containerAdd win v
> -
> - widgetShowAll win
> - mainGUI
> rmfile ./gtk/demo/treeList/ListDND.hs
> hunk ./gtk/demo/treeList/ListDemo.hs 1
> -module Main where
> -
> -import Graphics.UI.Gtk
> -import System.Glib.Signals (on)
> -import Data.List ( isPrefixOf )
> -import Data.Char ( toLower )
> -
> -data Phone = Phone { name :: String, number :: Int, marked ::
> Bool }
> -
> -main = do
> - initGUI
> -
> - win <- windowNew
> - onDestroy win mainQuit
> -
> - -- create a new list model
> - model <- listStoreNew
> - [Phone { name = "Foo", number = 12345, marked = False }
> - ,Phone { name = "Bar", number = 67890, marked = True }
> - ,Phone { name = "Baz", number = 39496, marked = False }]
> - view <- treeViewNewWithModel model
> -
> - treeViewSetHeadersVisible view True
> -
> - -- add a couple columns
> - col1 <- treeViewColumnNew
> - col2 <- treeViewColumnNew
> - col3 <- treeViewColumnNew
> -
> - treeViewColumnSetTitle col1 "String column"
> - treeViewColumnSetTitle col2 "Int column"
> - treeViewColumnSetTitle col3 "Bool column"
> -
> - renderer1 <- cellRendererTextNew
> - renderer2 <- cellRendererTextNew
> - renderer3 <- cellRendererToggleNew
> -
> - cellLayoutPackStart col1 renderer1 True
> - cellLayoutPackStart col2 renderer2 True
> - cellLayoutPackStart col3 renderer3 True
> -
> - cellLayoutSetAttributes col1 renderer1 model $ \row ->
> [ cellText := name row ]
> - cellLayoutSetAttributes col2 renderer2 model $ \row ->
> [ cellText := show (number row) ]
> - cellLayoutSetAttributes col3 renderer3 model $ \row ->
> [ cellToggleActive := marked row ]
> -
> - treeViewAppendColumn view col1
> - treeViewAppendColumn view col2
> - treeViewAppendColumn view col3
> -
> - -- update the model when the toggle buttons are activated
> - on renderer3 cellToggled $ \pathStr -> do
> - let (i:_) = stringToTreePath pathStr
> - val <- listStoreGetValue model i
> - listStoreSetValue model i val { marked = not (marked val) }
> -
> -
> - -- enable interactive search
> - treeViewSetEnableSearch view True
> - treeViewSetSearchEqualFunc view $ Just $ \str iter -> do
> - (i:_) <- treeModelGetPath model iter
> - row <- listStoreGetValue model i
> - return (map toLower str `isPrefixOf` map toLower (name row))
> -
> - containerAdd win view
> - widgetShowAll win
> - mainGUI
> rmfile ./gtk/demo/treeList/ListDemo.hs
> hunk ./gtk/demo/treeList/ListTest.glade 1
> -<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
> -<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd
> ">
> -
> -<glade-interface>
> -
> -<widget class="GtkWindow" id="window">
> - <property name="visible">True</property>
> - <property name="title" translatable="yes">List Test</property>
> - <property name="type">GTK_WINDOW_TOPLEVEL</property>
> - <property name="window_position">GTK_WIN_POS_NONE</property>
> - <property name="modal">False</property>
> - <property name="resizable">True</property>
> - <property name="destroy_with_parent">False</property>
> - <property name="decorated">True</property>
> - <property name="skip_taskbar_hint">False</property>
> - <property name="skip_pager_hint">False</property>
> - <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</
> property>
> - <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
> - <property name="focus_on_map">True</property>
> -
> - <child>
> - <widget class="GtkVBox" id="vbox1">
> - <property name="visible">True</property>
> - <property name="homogeneous">False</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkScrolledWindow" id="scrolledwindow1">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
> - <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
> - <property name="shadow_type">GTK_SHADOW_IN</property>
> - <property name="window_placement">GTK_CORNER_TOP_LEFT</
> property>
> -
> - <child>
> - <widget class="GtkTreeView" id="view">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="headers_visible">True</property>
> - <property name="rules_hint">False</property>
> - <property name="reorderable">False</property>
> - <property name="enable_search">True</property>
> - <property name="fixed_height_mode">False</property>
> - <property name="hover_selection">False</property>
> - <property name="hover_expand">False</property>
> - </widget>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox1">
> - <property name="visible">True</property>
> - <property name="homogeneous">False</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkVBox" id="vbox2">
> - <property name="border_width">8</property>
> - <property name="visible">True</property>
> - <property name="homogeneous">False</property>
> - <property name="spacing">12</property>
> -
> - <child>
> - <widget class="GtkExpander" id="expander6">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="expanded">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkTable" id="table1">
> - <property name="border_width">2</property>
> - <property name="visible">True</property>
> - <property name="n_rows">3</property>
> - <property name="n_columns">2</property>
> - <property name="homogeneous">False</property>
> - <property name="row_spacing">2</property>
> - <property name="column_spacing">18</property>
> -
> - <child>
> - <widget class="GtkSpinButton" id="intValue">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="climb_rate">1</property>
> - <property name="digits">0</property>
> - <property name="numeric">True</property>
> - <property name="update_policy">GTK_UPDATE_ALWAYS</property>
> - <property name="snap_to_ticks">True</property>
> - <property name="wrap">False</property>
> - <property name="adjustment">1 0 100 1 10 10</property>
> - </widget>
> - <packing>
> - <property name="left_attach">1</property>
> - <property name="right_attach">2</property>
> - <property name="top_attach">1</property>
> - <property name="bottom_attach">2</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkCheckButton" id="boolValue">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - <property name="active">False</property>
> - <property name="inconsistent">False</property>
> - <property name="draw_indicator">True</property>
> - </widget>
> - <packing>
> - <property name="left_attach">1</property>
> - <property name="right_attach">2</property>
> - <property name="top_attach">2</property>
> - <property name="bottom_attach">3</property>
> - <property name="x_options">fill</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label2">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">String value:</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">1</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="left_attach">0</property>
> - <property name="right_attach">1</property>
> - <property name="top_attach">0</property>
> - <property name="bottom_attach">1</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label3">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">Number value:</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">1</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="left_attach">0</property>
> - <property name="right_attach">1</property>
> - <property name="top_attach">1</property>
> - <property name="bottom_attach">2</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label4">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">Boolean value:</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">1</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="left_attach">0</property>
> - <property name="right_attach">1</property>
> - <property name="top_attach">2</property>
> - <property name="bottom_attach">3</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkEntry" id="stringValue">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="editable">True</property>
> - <property name="visibility">True</property>
> - <property name="max_length">0</property>
> - <property name="text" translatable="yes"></property>
> - <property name="has_frame">True</property>
> - <property name="invisible_char">*</property>
> - <property name="activates_default">False</property>
> - </widget>
> - <packing>
> - <property name="left_attach">1</property>
> - <property name="right_attach">2</property>
> - <property name="top_attach">0</property>
> - <property name="bottom_attach">1</property>
> - <property name="x_options">expand|shrink|fill</property>
> - <property name="y_options"></property>
> - </packing>
> - </child>
> - </widget>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label29">
> - <property name="visible">True</property>
> - <property name="label"
> translatable="yes"><b>Value</b></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">True</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="type">label_item</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkExpander" id="expander5">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="expanded">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkVBox" id="vbox7">
> - <property name="border_width">4</property>
> - <property name="visible">True</property>
> - <property name="homogeneous">False</property>
> - <property name="spacing">2</property>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox9">
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="insert">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">insert</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label23">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">new entry at</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkSpinButton" id="newIndex">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="climb_rate">1</property>
> - <property name="digits">0</property>
> - <property name="numeric">False</property>
> - <property name="update_policy">GTK_UPDATE_ALWAYS</
> property>
> - <property name="snap_to_ticks">False</property>
> - <property name="wrap">False</property>
> - <property name="adjustment">1 0 100 1 10 10</property>
> - </widget>
> - <packing>
> - <property name="padding">4</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox7">
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="prepend">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">prepend</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label21">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">new entry</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label30">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes"></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox8">
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="append">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">append</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label22">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">new entry</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label31">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes"></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox6">
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="update">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">update</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label20">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">entry</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkSpinButton" id="updateIndex">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="climb_rate">1</property>
> - <property name="digits">0</property>
> - <property name="numeric">False</property>
> - <property name="update_policy">GTK_UPDATE_ALWAYS</
> property>
> - <property name="snap_to_ticks">False</property>
> - <property name="wrap">False</property>
> - <property name="adjustment">1 0 100 1 10 10</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> - </widget>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label28">
> - <property name="visible">True</property>
> - <property name="label"
> translatable="yes"><b>Insert and Update</b></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">True</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="type">label_item</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkExpander" id="expander1">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="expanded">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkVBox" id="vbox8">
> - <property name="visible">True</property>
> - <property name="homogeneous">False</property>
> - <property name="spacing">2</property>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox5">
> - <property name="border_width">4</property>
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="remove">
> - <property name="width_request">54</property>
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">delete</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label19">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">entry</
> property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkSpinButton" id="removeIndex">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="climb_rate">1</property>
> - <property name="digits">0</property>
> - <property name="numeric">False</property>
> - <property name="update_policy">GTK_UPDATE_ALWAYS</
> property>
> - <property name="snap_to_ticks">False</property>
> - <property name="wrap">False</property>
> - <property name="adjustment">1 0 100 1 10 10</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label32">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes"></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label33">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes"></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">True</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkHBox" id="hbox10">
> - <property name="border_width">4</property>
> - <property name="visible">True</property>
> - <property name="homogeneous">True</property>
> - <property name="spacing">0</property>
> -
> - <child>
> - <widget class="GtkButton" id="clear">
> - <property name="visible">True</property>
> - <property name="can_focus">True</property>
> - <property name="label" translatable="yes">clear</
> property>
> - <property name="use_underline">True</property>
> - <property name="relief">GTK_RELIEF_NORMAL</property>
> - <property name="focus_on_click">True</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label34">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes">all</property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">4</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">True</property>
> - </packing>
> - </child>
> -
> - <child>
> - <widget class="GtkLabel" id="label35">
> - <property name="visible">True</property>
> - <property name="label" translatable="yes"></property>
> - <property name="use_underline">False</property>
> - <property name="use_markup">False</property>
> - <property name="justify">GTK_JUSTIFY_LEFT</property>
> - <property name="wrap">False</property>
> - <property name="selectable">False</property>
> - <property name="xalign">0.5</property>
> - <property name="yalign">0.5</property>
> - <property name="xpad">0</property>
> - <property name="ypad">0</property>
> - <property name="ellipsize">PANGO_ELLIPSIZE_NONE</
> property>
> - <property name="width_chars">-1</property>
> - <property name="single_line_mode">False</property>
> - <property name="angle">0</property>
> - </widget>
> - <packing>
> - <property name="padding">0</property>
> - <property name="expand">False</property>
> - <property name="fill">False</property>
> - </packing>
> - </child>
> -
> - <child>
> -...
[truncated message content] |
|
From: Andy S. <And...@co...> - 2010-10-26 14:41:08
|
diffing dir...
Tue Oct 26 10:38:51 EDT 2010 Andy Stewart <laz...@gm...>
* Remove TreeList modules, we won't support TreeList anymore, please switch to Graphics.UI.Gtk.ModelView.*
Ignore-this: ecae2baa3e98e0f7c513d0867d71c013
{
binary ./gtk/demo/treeList/resListDND/desktop.png
rmfile ./gtk/demo/treeList/resListDND/desktop.png
binary ./gtk/demo/treeList/resListDND/laptop.png
rmfile ./gtk/demo/treeList/resListDND/laptop.png
binary ./gtk/demo/treeList/resListDND/laptopSmall.png
rmfile ./gtk/demo/treeList/resListDND/laptopSmall.png
binary ./gtk/demo/treeList/resListDND/printer.png
rmfile ./gtk/demo/treeList/resListDND/printer.png
binary ./gtk/demo/treeList/resListDND/server.png
rmfile ./gtk/demo/treeList/resListDND/server.png
binary ./gtk/demo/treeList/resListDND/tower.png
rmfile ./gtk/demo/treeList/resListDND/tower.png
rmdir ./gtk/demo/treeList/resListDND
hunk ./gtk/demo/treeList/Completion.hs 1
--- Demo to show off entry completion.
-
-import Graphics.UI.Gtk
-import Data.Char
-import Data.List
-
-data ColorDesc = ColorDesc {
- cdColor :: Color,
- cdName :: String
- } deriving Show
-
-compareCol :: ColumnId ColorDesc String
-compareCol = makeColumnIdString 0
-
-invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b)
---Color (65535-r) (65535-g) (65535-b)
-
-parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name))
- where
- s1 = dropWhile isSpace s
- (s2,s3) = span isDigit s1
- s4 = dropWhile isSpace s3
- (s5,s6) = span isDigit s4
- s7 = dropWhile isSpace s6
- (s8,s9) = span isDigit s7
- n1 = read ('0':s2)
- n2 = read ('0':s5)
- n3 = read ('0':s8)
- c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3)
- name = dropWhile isSpace s9
- upperToSpace [] = []
- upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs
- | otherwise = x:upperToSpace xs
-
-main =
- do
- initGUI
- window <- windowNew
-
- contents <- readFile "rgb.txt"
- let killDups [] = []
- killDups [x] = [x]
- killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs)
- | otherwise = x:killDups (y:xs)
- cols = killDups $ map parseColor (drop 1 (lines contents))
- store <- listStoreNew cols
- customStoreSetColumn store compareCol cdName
-
- entry <- entryNew
- completion <- entryCompletionNew
- entrySetCompletion entry completion
-
- set completion [entryCompletionModel := Just store]
- cell <- cellRendererTextNew
- set cell [cellTextBackgroundSet := True,
- cellTextForegroundSet := True]
- cellLayoutPackStart completion cell True
- cellLayoutSetAttributes completion cell store
- (\cd -> [cellText := cdName cd,
- cellTextBackgroundColor := cdColor cd,
- cellTextForegroundColor := invertColor (cdColor cd)])
- entryCompletionSetMatchFunc completion (matchFunc store)
- on completion matchSelected $ \model iter -> do
- color <- treeModelGetValue model iter compareCol
- entrySetText entry color
- return True
- set window [containerChild := entry]
- widgetShowAll window
- onDestroy window mainQuit
- mainGUI
-
-matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool
-matchFunc model str iter = do
- --putStrLn ("iter is "++show iter)
- tp <- treeModelGetPath model iter
- r <- case tp of
- (i:_) -> do row <- listStoreGetValue model i
- return $ any (isPrefixOf (map toLower str))
- (words (map toLower (cdName row)))
- otherwise -> return False
- return r
rmfile ./gtk/demo/treeList/Completion.hs
hunk ./gtk/demo/treeList/DirList.hs 1
-{-# OPTIONS -cpp #-}
--- Test file for the ListView widget.
-module Main(main) where
-
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.ModelView as New
-
-import Control.Exception
-import System.Directory
-import System.IO
-import System.Locale
-import System.Time
-
-data FileInfo = FileInfo {
- fName :: String,
- fSize :: Integer,
- fTime :: ClockTime
-}
-
-main = do
- initGUI
- win <- windowNew
- win `onDestroy` mainQuit
-
- curDir <- getCurrentDirectory
- files <- getDirectoryContents curDir
- fInfos <- (flip mapM) files $ \f -> do
- s <- handle (\e ->
-#if __GLASGOW_HASKELL__>=610
- case e :: SomeException of
- e ->
-#endif
- return 0) $ do
- h <- openFile f ReadMode
- s <- hFileSize h
- hClose h
- return s
- t <- getModificationTime f
- return FileInfo { fName = f
- , fSize = s
- , fTime = t }
-
- store <- New.listStoreNew fInfos
-
- tv <- New.treeViewNewWithModel store
- containerAdd win tv
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "File name"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- name <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc name True
- New.cellLayoutSetAttributes tvc name store $ \FileInfo { fName = name } ->
- [ New.cellText := name ]
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "Size"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- size <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc size True
- New.cellLayoutSetAttributes tvc size store $ \FileInfo { fSize = size } ->
- [ New.cellText := show size ]
-
- tvc <- New.treeViewColumnNew
- set tvc [ New.treeViewColumnTitle := "Modification time"
- , New.treeViewColumnResizable := True ]
- New.treeViewAppendColumn tv tvc
-
- time <- New.cellRendererTextNew
- New.treeViewColumnPackStart tvc time True
- New.cellLayoutSetAttributes tvc time store $ \FileInfo { fTime = time } ->
- [ New.cellText :=> do
- calTime <- toCalendarTime time
- return (formatCalendarTime defaultTimeLocale "%D %T" calTime)
- ]
-
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/treeList/DirList.hs
hunk ./gtk/demo/treeList/FilterDemo.hs 1
--- a demo that shows how to create a normal tree view and a tree view in
--- which only a chosen subset of rows are shown (namely those with upper case letters)
-module Main ( main ) where
-
-import Graphics.UI.Gtk
-import Data.List
-import Data.Char
-import Debug.Trace
-
--- | Define a virtual column of the model that determines the visibility of a row in
--- the model.
-visCol :: ColumnId String Bool
-visCol = makeColumnIdBool 0
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- content <- readFile "FilterDemo.hs"
-
- -- create a view that shows all lines
- model <- listStoreNew (lines content)
- viewAll <- treeViewNewWithModel model
- col <- treeViewColumnNew
- ren <- cellRendererTextNew
- cellLayoutPackStart col ren True
- cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
- treeViewAppendColumn viewAll col
-
- -- create a view that only shows lines with upper case characters
- fModel <- treeModelFilterNew model []
-
- -- create a virtual column 'visCol' that contains @True@ if a certain row has
- -- upper case letters. Then set this column to determine the visibility of a row.
- customStoreSetColumn model visCol (any isUpper)
- treeModelFilterSetVisibleColumn fModel visCol
-
-{-
- -- this is an alternative way to determine the visibility of a row. In this case,
- -- it is not necessary to create the column 'visCol'.
- treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do
- row <- treeModelGetRow model iter
- return (any isUpper row)
--}
- -- note: it is important to insert the model into the view after the visibility
- -- row or the visibility function have been set. Otherwise, the view is filled
- -- first and setting a new visibility column/function will not update the view.
- viewFew <- treeViewNewWithModel fModel
- col <- treeViewColumnNew
- ren <- cellRendererTextNew
- cellLayoutPackStart col ren True
- cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
-
- treeViewAppendColumn viewFew col
-
-
-
- box <- vBoxNew False 0
- swAll <- scrolledWindowNew Nothing Nothing
- containerAdd swAll viewAll
- boxPackStart box swAll PackGrow 4
-
- swFew <- scrolledWindowNew Nothing Nothing
- containerAdd swFew viewFew
- boxPackEnd box swFew PackGrow 4
-
- containerAdd win box
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/treeList/FilterDemo.hs
hunk ./gtk/demo/treeList/ListDND.hs 1
-module Main where
-
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.Gdk.EventM
-
-import System.Glib.GObject ( toGObject )
-import System.FilePath
-import Control.Concurrent.MVar
-import Control.Monad ( liftM )
-import Control.Monad.Trans ( liftIO )
-import Data.Maybe ( fromMaybe )
-import Data.List ( findIndex )
-
-roomStrCol :: ColumnId String String
-roomStrCol = makeColumnIdString 1
-
--- Define a string column and an image column on the store holding the
--- computer types.
-compPicCol :: ColumnId CompType Pixbuf
-compPicCol = makeColumnIdPixbuf 1
-
-compStrCol :: ColumnId CompType String
-compStrCol = makeColumnIdString 2
-
-data Computer = Computer {
- name :: String,
- addr :: (Int, Int, Int, Int),
- roomStore :: ListStore String,
- roomSel :: Int,
- cType :: CompType }
-
-data CompType
- = MacBookPro
- | MacBook
- | Printer
- | MacPro
- | Xserve
- | IMac
- deriving (Enum, Bounded, Show)
-
-showCT :: CompType -> String
-showCT ct = case show ct of
- 'I':xs -> 'i':xs
- xs -> xs
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- -- create a tag that we use as selection, target and selection type
- compTypeTag <- atomNew "_CompType"
-
- let pNames = map ("resListDND" </>)
- ["laptop.png","laptopSmall.png","printer.png",
- "tower.png","server.png","desktop.png"]
- pics <- mapM pixbufNewFromFile pNames
-
- smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames
-
- [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew
- [["Paul (Home)","John (Home)","Fred (Home)"],
- ["N12","S112", "S113", "S114"],
- ["Server Room Upstairs", "Server Room Downstairs"]]
-
- -- define extractor function for the string column
- treeModelSetColumn noRoom roomStrCol id
- treeModelSetColumn publicRoom roomStrCol id
- treeModelSetColumn restrictedRoom roomStrCol id
-
- let genRoomStore MacBookPro = noRoom
- genRoomStore MacBook = noRoom
- genRoomStore Printer = publicRoom
- genRoomStore MacPro = publicRoom
- genRoomStore Xserve = restrictedRoom
- genRoomStore IMac = publicRoom
-
- -- the initial computer list - it's a coincidence that there's
- -- one computer of each type
- content <- listStoreNewDND
- (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1),
- roomStore = genRoomStore t, roomSel = 0, cType = t})
- [minBound :: CompType .. maxBound])
- (Just listStoreDefaultDragSourceIface)
- (Just DragDestIface {
- treeDragDestRowDropPossible = \store path@(i:_) -> do
- mCT <- selectionDataGet compTypeTag
- case mCT :: Maybe [Int] of
- Just [ct] -> return True
- Nothing ->
- (treeDragDestRowDropPossible listStoreDefaultDragDestIface)
- store path
- _ -> return False,
- treeDragDestDragDataReceived = \store path@(i:_) -> do
- mCT <- selectionDataGet compTypeTag
- case mCT of
- Just [ct] -> do
- let t = toEnum ct
- liftIO $ listStoreInsert store i
- Computer { name = showCT t, addr = (192,168,0,254),
- roomStore = genRoomStore t, roomSel = 0,
- cType = t }
- return True
- Nothing ->
- (treeDragDestDragDataReceived listStoreDefaultDragDestIface)
- store path
- })
- -- the area with the possible computer types
- compTypes <- listStoreNewDND [minBound :: CompType .. maxBound]
- (Just DragSourceIface {
- treeDragSourceRowDraggable = \store (i:_) -> return True,
- treeDragSourceDragDataGet = \store (i:_) -> do
- ty <- selectionDataGetTarget
- ct <- liftIO $ listStoreGetValue store i
- selectionDataSet compTypeTag [fromEnum ct]
- return True,
- treeDragSourceDragDataDelete = \store path -> return True
- })
- Nothing
-
- -- define extractor functions for the two column
- treeModelSetColumn compTypes compPicCol $
- \t -> pics !! fromEnum t
- treeModelSetColumn compTypes compStrCol showCT
-
- -- create an icon view of all the computer types
- typesView <- iconViewNew
- set typesView [iconViewModel := Just compTypes,
- iconViewPixbufColumn := compPicCol,
- iconViewTextColumn := compStrCol,
- iconViewColumns := 6]
-
- -- create an editable list of computers
- inventory <- treeViewNewWithModel content
-
- tyCol <- treeViewColumnNew
- treeViewColumnSetTitle tyCol "Type"
- picRen <- cellRendererPixbufNew
- treeViewColumnPackStart tyCol picRen False
- cellLayoutSetAttributes tyCol picRen content
- (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t])
- tyRen <- cellRendererTextNew
- treeViewColumnPackStart tyCol tyRen False
- cellLayoutSetAttributes tyCol tyRen content
- (\Computer { cType = t} -> [cellText := showCT t])
- treeViewAppendColumn inventory tyCol
-
- nameCol <- treeViewColumnNew
- treeViewColumnSetTitle nameCol "Name"
- treeViewColumnSetResizable nameCol True
- treeViewColumnSetMinWidth nameCol 100
- nameRen <- cellRendererTextNew
- set nameRen [ cellTextEditable := True,
- cellTextEditableSet := True,
- cellTextEllipsize := EllipsizeEnd,
- cellTextEllipsizeSet := True]
- treeViewColumnPackStart nameCol nameRen True
- cellLayoutSetAttributes nameCol nameRen content
- (\Computer { name = n } -> [cellText := n])
- treeViewAppendColumn inventory nameCol
- on nameRen edited $ \[i] str -> do
- val <- listStoreGetValue content i
- listStoreSetValue content i val { name = str }
-
- addrCol <- treeViewColumnNew
- treeViewColumnSetTitle addrCol "Address"
- oct1 <- cellRendererTextNew
- dot1 <- cellRendererTextNew
- oct2 <- cellRendererTextNew
- dot2 <- cellRendererTextNew
- oct3 <- cellRendererTextNew
- dot3 <- cellRendererTextNew
- oct4 <- cellRendererTextNew
- mapM_ (uncurry (cellLayoutPackStart addrCol))
- [(oct1, True), (dot1, False), (oct2, True),
- (dot2, False), (oct3, True), (dot3, False), (oct4, True)]
- mapM_ (\d -> set d [cellText := ".",
- cellTextWidthChars := 0]) [dot1, dot2, dot3]
- mapM_ (\o -> set o [cellXAlign := 1.0,
- cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4]
- cellLayoutSetAttributes addrCol oct1 content
- (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1])
- cellLayoutSetAttributes addrCol oct2 content
- (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2])
- cellLayoutSetAttributes addrCol oct3 content
- (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3])
- cellLayoutSetAttributes addrCol oct4 content
- (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4])
- treeViewAppendColumn inventory addrCol
-
- roomCol <- treeViewColumnNew
- treeViewColumnSetTitle roomCol "Room"
- treeViewColumnSetResizable roomCol True
- treeViewColumnSetSizing roomCol TreeViewColumnAutosize
- roomRen <- cellRendererComboNew
- set roomRen [ cellTextEditable := True,
- cellTextEditableSet := True,
- cellComboHasEntry := True ]
- treeViewColumnPackStart roomCol roomRen True
- cellLayoutSetAttributes roomCol roomRen content
- (\Computer { roomStore = t, roomSel = idx } ->
- [cellText :=> listStoreGetValue t idx,
- cellComboTextModel := (t, roomStrCol)])
- on roomRen edited $ \[i] str -> do
- row@Computer { roomStore = t } <- listStoreGetValue content i
- elems <- listStoreToList t
- idx <- case (findIndex ((==) str) elems) of
- Just idx -> return idx
- Nothing -> listStoreAppend t str
- listStoreSetValue content i row { roomSel = idx }
- treeViewAppendColumn inventory roomCol
-
- -- make typesView a drag source for compTypeTag values
- tl <- targetListNew
- targetListAdd tl compTypeTag [TargetSameApp] 0
- iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy]
-
- -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in
- -- the DND source handler is not called unless the IconView is also
- -- set to be a DND destination. Bugzilla 550528
- tl <- targetListNew
- iconViewEnableModelDragDest typesView tl []
-
- -- make the inventory widget a drag destination for compTypeTag values
- tl <- targetListNew
- targetListAdd tl compTypeTag [TargetSameApp] 0
- targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
- treeViewEnableModelDragDest inventory tl [ActionMove]
- tl <- targetListNew
- targetListAdd tl targetTreeModelRow [TargetSameWidget] 0
- treeViewEnableModelDragSource inventory [Button1] tl [ActionMove]
-
- -- Install drag and drop for permuting rows. This is now done above using
- -- the explicit target 'targetTreeModelRow'. Calling the function below
- -- will set a completely new 'TargetList' thereby removing our own
- -- 'compTypeTag' from the inventory widget's target list.
-
- --treeViewSetReorderable inventory True
-
- -- arrange the widgets
- v <- vPanedNew
- panedAdd1 v typesView
- panedAdd2 v inventory
- containerAdd win v
-
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/treeList/ListDND.hs
hunk ./gtk/demo/treeList/ListDemo.hs 1
-module Main where
-
-import Graphics.UI.Gtk
-import System.Glib.Signals (on)
-import Data.List ( isPrefixOf )
-import Data.Char ( toLower )
-
-data Phone = Phone { name :: String, number :: Int, marked :: Bool }
-
-main = do
- initGUI
-
- win <- windowNew
- onDestroy win mainQuit
-
- -- create a new list model
- model <- listStoreNew
- [Phone { name = "Foo", number = 12345, marked = False }
- ,Phone { name = "Bar", number = 67890, marked = True }
- ,Phone { name = "Baz", number = 39496, marked = False }]
- view <- treeViewNewWithModel model
-
- treeViewSetHeadersVisible view True
-
- -- add a couple columns
- col1 <- treeViewColumnNew
- col2 <- treeViewColumnNew
- col3 <- treeViewColumnNew
-
- treeViewColumnSetTitle col1 "String column"
- treeViewColumnSetTitle col2 "Int column"
- treeViewColumnSetTitle col3 "Bool column"
-
- renderer1 <- cellRendererTextNew
- renderer2 <- cellRendererTextNew
- renderer3 <- cellRendererToggleNew
-
- cellLayoutPackStart col1 renderer1 True
- cellLayoutPackStart col2 renderer2 True
- cellLayoutPackStart col3 renderer3 True
-
- cellLayoutSetAttributes col1 renderer1 model $ \row -> [ cellText := name row ]
- cellLayoutSetAttributes col2 renderer2 model $ \row -> [ cellText := show (number row) ]
- cellLayoutSetAttributes col3 renderer3 model $ \row -> [ cellToggleActive := marked row ]
-
- treeViewAppendColumn view col1
- treeViewAppendColumn view col2
- treeViewAppendColumn view col3
-
- -- update the model when the toggle buttons are activated
- on renderer3 cellToggled $ \pathStr -> do
- let (i:_) = stringToTreePath pathStr
- val <- listStoreGetValue model i
- listStoreSetValue model i val { marked = not (marked val) }
-
-
- -- enable interactive search
- treeViewSetEnableSearch view True
- treeViewSetSearchEqualFunc view $ Just $ \str iter -> do
- (i:_) <- treeModelGetPath model iter
- row <- listStoreGetValue model i
- return (map toLower str `isPrefixOf` map toLower (name row))
-
- containerAdd win view
- widgetShowAll win
- mainGUI
rmfile ./gtk/demo/treeList/ListDemo.hs
hunk ./gtk/demo/treeList/ListTest.glade 1
-<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
-<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
-
-<glade-interface>
-
-<widget class="GtkWindow" id="window">
- <property name="visible">True</property>
- <property name="title" translatable="yes">List Test</property>
- <property name="type">GTK_WINDOW_TOPLEVEL</property>
- <property name="window_position">GTK_WIN_POS_NONE</property>
- <property name="modal">False</property>
- <property name="resizable">True</property>
- <property name="destroy_with_parent">False</property>
- <property name="decorated">True</property>
- <property name="skip_taskbar_hint">False</property>
- <property name="skip_pager_hint">False</property>
- <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
- <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
- <property name="focus_on_map">True</property>
-
- <child>
- <widget class="GtkVBox" id="vbox1">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkScrolledWindow" id="scrolledwindow1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
- <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
- <property name="shadow_type">GTK_SHADOW_IN</property>
- <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
-
- <child>
- <widget class="GtkTreeView" id="view">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="headers_visible">True</property>
- <property name="rules_hint">False</property>
- <property name="reorderable">False</property>
- <property name="enable_search">True</property>
- <property name="fixed_height_mode">False</property>
- <property name="hover_selection">False</property>
- <property name="hover_expand">False</property>
- </widget>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox1">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox2">
- <property name="border_width">8</property>
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">12</property>
-
- <child>
- <widget class="GtkExpander" id="expander6">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkTable" id="table1">
- <property name="border_width">2</property>
- <property name="visible">True</property>
- <property name="n_rows">3</property>
- <property name="n_columns">2</property>
- <property name="homogeneous">False</property>
- <property name="row_spacing">2</property>
- <property name="column_spacing">18</property>
-
- <child>
- <widget class="GtkSpinButton" id="intValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">True</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">True</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkCheckButton" id="boolValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- <property name="active">False</property>
- <property name="inconsistent">False</property>
- <property name="draw_indicator">True</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">2</property>
- <property name="bottom_attach">3</property>
- <property name="x_options">fill</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label2">
- <property name="visible">True</property>
- <property name="label" translatable="yes">String value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">0</property>
- <property name="bottom_attach">1</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label3">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Number value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">1</property>
- <property name="bottom_attach">2</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label4">
- <property name="visible">True</property>
- <property name="label" translatable="yes">Boolean value:</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">1</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="left_attach">0</property>
- <property name="right_attach">1</property>
- <property name="top_attach">2</property>
- <property name="bottom_attach">3</property>
- <property name="y_options"></property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkEntry" id="stringValue">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="editable">True</property>
- <property name="visibility">True</property>
- <property name="max_length">0</property>
- <property name="text" translatable="yes"></property>
- <property name="has_frame">True</property>
- <property name="invisible_char">*</property>
- <property name="activates_default">False</property>
- </widget>
- <packing>
- <property name="left_attach">1</property>
- <property name="right_attach">2</property>
- <property name="top_attach">0</property>
- <property name="bottom_attach">1</property>
- <property name="x_options">expand|shrink|fill</property>
- <property name="y_options"></property>
- </packing>
- </child>
- </widget>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label29">
- <property name="visible">True</property>
- <property name="label" translatable="yes"><b>Value</b></property>
- <property name="use_underline">False</property>
- <property name="use_markup">True</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkExpander" id="expander5">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox7">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">2</property>
-
- <child>
- <widget class="GtkHBox" id="hbox9">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="insert">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">insert</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label23">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry at</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="newIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">4</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox7">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="prepend">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">prepend</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label21">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label30">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox8">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="append">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">append</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label22">
- <property name="visible">True</property>
- <property name="label" translatable="yes">new entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label31">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox6">
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="update">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">update</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label20">
- <property name="visible">True</property>
- <property name="label" translatable="yes">entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="updateIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
- </widget>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label28">
- <property name="visible">True</property>
- <property name="label" translatable="yes"><b>Insert and Update</b></property>
- <property name="use_underline">False</property>
- <property name="use_markup">True</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="type">label_item</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkExpander" id="expander1">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="expanded">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkVBox" id="vbox8">
- <property name="visible">True</property>
- <property name="homogeneous">False</property>
- <property name="spacing">2</property>
-
- <child>
- <widget class="GtkHBox" id="hbox5">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="remove">
- <property name="width_request">54</property>
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">delete</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label19">
- <property name="visible">True</property>
- <property name="label" translatable="yes">entry</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkSpinButton" id="removeIndex">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="climb_rate">1</property>
- <property name="digits">0</property>
- <property name="numeric">False</property>
- <property name="update_policy">GTK_UPDATE_ALWAYS</property>
- <property name="snap_to_ticks">False</property>
- <property name="wrap">False</property>
- <property name="adjustment">1 0 100 1 10 10</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label32">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label33">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">True</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkHBox" id="hbox10">
- <property name="border_width">4</property>
- <property name="visible">True</property>
- <property name="homogeneous">True</property>
- <property name="spacing">0</property>
-
- <child>
- <widget class="GtkButton" id="clear">
- <property name="visible">True</property>
- <property name="can_focus">True</property>
- <property name="label" translatable="yes">clear</property>
- <property name="use_underline">True</property>
- <property name="relief">GTK_RELIEF_NORMAL</property>
- <property name="focus_on_click">True</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label34">
- <property name="visible">True</property>
- <property name="label" translatable="yes">all</property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0</property>
- <property name="yalign">0.5</property>
- <property name="xpad">4</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">True</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label35">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label36">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
- <property name="width_chars">-1</property>
- <property name="single_line_mode">False</property>
- <property name="angle">0</property>
- </widget>
- <packing>
- <property name="padding">0</property>
- <property name="expand">False</property>
- <property name="fill">False</property>
- </packing>
- </child>
-
- <child>
- <widget class="GtkLabel" id="label37">
- <property name="visible">True</property>
- <property name="label" translatable="yes"></property>
- <property name="use_underline">False</property>
- <property name="use_markup">False</property>
- <property name="justify">GTK_JUSTIFY_LEFT</property>
- <property name="wrap">False</property>
- <property name="selectable">False</property>
- <property name="xalign">0.5</property>
- <property name="yalign">0.5</property>
- <property name="xpad">0</property>
- <property name="ypad">0</property>
- <property name="ellipsize">PANGO_ELLIPSIZE_...
[truncated message content] |
|
From: Andy S. <And...@co...> - 2010-10-25 22:47:49
|
diffing dir...
Mon Oct 25 18:46:34 EDT 2010 Andy Stewart <laz...@gm...>
* Fix parse error when compile gtk
Ignore-this: 46e720ff4d918bdc71f0f51528d89d7d
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 303
-deleteText :: EditableClass self =>
- Signal self (
- Int -> Int -> IO () -- ^ @(\startPos endPos -> ...)@
- )
+deleteText :: EditableClass self [_$_]
+ => Signal self (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:56
|
diffing dir...
Sun Oct 24 23:05:51 EDT 2010 Andy Stewart <laz...@gm...>
* Adjust signal name to avoid conflict
Ignore-this: 7012887d7edc89ebc2c00340d0c7957
{
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 82
- menuItemSelect,
- menuItemDeselect,
- menuItemActivate,
+ menuItemEmitSelect,
+ menuItemEmitDeselect,
+ menuItemEmitActivate,
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 94
- activateItem,
- activateLeaf,
- select,
- deselect,
- toggle,
+ menuItemActivateItem,
+ menuItemActivate,
+ menuItemSelect,
+ menuItemDeselect,
+ menuItemToggle,
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 195
-menuItemSelect :: MenuItemClass self => self -> IO ()
-menuItemSelect self =
+menuItemEmitSelect :: MenuItemClass self => self -> IO ()
+menuItemEmitSelect self =
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 202
-menuItemDeselect :: MenuItemClass self => self -> IO ()
-menuItemDeselect self =
+menuItemEmitDeselect :: MenuItemClass self => self -> IO ()
+menuItemEmitDeselect self =
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 209
-menuItemActivate :: MenuItemClass self => self -> IO ()
-menuItemActivate self =
+menuItemEmitActivate :: MenuItemClass self => self -> IO ()
+menuItemEmitActivate self =
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 289
-activateLeaf :: MenuItemClass self => Signal self (IO ())
-activateLeaf = Signal (connect_NONE__NONE "activate")
+menuItemActivate :: MenuItemClass self => Signal self (IO ())
+menuItemActivate = Signal (connect_NONE__NONE "activate")
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 297
-activateItem :: MenuItemClass self => Signal self (IO ())
-activateItem = Signal (connect_NONE__NONE "activate-item")
+menuItemActivateItem :: MenuItemClass self => Signal self (IO ())
+menuItemActivateItem = Signal (connect_NONE__NONE "activate-item")
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 302
-select :: ItemClass i => Signal i (IO ())
-select = Signal (connect_NONE__NONE "select")
+menuItemSelect :: ItemClass i => Signal i (IO ())
+menuItemSelect = Signal (connect_NONE__NONE "select")
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 307
-deselect :: ItemClass i => Signal i (IO ())
-deselect = Signal (connect_NONE__NONE "deselect")
+menuItemDeselect :: ItemClass i => Signal i (IO ())
+menuItemDeselect = Signal (connect_NONE__NONE "deselect")
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 312
-toggle :: ItemClass i => Signal i (IO ())
-toggle = Signal (connect_NONE__NONE "toggle")
+menuItemToggle :: ItemClass i => Signal i (IO ())
+menuItemToggle = Signal (connect_NONE__NONE "toggle")
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:56
|
diffing dir...
Sun Oct 24 16:29:17 EDT 2010 Maxime Henrion <mhe...@gm...>
* Update signal handlers for MenuItem and Item objects, and fix a suspected bug
Ignore-this: 70326a5a2542757f1dad7dce8869cd34
{
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 94
+ activateItem,
+ activateLeaf,
+ select,
+ deselect,
+ toggle,
+
+#ifndef DISABLE_DEPRECATED
+-- * Deprecated
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 112
+#endif
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 289
-onActivateLeaf, afterActivateLeaf :: MenuItemClass self => self
- -> IO ()
- -> IO (ConnectId self)
-onActivateLeaf = connect_NONE__NONE "activate" False
-afterActivateLeaf = connect_NONE__NONE "activate" True
+activateLeaf :: MenuItemClass self => Signal self (IO ())
+activateLeaf = Signal (connect_NONE__NONE "activate")
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 297
+activateItem :: MenuItemClass self => Signal self (IO ())
+activateItem = Signal (connect_NONE__NONE "activate-item")
+
+-- | This signal is emitted when the item is selected.
+--
+select :: ItemClass i => Signal i (IO ())
+select = Signal (connect_NONE__NONE "select")
+
+-- | This signal is emitted when the item is deselected.
+--
+deselect :: ItemClass i => Signal i (IO ())
+deselect = Signal (connect_NONE__NONE "deselect")
+
+-- | This signal is emitted when the item is toggled.
+--
+toggle :: ItemClass i => Signal i (IO ())
+toggle = Signal (connect_NONE__NONE "toggle")
+
+#ifndef DISABLE_DEPRECATED
+--------------------
+-- Deprecated Signals
+
+onActivateLeaf, afterActivateLeaf :: MenuItemClass self => self
+ -> IO ()
+ -> IO (ConnectId self)
+onActivateLeaf = connect_NONE__NONE "activate" False
+afterActivateLeaf = connect_NONE__NONE "activate" True
+
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 331
--- | This signal is emitted when the item is selected.
---
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 337
--- | This signal is emitted when the item is deselected.
---
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 343
--- | This signal is emitted when the item is toggled.
---
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs 346
-onToggle = connect_NONE__NONE "toggled" False
-afterToggle = connect_NONE__NONE "toggled" True
+onToggle = connect_NONE__NONE "toggle" False
+afterToggle = connect_NONE__NONE "toggle" True
+#endif
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:52
|
diffing dir...
Sun Oct 24 13:20:46 EDT 2010 Maxime Henrion <mhe...@gm...>
* Update signal handler in TreeSelection
Ignore-this: 3d2543cd74090ed69bb8eee94220ad94
{
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs 98
+ treeSelectionSelectionChanged,
+
+#ifndef DISABLE_DEPRECATED
+-- * Deprecated
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs 104
+#endif
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs 387
+treeSelectionSelectionChanged :: TreeSelectionClass self => Signal self (IO ())
+treeSelectionSelectionChanged = Signal (connect_NONE__NONE "changed")
+
+#ifndef DISABLE_DEPRECATED
+--------------------
+-- Deprecated Signals
+
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs 399
+#endif
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:51
|
diffing dir...
Sun Oct 24 12:13:23 EDT 2010 Maxime Henrion <mhe...@gm...>
* Wrap deprecated code inside #ifndef DISABLE_DEPRECATED
Ignore-this: 8d71a54e17f8ab7391c64b2a9d3a2666
{
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 79
+#ifndef DISABLE_DEPRECATED
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 86
+#endif
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 360
+#ifndef DISABLE_DEPRECATED
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 396
+#endif
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:51
|
diffing dir...
Sun Oct 24 22:48:26 EDT 2010 Andy Stewart <laz...@gm...>
* Replace '_' with '-' in new style signal.
Ignore-this: 98dae858cdeac6675d49707109070793
Please replace '_' with '-' when you convert signal to new style, we need keep same style with GTK+ though '_' can work too.
{
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 305
-deleteText = Signal (connect_INT_INT__NONE "delete_text")
+deleteText = Signal (connect_INT_INT__NONE "delete-text")
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 310
- signalStopEmission obj "delete_text"
+ signalStopEmission obj "delete-text"
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 344
- connect_PTR_INT_PTR__NONE "insert_text" after obj
+ connect_PTR_INT_PTR__NONE "insert-text" after obj
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 356
- signalStopEmission obj "insert_text"
+ signalStopEmission obj "insert-text"
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:51
|
diffing dir...
Sun Oct 24 11:59:23 EDT 2010 Maxime Henrion <mhe...@gm...>
* Style improvements for entryIconPress and entryIconRelease signals
Ignore-this: a23ab476450d4e48d850924f58d18ddd
{
hunk ./gtk/Graphics/UI/Gtk/Entry/Entry.chs 711
-entryIconPress = Signal connect
- where connect after obj f =
- connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f)
+entryIconPress = Signal $ \after obj f ->
+ connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f)
hunk ./gtk/Graphics/UI/Gtk/Entry/Entry.chs 719
-entryIconRelease = Signal connect
- where connect after obj f =
- connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f)
+entryIconRelease = Signal $ \after obj f ->
+ connect_ENUM_PTR__NONE "icon-press" after obj (runReaderT . f)
}
|
|
From: Andy S. <And...@co...> - 2010-10-25 03:11:45
|
diffing dir...
Sun Oct 24 11:57:48 EDT 2010 Maxime Henrion <mhe...@gm...>
* Provide new style signal handlers for Editable
Ignore-this: e364d8cc93b56536d409cbd2d5e88952
{
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 72
+ editableChanged,
+ deleteText,
+ insertText,
+ stopDeleteText,
+ stopInsertText,
+
+-- * Deprecated
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 83
- stopDeleteText,
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 84
- afterInsertText,
- stopInsertText
+ afterInsertText
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 285
--- | The 'onEditableChanged' signal is emitted at the end of a single
+-- | The 'editableChanged' signal is emitted at the end of a single
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 291
--- content, and may cause multiple 'onEditableInserText' signals to be
+-- content, and may cause multiple 'inserText' signals to be
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 294
-onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
- IO (ConnectId ec)
-onEditableChanged = connect_NONE__NONE "changed" False
-afterEditableChanged = connect_NONE__NONE "changed" True
+editableChanged :: EditableClass ec => Signal ec (IO ())
+editableChanged = Signal (connect_NONE__NONE "changed")
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 299
--- * See 'onInsertText' for information on how to use this signal.
+-- * See 'insertText' for information on how to use this signal.
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 301
-onDeleteText, afterDeleteText :: EditableClass self => self
- -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
- -> IO (ConnectId self)
-onDeleteText = connect_INT_INT__NONE "delete_text" False
-afterDeleteText = connect_INT_INT__NONE "delete_text" True
+deleteText :: EditableClass self =>
+ Signal self (
+ Int -> Int -> IO () -- ^ @(\startPos endPos -> ...)@
+ )
+deleteText = Signal (connect_INT_INT__NONE "delete_text")
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 330
--- > id <- onInsertText entry $ \str pos -> do
+-- > id <- entry `on` insertText $ \str pos -> do
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 339
--- Note that the 'afterInsertText' function is not very useful, except to
+-- Note that binding 'insertText' using 'after' is not very useful, except to
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 342
+insertText :: EditableClass self => Signal self (String -> Int -> IO Int)
+insertText = Signal $ \after obj handler ->
+ connect_PTR_INT_PTR__NONE "insert_text" after obj
+ (\strPtr strLen posPtr -> do
+ str <- if strLen<0 then peekUTFString strPtr
+ else peekUTFStringLen (strPtr, strLen)
+ pos <- peek (posPtr :: Ptr {#type gint#})
+ pos' <- handler str (fromIntegral pos)
+ poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
+ )
+ [_$_]
+-- | Stop the current signal that inserts text.
+stopInsertText :: EditableClass self => ConnectId self -> IO ()
+stopInsertText (ConnectId _ obj) =
+ signalStopEmission obj "insert_text"
+
+--------------------
+-- Deprecated Signals
+
+onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
+ IO (ConnectId ec)
+onEditableChanged = connect_NONE__NONE "changed" False
+afterEditableChanged = connect_NONE__NONE "changed" True
+
+onDeleteText, afterDeleteText :: EditableClass self => self
+ -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
+ -> IO (ConnectId self)
+onDeleteText = connect_INT_INT__NONE "delete_text" False
+afterDeleteText = connect_INT_INT__NONE "delete_text" True
+
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs 393
-
--- | Stop the current signal that inserts text.
-stopInsertText :: EditableClass self => ConnectId self -> IO ()
-stopInsertText (ConnectId _ obj) =
- signalStopEmission obj "insert_text"
}
|
|
From: Andy S. <And...@co...> - 2010-10-24 02:30:49
|
diffing dir...
Sat Oct 23 17:53:54 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGobject] hunt down the last occurrences of un"wrap"ped new GObjects
Ignore-this: bd336d11366fbdbcc43d27bcbf1d52e4
{
hunk ./gtk/Graphics/UI/Gtk/Gdk/Screen.chs 482
- maybeNull (makeNewGObject mkDrawWindow) $
+ maybeNull (wrapNewGObject mkDrawWindow) $
hunk ./gtk/Graphics/UI/Gtk/Gdk/Screen.chs 506
- fromGList lPtr >>= mapM (constructNewGObject mkDrawWindow . return)
+ fromGList lPtr >>= mapM (wrapNewGObject mkDrawWindow . return)
hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs 343
- liftIO $ maybeNull (constructNewGObject mkPixbuf) $
+ liftIO $ maybeNull (wrapNewGObject mkPixbuf) $
hunk ./gtk/Graphics/UI/Gtk/Windows/OffscreenWindow.chs 111
--- | Retrieves a snapshot of the contained widget in the form of a 'Pixbuf'. This is a new pixbuf with a
--- reference count of 1, and the application should unreference it once it is no longer needed.
+-- | Retrieves a snapshot of the contained widget in the form of a 'Pixbuf'.
hunk ./gtk/Graphics/UI/Gtk/Windows/OffscreenWindow.chs 119
- maybeNull (makeNewGObject mkPixbuf) $
+ maybeNull (wrapNewGObject mkPixbuf) $
}
|
|
From: Andy S. <And...@co...> - 2010-10-24 02:30:44
|
diffing dir...
Sat Oct 23 17:45:00 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] cosmetic stuff / adjust semantic
Ignore-this: 35f39fe5c3bbbe350fe8ddc12ab396c2
{
hunk ./gtk/Graphics/UI/Gtk/Gdk/Cursor.chs 155
- constructNewGObject mkDisplay $ {#call cursor_get_display#} cursor
+ makeNewGObject mkDisplay $ {#call cursor_get_display#} cursor
hunk ./gtk/Graphics/UI/Gtk/Gdk/Cursor.chs 164
- maybeNull (constructNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor
+ maybeNull (makeNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor
hunk ./gtk/Graphics/UI/Gtk/Gdk/Keymap.chs 145
- constructNewGObject mkKeymap $
+ makeNewGObject mkKeymap $
hunk ./gtk/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs 190
- maybeNull (constructNewGObject mkPixbuf) $ {#call unsafe pixbuf_animation_get_static_image#} self
+ maybeNull (makeNewGObject mkPixbuf) $ {#call unsafe pixbuf_animation_get_static_image#} self
hunk ./gtk/Graphics/UI/Gtk/Gdk/PixbufAnimation.chs 257
-pixbufAnimationIterGetPixbuf iter = constructNewGObject mkPixbuf $
+pixbufAnimationIterGetPixbuf iter = makeNewGObject mkPixbuf $
}
|
|
From: Andy S. <And...@co...> - 2010-10-23 11:11:24
|
diffing dir...
Sat Oct 23 00:12:27 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] additional fix to ./gio/System/GIO/Volumes/VolumeMonitor.chs
Ignore-this: bc03ac4043727d0ab5c984ea06880092
{
hunk ./gio/System/GIO/Volumes/VolumeMonitor.chs 119
- maybeNull (makeNewGObject mkMount) $
+ maybeNull (wrapNewGObject mkMount) $
hunk ./gio/System/GIO/Volumes/VolumeMonitor.chs 128
- maybeNull (makeNewGObject mkVolume) $ [_$_]
+ maybeNull (wrapNewGObject mkVolume) $ [_$_]
}
|
|
From: Andy S. <And...@co...> - 2010-10-23 11:11:22
|
diffing dir...
Sat Oct 23 00:12:26 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] additional fix to ./gio/System/GIO/Volumes/Volume.chs
Ignore-this: 9d2be1ce09cf799e44afa79335adca3b
{
hunk ./gio/System/GIO/Volumes/Volume.chs 138
- maybeNull (makeNewGObject mkDrive) $
+ maybeNull (wrapNewGObject mkDrive) $
hunk ./gio/System/GIO/Volumes/Volume.chs 145
- maybeNull (makeNewGObject mkMount) $
+ maybeNull (wrapNewGObject mkMount) $
hunk ./gio/System/GIO/Volumes/Volume.chs 170
- maybeNull (makeNewGObject mkFile) $
+ maybeNull (wrapNewGObject mkFile) $
}
|
|
From: Andy S. <And...@co...> - 2010-10-23 11:11:19
|
diffing dir...
Sat Oct 23 00:12:26 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] additional fix to ./gio/System/GIO/Volumes/Mount.chs
Ignore-this: b5f97fa10ad771ac2778c0974ea95421
{
hunk ./gio/System/GIO/Volumes/Mount.chs 143
- maybeNull (makeNewGObject mkDrive) $
+ maybeNull (wrapNewGObject mkDrive) $
hunk ./gio/System/GIO/Volumes/Mount.chs 157
- maybeNull (makeNewGObject mkVolume) $
+ maybeNull (wrapNewGObject mkVolume) $
}
|
|
From: Andy S. <And...@co...> - 2010-10-23 11:11:18
|
diffing dir...
Sat Oct 23 00:12:25 EDT 2010 John Obbele <joh...@gm...>
* [wrapNewGObject] additional fix to ./gio/System/GIO/File/File.chs
Ignore-this: a94450d7da850b1f0a8a3d766fe1aad
{
hunk ./gio/System/GIO/File/File.chs 371
- unsafePerformIO $ maybeNull (makeNewGObject mkFile) $ [_$_]
+ unsafePerformIO $ maybeNull (wrapNewGObject mkFile) $ [_$_]
hunk ./gio/System/GIO/File/File.chs 407
- unsafePerformIO $ (makeNewGObject mkFile) $
+ unsafePerformIO $ (wrapNewGObject mkFile) $
hunk ./gio/System/GIO/File/File.chs 442
- unsafePerformIO $ maybeNull (makeNewGObject mkFile) $
+ unsafePerformIO $ maybeNull (wrapNewGObject mkFile) $
}
|
2 messages has been excluded from this view by a project administrator.
