{-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- #include #include "template-hsc-gtk2hs.h" -- GIMP Toolkit (GTK) StockItems -- -- Author : Axel Simon -- -- Created: 24 May 2001 -- -- Copyright (C) 1999-2005 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- A StockItem is a resource that is know throughout Gtk. -- -- * Defining you own 'Graphics.UI.Gtk.General.IconFactory.IconSet's -- as 'StockItem's will make it possible for Gtk to choose the most -- appropriate sizes and enables themes to override your built in -- icons. A couple of constants are defined here as well. They are -- useful in accessing Gtk's predefined items. -- module Graphics.UI.Gtk.General.StockItems ( StockItem(StockItem), StockId, siStockId, siLabel, siModifier, siKeyval, siTransDom, stockAddItem, stockLookupItem, stockListIds, stockAbout, stockAdd, stockApply, stockBold, stockCancel, #if GTK_CHECK_VERSION(2,16,0) stockCapsLockWarning, #endif stockCDROM, stockClear, stockClose, stockColorPicker, stockConvert, stockConnect, stockCopy, stockCut, stockDelete, stockDialogAuthentication, stockDialogError, stockDialogInfo, stockDialogQuestion, stockDialogWarning, stockDirectory, #if GTK_CHECK_VERSION(2,12,0) stockDiscard, #endif stockDisconnect, stockDnd, stockDndMultiple, stockEdit, stockExecute, stockFile, stockFind, stockFindAndRelpace, stockFloppy, stockFullscreen, stockGotoBottom, stockGotoFirst, stockGotoLast, stockGotoTop, stockGoBack, stockGoDown, stockGoForward, stockGoUp, stockHarddisk, stockHelp, stockHome, stockIndent, stockIndex, stockInfo, stockItalic, stockJumpTo, stockJustifyCenter, stockJustifyFill, stockJustifyLeft, stockJustifyRight, stockLeaveFullscreen, stockMediaForward, stockMediaNext, stockMediaPause, stockMediaPlay, stockMediaPrevious, stockMediaRecord, stockMediaRewind, stockMediaStop, stockMissingImage, stockNetwork, stockNew, stockNo, stockOk, stockOpen, #if GTK_CHECK_VERSION(2,10,0) stockOrientationLandscape, stockOrientationReverseLandscape, stockOrientationPortrait, stockOrientationReversePortrait, #endif #if GTK_CHECK_VERSION(2,14,0) stockPageSetup, #endif stockPaste, stockPreferences, stockPrint, #if GTK_CHECK_VERSION(2,14,0) stockPrintError, stockPrintPaused, stockPrintReport, stockPrintWarning, #endif stockPrintPreview, stockProperties, stockQuit, stockRedo, stockRefresh, stockRemove, stockRevertToSaved, stockSave, stockSaveAs, #if GTK_CHECK_VERSION(2,10,0) stockSelectAll, #endif stockSelectColor, stockSelectFont, stockSortAscending, stockSortDescending, stockSpellCheck, stockStop, stockStrikethrough, stockUndelete, stockUnderline, stockUndo, stockUnindent, stockYes, stockZoom100, stockZoomFit, stockZoomIn, stockZoomOut ) where -- The StockItem structure is completely marshaled to Haskell. It is -- possible to marshal all strings lazily because the string pointers are -- valid throughout the lifetime of the application. The only drawback it -- that a stock item that is replaced by the another item with the same -- name will never be freed. This deficiency is built into Gtk however. -- import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.Flags import System.Glib.GList (GSList, fromGSListRev) import Graphics.UI.Gtk.Gdk.Events (Modifier) import Graphics.UI.Gtk.Gdk.Keys (KeyVal) -- | A synonym for a standard button or icon. -- type StockId = String -- Although the structure itself is allocated dynamically, its contents -- are not. All string pointers are constant throughout the lifetime of -- the application. We do not need to marshal these Strings to Haskell if -- they are not needed. -- -- | The description of a stock item. -- data StockItem = StockItem { siStockId :: StockId, siLabel :: String, siModifier:: [Modifier], siKeyval :: KeyVal, siTransDom:: String } instance Storable StockItem where sizeOf _ = #const sizeof(GtkStockItem) alignment _ = alignment (undefined::CString) peek siPtr = do (stockId :: CString) <- #{peek GtkStockItem, stock_id} siPtr (label :: CString) <- #{peek GtkStockItem, label} siPtr (modifier :: #gtk2hs_type GdkModifierType) <- #{peek GtkStockItem, modifier} siPtr (keyval :: #gtk2hs_type guint) <- #{peek GtkStockItem, keyval} siPtr (transDom :: CString) <- #{peek GtkStockItem, translation_domain} siPtr return $ StockItem { siStockId = unsafePerformIO $ peekUTFString' stockId, siLabel = unsafePerformIO $ peekUTFString' label, -- &%!?$ c2hs and hsc should agree on types siModifier = toFlags (fromIntegral modifier), siKeyval = keyval, siTransDom = unsafePerformIO $ peekUTFString' transDom } where peekUTFString' :: CString -> IO String peekUTFString' strPtr | strPtr==nullPtr = return "" | otherwise = peekUTFString strPtr poke siPtr (StockItem { siStockId = stockId, siLabel = label, siModifier= modifier, siKeyval = keyval, siTransDom= transDom }) = do stockIdPtr <- newUTFString stockId #{poke GtkStockItem, stock_id} siPtr stockIdPtr labelPtr <- newUTFString label #{poke GtkStockItem, label} siPtr labelPtr #{poke GtkStockItem, modifier} siPtr ((fromIntegral (fromFlags modifier))::#{gtk2hs_type GdkModifierType}) #{poke GtkStockItem, keyval} siPtr ((fromIntegral keyval)::#{gtk2hs_type guint}) transDomPtr<- newUTFString transDom #{poke GtkStockItem, translation_domain} siPtr transDomPtr -- | Add new stock items to Gtk. -- -- Using stock_add_static would be possible if we used g_malloc to reserve -- space since the allocated space might actually be freed when another -- stock item with the same name is added. stockAddItem :: [StockItem] -> IO () stockAddItem [] = return () stockAddItem sis = let items = length sis in do allocaArray items $ \aPtr -> do pokeArray aPtr sis stock_add aPtr (fromIntegral items) -- | Lookup an item in stock. -- stockLookupItem :: StockId -> IO (Maybe StockItem) stockLookupItem stockId = alloca $ \siPtr -> withUTFString stockId $ \strPtr -> do res <- stock_lookup strPtr siPtr if (toBool res) then liftM Just $ peek siPtr else return Nothing -- | Produce a list of all known stock identifiers. -- -- * Retrieve a list of all known stock identifiers. These can either be -- added by 'stockAddItem' or by adding items to a -- 'Graphics.UI.Gtk.General.IconFactory.IconFactory'. -- -- * The list is sorted alphabetically (sorting is not Unicode aware). -- stockListIds :: IO [StockId] stockListIds = do lPtr <- stock_list_ids sPtrs <- fromGSListRev lPtr res <- mapM readUTFString sPtrs return res foreign import ccall unsafe "gtk_stock_add" stock_add :: Ptr StockItem -> #{gtk2hs_type guint} -> IO () foreign import ccall unsafe "gtk_stock_lookup" stock_lookup :: CString -> Ptr StockItem -> IO #gtk2hs_type gboolean foreign import ccall unsafe "gtk_stock_list_ids" stock_list_ids :: IO GSList #if GTK_CHECK_VERSION(2,6,0) -- | <> stockAbout :: StockId stockAbout = #{const_str GTK_STOCK_ABOUT} #else stockAbout = stockMissingImage #endif -- | <> stockAdd :: StockId stockAdd = #{const_str GTK_STOCK_ADD} -- | <> stockApply :: StockId stockApply = #{const_str GTK_STOCK_APPLY} -- | <> stockBold :: StockId stockBold = #{const_str GTK_STOCK_BOLD} -- | <> stockCancel :: StockId stockCancel = #{const_str GTK_STOCK_CANCEL} #if GTK_CHECK_VERSION(2,16,0) -- | <> stockCapsLockWarning :: StockId stockCapsLockWarning = #{const_str GTK_STOCK_CAPS_LOCK_WARNING} #endif -- | <> stockCDROM :: StockId stockCDROM = #{const_str GTK_STOCK_CDROM} -- | <> stockClear :: StockId stockClear = #{const_str GTK_STOCK_CLEAR} -- | <> stockClose :: StockId stockClose = #{const_str GTK_STOCK_CLOSE} #if GTK_CHECK_VERSION(2,2,0) -- | <> stockColorPicker :: StockId stockColorPicker = #{const_str GTK_STOCK_COLOR_PICKER} #else stockColorPicker = stockMissingImage #endif -- | <> stockConvert :: StockId stockConvert = #{const_str GTK_STOCK_CONVERT} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockConnect :: StockId stockConnect = #{const_str GTK_STOCK_CONNECT} #else stockConnect = stockMissingImage #endif -- | <> stockCopy :: StockId stockCopy = #{const_str GTK_STOCK_COPY} -- | <> stockCut :: StockId stockCut = #{const_str GTK_STOCK_CUT} -- | <> stockDelete :: StockId stockDelete = #{const_str GTK_STOCK_DELETE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDialogAuthentication :: StockId stockDialogAuthentication = #{const_str GTK_STOCK_DIALOG_AUTHENTICATION} #else stockDialogAuthentication = stockDialogQuestion #endif -- | <> stockDialogError :: StockId stockDialogError = #{const_str GTK_STOCK_DIALOG_ERROR} -- | <> stockDialogInfo :: StockId stockDialogInfo = #{const_str GTK_STOCK_DIALOG_INFO} -- | <> stockDialogQuestion :: StockId stockDialogQuestion = #{const_str GTK_STOCK_DIALOG_QUESTION} -- | <> stockDialogWarning :: StockId stockDialogWarning = #{const_str GTK_STOCK_DIALOG_WARNING} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDirectory :: StockId stockDirectory = #{const_str GTK_STOCK_DIRECTORY} #else stockDirectory = stockMissingImage #endif #if GTK_CHECK_VERSION(2,12,0) -- | stockDiscard :: StockId stockDiscard = #{const_str GTK_STOCK_DISCARD} #endif #if GTK_CHECK_VERSION(2,6,0) -- | <> stockDisconnect :: StockId stockDisconnect = #{const_str GTK_STOCK_DISCONNECT} #else stockDisconnect = stockMissingImage #endif -- | <> stockDnd :: StockId stockDnd = #{const_str GTK_STOCK_DND} -- | <> stockDndMultiple :: StockId stockDndMultiple = #{const_str GTK_STOCK_DND_MULTIPLE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockEdit :: StockId stockEdit = #{const_str GTK_STOCK_EDIT} #else stockEdit = stockMissingImage #endif -- | <> stockExecute :: StockId stockExecute = #{const_str GTK_STOCK_EXECUTE} #if GTK_CHECK_VERSION(2,6,0) -- | <> stockFile :: StockId stockFile = #{const_str GTK_STOCK_FILE} #else stockFile = stockMissingImage #endif -- | <> stockFind :: StockId stockFind = #{const_str GTK_STOCK_FIND} -- | <> stockFindAndRelpace :: StockId stockFindAndRelpace = #{const_str GTK_STOCK_FIND_AND_REPLACE} -- | <> stockFloppy :: StockId stockFloppy = #{const_str GTK_STOCK_FLOPPY} #if GTK_CHECK_VERSION(2,8,0) -- | <> stockFullscreen :: StockId stockFullscreen = #{const_str GTK_STOCK_FULLSCREEN} #else stockFullscreen = stockMissingImage #endif -- | <> stockGotoBottom :: StockId stockGotoBottom = #{const_str GTK_STOCK_GOTO_BOTTOM} -- | <> -- <> stockGotoFirst :: StockId stockGotoFirst = #{const_str GTK_STOCK_GOTO_FIRST} -- | <> -- <> stockGotoLast :: StockId stockGotoLast = #{const_str GTK_STOCK_GOTO_LAST} -- | <> stockGotoTop :: StockId stockGotoTop = #{const_str GTK_STOCK_GOTO_TOP} -- | <> -- <> stockGoBack :: StockId stockGoBack = #{const_str GTK_STOCK_GO_BACK} -- | <> stockGoDown :: StockId stockGoDown = #{const_str GTK_STOCK_GO_DOWN} -- | <> -- <> stockGoForward :: StockId stockGoForward = #{const_str GTK_STOCK_GO_FORWARD} -- | <> stockGoUp :: StockId stockGoUp = #{const_str GTK_STOCK_GO_UP} #if GTK_CHECK_VERSION(2,4,0) -- | <> stockHarddisk :: StockId stockHarddisk = #{const_str GTK_STOCK_HARDDISK} #else stockHarddisk = stockMissingImage #endif -- | <> stockHelp :: StockId stockHelp = #{const_str GTK_STOCK_HELP} -- | <> stockHome :: StockId stockHome = #{const_str GTK_STOCK_HOME} #if GTK_CHECK_VERSION(2,4,0) -- | <> -- <> stockIndent :: StockId stockIndent = #{const_str GTK_STOCK_INDENT} #else stockIndent = stockMissingImage #endif -- | <> stockIndex :: StockId stockIndex = #{const_str GTK_STOCK_INDEX} #if GTK_CHECK_VERSION(2,8,0) -- | <> stockInfo :: StockId stockInfo = #{const_str GTK_STOCK_INFO} #else stockInfo = stockMissingImage #endif -- | <> stockItalic :: StockId stockItalic = #{const_str GTK_STOCK_ITALIC} -- | <> -- <> stockJumpTo :: StockId stockJumpTo = #{const_str GTK_STOCK_JUMP_TO} -- | <> stockJustifyCenter :: StockId stockJustifyCenter = #{const_str GTK_STOCK_JUSTIFY_CENTER} -- | <> stockJustifyFill :: StockId stockJustifyFill = #{const_str GTK_STOCK_JUSTIFY_FILL} -- | <> stockJustifyLeft :: StockId stockJustifyLeft = #{const_str GTK_STOCK_JUSTIFY_LEFT} -- | <> stockJustifyRight :: StockId stockJustifyRight = #{const_str GTK_STOCK_JUSTIFY_RIGHT} -- | <> stockLeaveFullscreen :: StockId stockLeaveFullscreen = #{const_str GTK_STOCK_LEAVE_FULLSCREEN} -- | <> stockMissingImage :: StockId stockMissingImage = #{const_str GTK_STOCK_MISSING_IMAGE} #if GTK_CHECK_VERSION(2,6,0) -- | <> -- <> stockMediaForward :: StockId stockMediaForward = #{const_str GTK_STOCK_MEDIA_FORWARD} -- | <> -- <> stockMediaNext :: StockId stockMediaNext = #{const_str GTK_STOCK_MEDIA_NEXT} -- | <> stockMediaPause :: StockId stockMediaPause = #{const_str GTK_STOCK_MEDIA_PAUSE} -- | <> -- <> stockMediaPlay :: StockId stockMediaPlay = #{const_str GTK_STOCK_MEDIA_PLAY} -- | <> -- <> stockMediaPrevious :: StockId stockMediaPrevious = #{const_str GTK_STOCK_MEDIA_PREVIOUS} -- | <> stockMediaRecord :: StockId stockMediaRecord = #{const_str GTK_STOCK_MEDIA_RECORD} -- | <> -- <> stockMediaRewind :: StockId stockMediaRewind = #{const_str GTK_STOCK_MEDIA_REWIND} -- | <> stockMediaStop :: StockId stockMediaStop = #{const_str GTK_STOCK_MEDIA_STOP} #else stockMediaForward = stockMissingImage stockMediaNext = stockMissingImage stockMediaPause = stockMissingImage stockMediaPlay = stockMissingImage stockMediaPrevious = stockMissingImage stockMediaRecord = stockMissingImage stockMediaRewind = stockMissingImage stockMediaStop = stockMissingImage #endif #if GTK_CHECK_VERSION(2,4,0) -- | <> stockNetwork :: StockId stockNetwork = #{const_str GTK_STOCK_NETWORK} #else stockNetwork = stockMissingImage #endif -- | <> stockNew :: StockId stockNew = #{const_str GTK_STOCK_NEW} -- | <> stockNo :: StockId stockNo = #{const_str GTK_STOCK_NO} -- | <> stockOk :: StockId stockOk = #{const_str GTK_STOCK_OK} -- | <> stockOpen :: StockId stockOpen = #{const_str GTK_STOCK_OPEN} #if GTK_CHECK_VERSION(2,10,0) -- | <> stockOrientationLandscape :: StockId stockOrientationLandscape = #{const_str GTK_STOCK_ORIENTATION_LANDSCAPE} -- | <> stockOrientationReverseLandscape :: StockId stockOrientationReverseLandscape = #{const_str GTK_STOCK_ORIENTATION_REVERSE_LANDSCAPE} -- | <> stockOrientationPortrait :: StockId stockOrientationPortrait = #{const_str GTK_STOCK_ORIENTATION_PORTRAIT} -- | <> stockOrientationReversePortrait :: StockId stockOrientationReversePortrait = #{const_str GTK_STOCK_ORIENTATION_REVERSE_PORTRAIT} #else stockOrientationLandscape = stockMissingImage stockOrientationReverseLandscape = stockMissingImage stockOrientationPortrait = stockMissingImage stockOrientationReversePortrait = stockMissingImage #endif #if GTK_CHECK_VERSION(2,14,0) -- | <> stockPageSetup :: StockId stockPageSetup = #{const_str GTK_STOCK_PAGE_SETUP} #endif -- | <> stockPaste :: StockId stockPaste = #{const_str GTK_STOCK_PASTE} -- | <> stockPreferences :: StockId stockPreferences = #{const_str GTK_STOCK_PREFERENCES} -- | <> stockPrint :: StockId stockPrint = #{const_str GTK_STOCK_PRINT} #if GTK_CHECK_VERSION(2,14,0) -- | <> stockPrintError :: StockId stockPrintError = #{const_str GTK_STOCK_PRINT_ERROR} -- | <> stockPrintPaused :: StockId stockPrintPaused = #{const_str GTK_STOCK_PRINT_PAUSED} -- | <> stockPrintReport :: StockId stockPrintReport = #{const_str GTK_STOCK_PRINT_REPORT} -- | <> stockPrintWarning :: StockId stockPrintWarning = #{const_str GTK_STOCK_PRINT_WARNING} #endif -- | <> stockPrintPreview :: StockId stockPrintPreview = #{const_str GTK_STOCK_PRINT_PREVIEW} -- | <> stockProperties :: StockId stockProperties = #{const_str GTK_STOCK_PROPERTIES} -- | <> stockQuit :: StockId stockQuit = #{const_str GTK_STOCK_QUIT} -- | <> -- <> stockRedo :: StockId stockRedo = #{const_str GTK_STOCK_REDO} -- | <> stockRefresh :: StockId stockRefresh = #{const_str GTK_STOCK_REFRESH} -- | <> stockRemove :: StockId stockRemove = #{const_str GTK_STOCK_REMOVE} -- | <> -- <> stockRevertToSaved :: StockId stockRevertToSaved = #{const_str GTK_STOCK_REVERT_TO_SAVED} -- | <> stockSave :: StockId stockSave = #{const_str GTK_STOCK_SAVE} -- | <> stockSaveAs :: StockId stockSaveAs = #{const_str GTK_STOCK_SAVE_AS} #if GTK_CHECK_VERSION(2,10,0) -- | <> stockSelectAll :: StockId stockSelectAll = #{const_str GTK_STOCK_SELECT_ALL} #else stockSelectAll = stockMissingImage #endif -- | <> stockSelectColor :: StockId stockSelectColor = #{const_str GTK_STOCK_SELECT_COLOR} -- | <> stockSelectFont :: StockId stockSelectFont = #{const_str GTK_STOCK_SELECT_FONT} -- | <> stockSortAscending :: StockId stockSortAscending = #{const_str GTK_STOCK_SORT_ASCENDING} -- | <> stockSortDescending :: StockId stockSortDescending = #{const_str GTK_STOCK_SORT_DESCENDING} -- | <> stockSpellCheck :: StockId stockSpellCheck = #{const_str GTK_STOCK_SPELL_CHECK} -- | <> stockStop :: StockId stockStop = #{const_str GTK_STOCK_STOP} -- | <> stockStrikethrough :: StockId stockStrikethrough = #{const_str GTK_STOCK_STRIKETHROUGH} -- | <> -- <> stockUndelete :: StockId stockUndelete = #{const_str GTK_STOCK_UNDELETE} -- | <> stockUnderline :: StockId stockUnderline = #{const_str GTK_STOCK_UNDERLINE} -- | <> -- <> stockUndo :: StockId stockUndo = #{const_str GTK_STOCK_UNDO} #if GTK_CHECK_VERSION(2,4,0) -- | <> -- <> stockUnindent :: StockId stockUnindent = #{const_str GTK_STOCK_UNINDENT} #else stockUnindent = stockMissingImage #endif -- | <> stockYes :: StockId stockYes = #{const_str GTK_STOCK_YES} -- | <> stockZoom100 :: StockId stockZoom100 = #{const_str GTK_STOCK_ZOOM_100} -- | <> stockZoomFit :: StockId stockZoomFit = #{const_str GTK_STOCK_ZOOM_FIT} -- | <> stockZoomIn :: StockId stockZoomIn = #{const_str GTK_STOCK_ZOOM_IN} -- | <> stockZoomOut :: StockId stockZoomOut = #{const_str GTK_STOCK_ZOOM_OUT}