From 305837683782841b0d93dabc61e7e6e19df220b4 Mon Sep 17 00:00:00 2001 From: Jan Sucan Date: Fri, 12 Sep 2025 09:10:37 +0200 Subject: 23_a_1: Copy code of ch23 from the examples --- ch23/23_a_1/PodCabalMain.hs | 10 ++ ch23/23_a_1/PodDB.hs | 150 ++++++++++++++++++++++++++ ch23/23_a_1/PodDownload.hs | 65 ++++++++++++ ch23/23_a_1/PodLocalMain.hs | 7 ++ ch23/23_a_1/PodMainGUI.hs | 214 +++++++++++++++++++++++++++++++++++++ ch23/23_a_1/PodParser.hs | 106 ++++++++++++++++++ ch23/23_a_1/PodTypes.hs | 17 +++ ch23/23_a_1/Setup.hs | 5 + ch23/23_a_1/pod.cabal | 11 ++ ch23/23_a_1/podresources.glade | 236 +++++++++++++++++++++++++++++++++++++++++ 10 files changed, 821 insertions(+) create mode 100644 ch23/23_a_1/PodCabalMain.hs create mode 100644 ch23/23_a_1/PodDB.hs create mode 100644 ch23/23_a_1/PodDownload.hs create mode 100644 ch23/23_a_1/PodLocalMain.hs create mode 100644 ch23/23_a_1/PodMainGUI.hs create mode 100644 ch23/23_a_1/PodParser.hs create mode 100644 ch23/23_a_1/PodTypes.hs create mode 100644 ch23/23_a_1/Setup.hs create mode 100644 ch23/23_a_1/pod.cabal create mode 100644 ch23/23_a_1/podresources.glade (limited to 'ch23/23_a_1') diff --git a/ch23/23_a_1/PodCabalMain.hs b/ch23/23_a_1/PodCabalMain.hs new file mode 100644 index 0000000..3810cb3 --- /dev/null +++ b/ch23/23_a_1/PodCabalMain.hs @@ -0,0 +1,10 @@ +{-- snippet all --} +module Main where + +import qualified PodMainGUI +import Paths_pod(getDataFileName) + +main = + do gladefn <- getDataFileName "podresources.glade" + PodMainGUI.main gladefn +{-- /snippet all --} diff --git a/ch23/23_a_1/PodDB.hs b/ch23/23_a_1/PodDB.hs new file mode 100644 index 0000000..b7257ec --- /dev/null +++ b/ch23/23_a_1/PodDB.hs @@ -0,0 +1,150 @@ +{-- snippet all --} +module PodDB where + +import Database.HDBC +import Database.HDBC.Sqlite3 +import PodTypes +import Control.Monad(when) +import Data.List(sort) + +-- | Initialize DB and return database Connection +connect :: FilePath -> IO Connection +connect fp = + do dbh <- connectSqlite3 fp + prepDB dbh + return dbh + +{- | Prepare the database for our data. + +We create two tables and ask the database engine to verify some pieces +of data consistency for us: + +* castid and epid both are unique primary keys and must never be duplicated +* castURL also is unique +* In the spidoes table, for a given podcast (epcast), there must be only + one instance of each given URL or episode ID +-} +prepDB :: IConnection conn => conn -> IO () +prepDB dbh = + do tables <- getTables dbh + when (not ("podcasts" `elem` tables)) $ + do run dbh "CREATE TABLE podcasts (\ + \castid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\ + \castURL TEXT NOT NULL UNIQUE)" [] + return () + when (not ("episodes" `elem` tables)) $ + do run dbh "CREATE TABLE episodes (\ + \epid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\ + \epcastid INTEGER NOT NULL,\ + \epurl TEXT NOT NULL,\ + \epdone INTEGER NOT NULL,\ + \UNIQUE(epcastid, epurl),\ + \UNIQUE(epcastid, epid))" [] + return () + commit dbh + +{- | Adds a new podcast to the database. Ignores the castid on the +incoming podcast, and returns a new object with the castid populated. + +An attempt to add a podcast that already exists is an error. -} +addPodcast :: IConnection conn => conn -> Podcast -> IO Podcast +addPodcast dbh podcast = + handleSql errorHandler $ + do -- Insert the castURL into the table. The database + -- will automatically assign a cast ID. + run dbh "INSERT INTO podcasts (castURL) VALUES (?)" + [toSql (castURL podcast)] + -- Find out the castID for the URL we just added. + r <- quickQuery' dbh "SELECT castid FROM podcasts WHERE castURL = ?" + [toSql (castURL podcast)] + case r of + [[x]] -> return $ podcast {castId = fromSql x} + y -> fail $ "addPodcast: unexpected result: " ++ show y + where errorHandler e = + do fail $ "Error adding podcast; does this URL already exist?\n" + ++ show e + +{- | Adds a new episode to the database. + +Since this is done by automation, instead of by user request, we will +simply ignore requests to add duplicate episodes. This way, when we are +processing a feed, each URL encountered can be fed to this function, +without having to first look it up in the DB. + +Also, we generally won't care about the new ID here, so don't bother +fetching it. -} +addEpisode :: IConnection conn => conn -> Episode -> IO () +addEpisode dbh ep = + run dbh "INSERT OR IGNORE INTO episodes (epCastId, epURL, epDone) \ + \VALUES (?, ?, ?)" + [toSql (castId . epCast $ ep), toSql (epURL ep), + toSql (epDone ep)] + >> return () + +{- | Modifies an existing podcast. Looks up the given podcast by +ID and modifies the database record to match the passed Podcast. -} +updatePodcast :: IConnection conn => conn -> Podcast -> IO () +updatePodcast dbh podcast = + run dbh "UPDATE podcasts SET castURL = ? WHERE castId = ?" + [toSql (castURL podcast), toSql (castId podcast)] + >> return () + +{- | Modifies an existing episode. Looks it up by ID and modifies the +database record to match the given episode. -} +updateEpisode :: IConnection conn => conn -> Episode -> IO () +updateEpisode dbh episode = + run dbh "UPDATE episodes SET epCastId = ?, epURL = ?, epDone = ? \ + \WHERE epId = ?" + [toSql (castId . epCast $ episode), + toSql (epURL episode), + toSql (epDone episode), + toSql (epId episode)] + >> return () + +{- | Remove a podcast. First removes any episodes that may exist +for this podcast. -} +removePodcast :: IConnection conn => conn -> Podcast -> IO () +removePodcast dbh podcast = + do run dbh "DELETE FROM episodes WHERE epcastid = ?" + [toSql (castId podcast)] + run dbh "DELETE FROM podcasts WHERE castid = ?" + [toSql (castId podcast)] + return () + +{- | Gets a list of all podcasts. -} +getPodcasts :: IConnection conn => conn -> IO [Podcast] +getPodcasts dbh = + do res <- quickQuery' dbh + "SELECT castid, casturl FROM podcasts ORDER BY castid" [] + return (map convPodcastRow res) + +{- | Get a particular podcast. Nothing if the ID doesn't match, or +Just Podcast if it does. -} +getPodcast :: IConnection conn => conn -> Integer -> IO (Maybe Podcast) +getPodcast dbh wantedId = + do res <- quickQuery' dbh + "SELECT castid, casturl FROM podcasts WHERE castid = ?" + [toSql wantedId] + case res of + [x] -> return (Just (convPodcastRow x)) + [] -> return Nothing + x -> fail $ "Really bad error; more than one podcast with ID" + +{- | Convert the result of a SELECT into a Podcast record -} +convPodcastRow :: [SqlValue] -> Podcast +convPodcastRow [svId, svURL] = + Podcast {castId = fromSql svId, + castURL = fromSql svURL} +convPodcastRow x = error $ "Can't convert podcast row " ++ show x + +{- | Get all episodes for a particular podcast. -} +getPodcastEpisodes :: IConnection conn => conn -> Podcast -> IO [Episode] +getPodcastEpisodes dbh pc = + do r <- quickQuery' dbh + "SELECT epId, epURL, epDone FROM episodes WHERE epCastId = ?" + [toSql (castId pc)] + return (map convEpisodeRow r) + where convEpisodeRow [svId, svURL, svDone] = + Episode {epId = fromSql svId, epURL = fromSql svURL, + epDone = fromSql svDone, epCast = pc} +{-- /snippet all --} diff --git a/ch23/23_a_1/PodDownload.hs b/ch23/23_a_1/PodDownload.hs new file mode 100644 index 0000000..84e6ab7 --- /dev/null +++ b/ch23/23_a_1/PodDownload.hs @@ -0,0 +1,65 @@ +{-- snippet all --} +module PodDownload where +import PodTypes +import PodDB +import PodParser +import Network.HTTP +import System.IO +import Database.HDBC +import Data.Maybe +import Network.URI + +{- | Download a URL. (Left errorMessage) if an error, +(Right doc) if success. -} +downloadURL :: String -> IO (Either String String) +downloadURL url = + do resp <- simpleHTTP request + case resp of + Left x -> return $ Left ("Error connecting: " ++ show x) + Right r -> + case rspCode r of + (2,_,_) -> return $ Right (rspBody r) + (3,_,_) -> -- A HTTP redirect + case findHeader HdrLocation r of + Nothing -> return $ Left (show r) + Just url -> downloadURL url + _ -> return $ Left (show r) + where request = Request {rqURI = uri, + rqMethod = GET, + rqHeaders = [], + rqBody = ""} + uri = fromJust $ parseURI url + +{- | Update the podcast in the database. -} +updatePodcastFromFeed :: IConnection conn => conn -> Podcast -> IO () +updatePodcastFromFeed dbh pc = + do resp <- downloadURL (castURL pc) + case resp of + Left x -> putStrLn x + Right doc -> updateDB doc + + where updateDB doc = + do mapM_ (addEpisode dbh) episodes + commit dbh + where feed = parse doc (castURL pc) + episodes = map (item2ep pc) (items feed) + +{- | Downloads an episode, returning a String representing +the filename it was placed into, or Nothing on error. -} +getEpisode :: IConnection conn => conn -> Episode -> IO (Maybe String) +getEpisode dbh ep = + do resp <- downloadURL (epURL ep) + case resp of + Left x -> do putStrLn x + return Nothing + Right doc -> + do file <- openBinaryFile filename WriteMode + hPutStr file doc + hClose file + updateEpisode dbh (ep {epDone = True}) + commit dbh + return (Just filename) + -- This function ought to apply an extension based on the filetype + where filename = "pod." ++ (show . castId . epCast $ ep) ++ "." ++ + (show (epId ep)) ++ ".mp3" +{-- /snippet all --} diff --git a/ch23/23_a_1/PodLocalMain.hs b/ch23/23_a_1/PodLocalMain.hs new file mode 100644 index 0000000..94bd963 --- /dev/null +++ b/ch23/23_a_1/PodLocalMain.hs @@ -0,0 +1,7 @@ +{-- snippet all --} +module Main where + +import qualified PodMainGUI + +main = PodMainGUI.main "podresources.glade" +{-- /snippet all --} diff --git a/ch23/23_a_1/PodMainGUI.hs b/ch23/23_a_1/PodMainGUI.hs new file mode 100644 index 0000000..943be01 --- /dev/null +++ b/ch23/23_a_1/PodMainGUI.hs @@ -0,0 +1,214 @@ +{-- snippet imports --} +module PodMainGUI where + +import PodDownload +import PodDB +import PodTypes +import System.Environment +import Database.HDBC +import Network.Socket(withSocketsDo) + +-- GUI libraries + +import Graphics.UI.Gtk hiding (disconnect) +import Graphics.UI.Gtk.Glade + +-- Threading + +import Control.Concurrent + +{-- /snippet imports --} + +{-- snippet type --} +-- | Our main GUI type +data GUI = GUI { + mainWin :: Window, + mwAddBt :: Button, + mwUpdateBt :: Button, + mwDownloadBt :: Button, + mwFetchBt :: Button, + mwExitBt :: Button, + statusWin :: Dialog, + swOKBt :: Button, + swCancelBt :: Button, + swLabel :: Label, + addWin :: Dialog, + awOKBt :: Button, + awCancelBt :: Button, + awEntry :: Entry} +{-- /snippet type --} + +{-- snippet main --} +main :: FilePath -> IO () +main gladepath = withSocketsDo $ handleSqlError $ + do initGUI -- Initialize GTK+ engine + + -- Every so often, we try to run other threads. + timeoutAddFull (yield >> return True) + priorityDefaultIdle 100 + + -- Load the GUI from the Glade file + gui <- loadGlade gladepath + + -- Connect to the database + dbh <- connect "pod.db" + + -- Set up our events + connectGui gui dbh + + -- Run the GTK+ main loop; exits after GUI is done + mainGUI + + -- Disconnect from the database at the end + disconnect dbh +{-- /snippet main --} + +{-- snippet loadGlade --} +loadGlade gladepath = + do -- Load XML from glade path. + -- Note: crashes with a runtime error on console if fails! + Just xml <- xmlNew gladepath + + -- Load main window + mw <- xmlGetWidget xml castToWindow "mainWindow" + + -- Load all buttons + + [mwAdd, mwUpdate, mwDownload, mwFetch, mwExit, swOK, swCancel, + auOK, auCancel] <- + mapM (xmlGetWidget xml castToButton) + ["addButton", "updateButton", "downloadButton", + "fetchButton", "exitButton", "okButton", "cancelButton", + "auOK", "auCancel"] + + sw <- xmlGetWidget xml castToDialog "statusDialog" + swl <- xmlGetWidget xml castToLabel "statusLabel" + + au <- xmlGetWidget xml castToDialog "addDialog" + aue <- xmlGetWidget xml castToEntry "auEntry" + + return $ GUI mw mwAdd mwUpdate mwDownload mwFetch mwExit + sw swOK swCancel swl au auOK auCancel aue +{-- /snippet loadGlade --} + +{-- snippet connectGui --} +connectGui gui dbh = + do -- When the close button is clicked, terminate GUI loop + -- by calling GTK mainQuit function + onDestroy (mainWin gui) mainQuit + + -- Main window buttons + onClicked (mwAddBt gui) (guiAdd gui dbh) + onClicked (mwUpdateBt gui) (guiUpdate gui dbh) + onClicked (mwDownloadBt gui) (guiDownload gui dbh) + onClicked (mwFetchBt gui) (guiFetch gui dbh) + onClicked (mwExitBt gui) mainQuit + + -- We leave the status window buttons for later +{-- /snippet connectGui --} + +{-- snippet guiAdd --} +guiAdd gui dbh = + do -- Initialize the add URL window + entrySetText (awEntry gui) "" + onClicked (awCancelBt gui) (widgetHide (addWin gui)) + onClicked (awOKBt gui) procOK + + -- Show the add URL window + windowPresent (addWin gui) + where procOK = + do url <- entryGetText (awEntry gui) + widgetHide (addWin gui) -- Remove the dialog + add dbh url -- Add to the DB +{-- /snippet guiAdd --} + +{-- snippet statusWindow --} +statusWindow :: IConnection conn => + GUI + -> conn + -> String + -> ((String -> IO ()) -> IO ()) + -> IO () +statusWindow gui dbh title func = + do -- Clear the status text + labelSetText (swLabel gui) "" + + -- Disable the OK button, enable Cancel button + widgetSetSensitivity (swOKBt gui) False + widgetSetSensitivity (swCancelBt gui) True + + -- Set the title + windowSetTitle (statusWin gui) title + + -- Start the operation + childThread <- forkIO childTasks + + -- Define what happens when clicking on Cancel + onClicked (swCancelBt gui) (cancelChild childThread) + + -- Show the window + windowPresent (statusWin gui) + where childTasks = + do updateLabel "Starting thread..." + func updateLabel + -- After the child task finishes, enable OK + -- and disable Cancel + enableOK + + enableOK = + do widgetSetSensitivity (swCancelBt gui) False + widgetSetSensitivity (swOKBt gui) True + onClicked (swOKBt gui) (widgetHide (statusWin gui)) + return () + + updateLabel text = + labelSetText (swLabel gui) text + cancelChild childThread = + do killThread childThread + yield + updateLabel "Action has been cancelled." + enableOK +{-- /snippet statusWindow --} + +{-- snippet statusWindowFuncs --} +guiUpdate :: IConnection conn => GUI -> conn -> IO () +guiUpdate gui dbh = + statusWindow gui dbh "Pod: Update" (update dbh) + +guiDownload gui dbh = + statusWindow gui dbh "Pod: Download" (download dbh) + +guiFetch gui dbh = + statusWindow gui dbh "Pod: Fetch" + (\logf -> update dbh logf >> download dbh logf) +{-- /snippet statusWindowFuncs --} + +{-- snippet workerFuncs --} +add dbh url = + do addPodcast dbh pc + commit dbh + where pc = Podcast {castId = 0, castURL = url} + +update :: IConnection conn => conn -> (String -> IO ()) -> IO () +update dbh logf = + do pclist <- getPodcasts dbh + mapM_ procPodcast pclist + logf "Update complete." + where procPodcast pc = + do logf $ "Updating from " ++ (castURL pc) + updatePodcastFromFeed dbh pc + +download dbh logf = + do pclist <- getPodcasts dbh + mapM_ procPodcast pclist + logf "Download complete." + where procPodcast pc = + do logf $ "Considering " ++ (castURL pc) + episodelist <- getPodcastEpisodes dbh pc + let dleps = filter (\ep -> epDone ep == False) + episodelist + mapM_ procEpisode dleps + procEpisode ep = + do logf $ "Downloading " ++ (epURL ep) + getEpisode dbh ep +{-- /snippet workerFuncs --} diff --git a/ch23/23_a_1/PodParser.hs b/ch23/23_a_1/PodParser.hs new file mode 100644 index 0000000..2ec1a17 --- /dev/null +++ b/ch23/23_a_1/PodParser.hs @@ -0,0 +1,106 @@ +{-- snippet all --} +module PodParser where + +import PodTypes +import Text.XML.HaXml +import Text.XML.HaXml.Parse +import Text.XML.HaXml.Html.Generate(showattr) +import Data.Char +import Data.List + +data Item = Item {itemtitle :: String, + enclosureurl :: String + } + deriving (Eq, Show, Read) + +data Feed = Feed {channeltitle :: String, + items :: [Item]} + deriving (Eq, Show, Read) + +{- | Given a podcast and an Item, produce an Episode -} +item2ep :: Podcast -> Item -> Episode +item2ep pc item = + Episode {epId = 0, + epCast = pc, + epURL = enclosureurl item, + epDone = False} + +{- | Parse the data from a given string, with the given name to use +in error messages. -} +parse :: String -> String -> Feed +parse content name = + Feed {channeltitle = getTitle doc, + items = getEnclosures doc} + + where parseResult = xmlParse name (stripUnicodeBOM content) + doc = getContent parseResult + + getContent :: Document -> Content + getContent (Document _ _ e _) = CElem e + + {- | Some Unicode documents begin with a binary sequence; + strip it off before processing. -} + stripUnicodeBOM :: String -> String + stripUnicodeBOM ('\xef':'\xbb':'\xbf':x) = x + stripUnicodeBOM x = x + +{- | Pull out the channel part of the document. + +Note that HaXml defines CFilter as: + +> type CFilter = Content -> [Content] +-} +channel :: CFilter +channel = tag "rss" /> tag "channel" + +getTitle :: Content -> String +getTitle doc = + contentToStringDefault "Untitled Podcast" + (channel /> tag "title" /> txt $ doc) + +getEnclosures :: Content -> [Item] +getEnclosures doc = + concatMap procItem $ getItems doc + where procItem :: Content -> [Item] + procItem item = concatMap (procEnclosure title) enclosure + where title = contentToStringDefault "Untitled Episode" + (keep /> tag "title" /> txt $ item) + enclosure = (keep /> tag "enclosure") item + + getItems :: CFilter + getItems = channel /> tag "item" + + procEnclosure :: String -> Content -> [Item] + procEnclosure title enclosure = + map makeItem (showattr "url" enclosure) + where makeItem :: Content -> Item + makeItem x = Item {itemtitle = title, + enclosureurl = contentToString [x]} + +{- | Convert [Content] to a printable String, with a default if the +passed-in [Content] is [], signifying a lack of a match. -} +contentToStringDefault :: String -> [Content] -> String +contentToStringDefault msg [] = msg +contentToStringDefault _ x = contentToString x + +{- | Convert [Content] to a printable string, taking care to unescape it. + +An implementation without unescaping would simply be: + +> contentToString = concatMap (show . content) + +Because HaXml's unescaping only works on Elements, we must make sure that +whatever Content we have is wrapped in an Element, then use txt to +pull the insides back out. -} +contentToString :: [Content] -> String +contentToString = + concatMap procContent + where procContent x = + verbatim $ keep /> txt $ CElem (unesc (fakeElem x)) + + fakeElem :: Content -> Element + fakeElem x = Elem "fake" [] [x] + + unesc :: Element -> Element + unesc = xmlUnEscape stdXmlEscaper +{-- /snippet all --} diff --git a/ch23/23_a_1/PodTypes.hs b/ch23/23_a_1/PodTypes.hs new file mode 100644 index 0000000..85a205b --- /dev/null +++ b/ch23/23_a_1/PodTypes.hs @@ -0,0 +1,17 @@ +{-- snippet all --} +module PodTypes where + +data Podcast = + Podcast {castId :: Integer, -- ^ Numeric ID for this podcast + castURL :: String -- ^ Its feed URL + } + deriving (Eq, Show, Read) + +data Episode = + Episode {epId :: Integer, -- ^ Numeric ID for this episode + epCast :: Podcast, -- ^ The ID of the podcast it came from + epURL :: String, -- ^ The download URL for this episode + epDone :: Bool -- ^ Whether or not we are done with this ep + } + deriving (Eq, Show, Read) +{-- /snippet all --} diff --git a/ch23/23_a_1/Setup.hs b/ch23/23_a_1/Setup.hs new file mode 100644 index 0000000..f9062b2 --- /dev/null +++ b/ch23/23_a_1/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhugs +import Distribution.Simple + +main = defaultMain + diff --git a/ch23/23_a_1/pod.cabal b/ch23/23_a_1/pod.cabal new file mode 100644 index 0000000..c7e4976 --- /dev/null +++ b/ch23/23_a_1/pod.cabal @@ -0,0 +1,11 @@ +-- ch24/pod.cabal +Name: pod +Version: 1.0.0 +Build-type: Simple +Build-Depends: HTTP, HaXml, network, HDBC, HDBC-sqlite3, base, + gtk, glade +Data-files: podresources.glade + +Executable: pod +Main-Is: PodCabalMain.hs +GHC-Options: -O2 diff --git a/ch23/23_a_1/podresources.glade b/ch23/23_a_1/podresources.glade new file mode 100644 index 0000000..ed8266b --- /dev/null +++ b/ch23/23_a_1/podresources.glade @@ -0,0 +1,236 @@ + + + + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + Pod + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + + + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + _Add New Podcast + True + 0 + + + + + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + _Update Podcast Feeds + True + 0 + + + 1 + + + + + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + _Download New Episodes + True + 0 + + + 2 + + + + + True + True + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + _Fetch (Update and Download) + True + 0 + + + 3 + + + + + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + E_xit + True + 0 + + + 4 + + + + + + + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + 5 + Pod Progress + True + GTK_WIN_POS_CENTER_ON_PARENT + True + GDK_WINDOW_TYPE_HINT_DIALOG + False + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + 2 + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + 0 + 0 + Status area + + + 1 + + + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + GTK_BUTTONBOX_END + + + True + False + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + gtk-ok + True + 0 + + + + + True + True + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + gtk-cancel + True + 0 + + + 1 + + + + + False + GTK_PACK_END + + + + + + + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + 5 + Add Podcast + True + GTK_WIN_POS_CENTER_ON_PARENT + GDK_WINDOW_TYPE_HINT_DIALOG + False + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + 2 + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + URL of new podcast: + + + + + True + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + True + + + 1 + + + + + 1 + + + + + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + GTK_BUTTONBOX_END + + + True + True + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + gtk-ok + True + 0 + + + + + True + True + True + GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK + gtk-cancel + True + 0 + + + 1 + + + + + False + GTK_PACK_END + + + + + + -- cgit v1.2.3