1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Widget AboutDialog
4--
5--  Author : Duncan Coutts
6--
7--  Created: 1 March 2005
8--
9--  Copyright (C) 2005 Duncan Coutts
10--
11--  This library is free software; you can redistribute it and/or
12--  modify it under the terms of the GNU Lesser General Public
13--  License as published by the Free Software Foundation; either
14--  version 2.1 of the License, or (at your option) any later version.
15--
16--  This library is distributed in the hope that it will be useful,
17--  but WITHOUT ANY WARRANTY; without even the implied warranty of
18--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19--  Lesser General Public License for more details.
20--
21-- |
22-- Maintainer  : gtk2hs-users@lists.sourceforge.net
23-- Stability   : provisional
24-- Portability : portable (depends on GHC)
25--
26-- Display information about an application
27--
28-- * Module available since Gtk+ version 2.6
29--
30module Graphics.UI.Gtk.Windows.AboutDialog (
31-- * Detail
32--
33-- | The 'AboutDialog' offers a simple way to display information about a
34-- program like its logo, name, copyright, website and license. It is also
35-- possible to give credits to the authors, documenters, translators and
36-- artists who have worked on the program. An about dialog is typically opened
37-- when the user selects the @About@ option from the @Help@ menu. All parts of
38-- the dialog are optional.
39--
40-- About dialog often contain links and email addresses. 'AboutDialog'
41-- supports this by offering global hooks, which are called when the user
42-- clicks on a link or email address, see 'aboutDialogSetEmailHook' and
43-- 'aboutDialogSetUrlHook'. Email addresses in the authors, documenters and
44-- artists properties are recognized by looking for @\<user\@host>@, URLs are
45-- recognized by looking for @http:\/\/url@, with @url@ extending to the next
46-- space, tab or line break.
47-- Since 2.18 'AboutDialog' provides default website and email hooks that
48-- use 'showURI'.
49--
50-- Note that Gtk+ sets a default title of @_(\"About %s\")@ on the dialog
51-- window (where %s is replaced by the name of the application, but in order to
52-- ensure proper translation of the title, applications should set the title
53-- property explicitly when constructing a 'AboutDialog', as shown in the
54-- following example:
55--
56-- Note that prior to Gtk+ 2.12, the 'aboutDialogProgramName' property was called
57-- 'aboutDialogName'. Both names may be used in Gtk2Hs.
58
59-- * Class Hierarchy
60-- |
61-- @
62-- |  'GObject'
63-- |   +----'Object'
64-- |         +----'Widget'
65-- |               +----'Container'
66-- |                     +----'Bin'
67-- |                           +----'Window'
68-- |                                 +----'Dialog'
69-- |                                       +----AboutDialog
70-- @
71
72#if GTK_CHECK_VERSION(2,6,0)
73-- * Types
74  AboutDialog,
75  AboutDialogClass,
76  castToAboutDialog, gTypeAboutDialog,
77  toAboutDialog,
78
79-- * Constructors
80  aboutDialogNew,
81
82-- * Methods
83#if GTK_MAJOR_VERSION < 3
84  aboutDialogSetEmailHook,
85  aboutDialogSetUrlHook,
86#endif
87
88-- * Attributes
89  aboutDialogProgramName,
90  aboutDialogName,
91  aboutDialogVersion,
92  aboutDialogCopyright,
93  aboutDialogComments,
94  aboutDialogLicense,
95  aboutDialogWebsite,
96  aboutDialogWebsiteLabel,
97  aboutDialogAuthors,
98  aboutDialogDocumenters,
99  aboutDialogArtists,
100  aboutDialogTranslatorCredits,
101  aboutDialogLogo,
102  aboutDialogLogoIconName,
103#if GTK_CHECK_VERSION(2,8,0)
104  aboutDialogWrapLicense,
105#endif
106
107-- * Deprecated
108#ifndef DISABLE_DEPRECATED
109  aboutDialogGetName,
110  aboutDialogSetName,
111  aboutDialogGetVersion,
112  aboutDialogSetVersion,
113  aboutDialogGetCopyright,
114  aboutDialogSetCopyright,
115  aboutDialogGetComments,
116  aboutDialogSetComments,
117  aboutDialogGetLicense,
118  aboutDialogSetLicense,
119  aboutDialogGetWebsite,
120  aboutDialogSetWebsite,
121  aboutDialogGetWebsiteLabel,
122  aboutDialogSetWebsiteLabel,
123  aboutDialogSetAuthors,
124  aboutDialogGetAuthors,
125  aboutDialogSetArtists,
126  aboutDialogGetArtists,
127  aboutDialogSetDocumenters,
128  aboutDialogGetDocumenters,
129  aboutDialogGetTranslatorCredits,
130  aboutDialogSetTranslatorCredits,
131  aboutDialogGetLogo,
132  aboutDialogSetLogo,
133  aboutDialogGetLogoIconName,
134  aboutDialogSetLogoIconName,
135#if GTK_CHECK_VERSION(2,8,0)
136  aboutDialogGetWrapLicense,
137  aboutDialogSetWrapLicense,
138#endif
139#endif
140#endif
141  ) where
142
143import Control.Monad    (liftM)
144import Data.Maybe       (fromMaybe)
145
146import System.Glib.FFI
147import System.Glib.UTFString
148import System.Glib.Attributes
149import System.Glib.Properties
150import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
151{#import Graphics.UI.Gtk.Types#}
152
153{# context lib="gtk" prefix="gtk" #}
154
155#if GTK_CHECK_VERSION(2,6,0)
156--------------------
157-- Constructors
158
159-- | Creates a new 'AboutDialog'.
160--
161aboutDialogNew :: IO AboutDialog
162aboutDialogNew =
163  makeNewObject mkAboutDialog $
164  liftM (castPtr :: Ptr Widget -> Ptr AboutDialog) $
165  {# call gtk_about_dialog_new #}
166
167--------------------
168-- Methods
169
170#ifndef DISABLE_DEPRECATED
171-- | Returns the program name displayed in the about dialog.
172--
173aboutDialogGetName :: (AboutDialogClass self, GlibString string) => self
174 -> IO string -- ^ returns The program name.
175aboutDialogGetName self =
176#if GTK_CHECK_VERSION(2,12,0)
177  {# call gtk_about_dialog_get_program_name #}
178#else
179  {# call gtk_about_dialog_get_name #}
180#endif
181    (toAboutDialog self)
182  >>= peekUTFString
183
184-- | Sets the name to display in the about dialog. If this is not set, it
185-- defaults to the program executable name.
186--
187aboutDialogSetName :: (AboutDialogClass self, GlibString string) => self
188 -> string -- ^ @name@ - the program name
189 -> IO ()
190aboutDialogSetName self name =
191  withUTFString name $ \namePtr ->
192#if GTK_CHECK_VERSION(2,12,0)
193  {# call gtk_about_dialog_set_program_name #}
194#else
195  {# call gtk_about_dialog_set_name #}
196#endif
197    (toAboutDialog self)
198    namePtr
199
200-- | Returns the version string.
201--
202aboutDialogGetVersion :: (AboutDialogClass self, GlibString string) => self -> IO string
203aboutDialogGetVersion self =
204  {# call gtk_about_dialog_get_version #}
205    (toAboutDialog self)
206  >>= peekUTFString
207
208-- | Sets the version string to display in the about dialog.
209--
210aboutDialogSetVersion :: (AboutDialogClass self, GlibString string) => self -> string -> IO ()
211aboutDialogSetVersion self version =
212  withUTFString version $ \versionPtr ->
213  {# call gtk_about_dialog_set_version #}
214    (toAboutDialog self)
215    versionPtr
216
217-- | Returns the copyright string.
218--
219aboutDialogGetCopyright :: (AboutDialogClass self, GlibString string) => self -> IO string
220aboutDialogGetCopyright self =
221  {# call gtk_about_dialog_get_copyright #}
222    (toAboutDialog self)
223  >>= peekUTFString
224
225-- | Sets the copyright string to display in the about dialog. This should be
226-- a short string of one or two lines.
227--
228aboutDialogSetCopyright :: (AboutDialogClass self, GlibString string) => self -> string -> IO ()
229aboutDialogSetCopyright self copyright =
230  withUTFString copyright $ \copyrightPtr ->
231  {# call gtk_about_dialog_set_copyright #}
232    (toAboutDialog self)
233    copyrightPtr
234
235-- | Returns the comments string.
236--
237aboutDialogGetComments :: (AboutDialogClass self, GlibString string) => self -> IO string
238aboutDialogGetComments self =
239  {# call gtk_about_dialog_get_comments #}
240    (toAboutDialog self)
241  >>= peekUTFString
242
243-- | Sets the comments string to display in the about dialog. This should be a
244-- short string of one or two lines.
245--
246aboutDialogSetComments :: (AboutDialogClass self, GlibString string) => self -> string -> IO ()
247aboutDialogSetComments self comments =
248  withUTFString comments $ \commentsPtr ->
249  {# call gtk_about_dialog_set_comments #}
250    (toAboutDialog self)
251    commentsPtr
252
253-- | Returns the license information.
254--
255aboutDialogGetLicense :: (AboutDialogClass self, GlibString string) => self -> IO (Maybe string)
256aboutDialogGetLicense self =
257  {# call gtk_about_dialog_get_license #}
258    (toAboutDialog self)
259  >>= maybePeek peekUTFString
260
261-- | Sets the license information to be displayed in the secondary license
262-- dialog. If @license@ is @Nothing@, the license button is hidden.
263--
264aboutDialogSetLicense :: (AboutDialogClass self, GlibString string) => self
265 -> Maybe string -- ^ @license@ - the license information or @Nothing@
266 -> IO ()
267aboutDialogSetLicense self license =
268  maybeWith withUTFString license $ \licensePtr ->
269  {# call gtk_about_dialog_set_license #}
270    (toAboutDialog self)
271    licensePtr
272
273-- | Returns the website URL.
274--
275aboutDialogGetWebsite :: (AboutDialogClass self, GlibString string) => self -> IO string
276aboutDialogGetWebsite self =
277  {# call gtk_about_dialog_get_website #}
278    (toAboutDialog self)
279  >>= peekUTFString
280
281-- | Sets the URL to use for the website link.
282--
283aboutDialogSetWebsite :: (AboutDialogClass self, GlibString string) => self
284 -> string -- ^ @website@ - a URL string starting with \"http:\/\/\"
285 -> IO ()
286aboutDialogSetWebsite self website =
287  withUTFString website $ \websitePtr ->
288  {# call gtk_about_dialog_set_website #}
289    (toAboutDialog self)
290    websitePtr
291
292-- | Returns the label used for the website link.
293--
294aboutDialogGetWebsiteLabel :: (AboutDialogClass self, GlibString string) => self -> IO string
295aboutDialogGetWebsiteLabel self =
296  {# call gtk_about_dialog_get_website_label #}
297    (toAboutDialog self)
298  >>= peekUTFString
299
300-- | Sets the label to be used for the website link. It defaults to the
301-- website URL.
302--
303aboutDialogSetWebsiteLabel :: (AboutDialogClass self, GlibString string) => self -> string -> IO ()
304aboutDialogSetWebsiteLabel self websiteLabel =
305  withUTFString websiteLabel $ \websiteLabelPtr ->
306  {# call gtk_about_dialog_set_website_label #}
307    (toAboutDialog self)
308    websiteLabelPtr
309#endif
310
311-- | Sets the strings which are displayed in the authors tab of the secondary
312-- credits dialog.
313--
314aboutDialogSetAuthors :: (AboutDialogClass self, GlibString string) => self
315 -> [string] -- ^ @authors@ - a list of author names
316 -> IO ()
317aboutDialogSetAuthors self authors =
318  withUTFStringArray0 authors $ \authorsPtr ->
319  {# call gtk_about_dialog_set_authors #}
320    (toAboutDialog self)
321    authorsPtr
322
323-- | Returns the string which are displayed in the authors tab of the
324-- secondary credits dialog.
325--
326aboutDialogGetAuthors :: (AboutDialogClass self, GlibString string) => self -> IO [string]
327aboutDialogGetAuthors self =
328  {# call gtk_about_dialog_get_authors #}
329    (toAboutDialog self)
330  >>= peekUTFStringArray0
331
332-- | Sets the strings which are displayed in the artists tab of the secondary
333-- credits dialog.
334--
335aboutDialogSetArtists :: (AboutDialogClass self, GlibString string) => self
336 -> [string] -- ^ @artists@ - a list of artist names
337 -> IO ()
338aboutDialogSetArtists self artists =
339  withUTFStringArray0 artists $ \artistsPtr ->
340  {# call gtk_about_dialog_set_artists #}
341    (toAboutDialog self)
342    artistsPtr
343
344-- | Returns the string which are displayed in the artists tab of the
345-- secondary credits dialog.
346--
347aboutDialogGetArtists :: (AboutDialogClass self, GlibString string) => self -> IO [string]
348aboutDialogGetArtists self =
349  {# call gtk_about_dialog_get_artists #}
350    (toAboutDialog self)
351  >>= peekUTFStringArray0
352
353-- | Sets the strings which are displayed in the documenters tab of the
354-- secondary credits dialog.
355--
356aboutDialogSetDocumenters :: (AboutDialogClass self, GlibString string) => self
357 -> [string] -- ^ @artists@ - a list of documenter names
358 -> IO ()
359aboutDialogSetDocumenters self documenters =
360  withUTFStringArray0 documenters $ \documentersPtr ->
361  {# call gtk_about_dialog_set_documenters #}
362    (toAboutDialog self)
363    documentersPtr
364
365-- | Returns the string which are displayed in the documenters tab of the
366-- secondary credits dialog.
367--
368aboutDialogGetDocumenters :: (AboutDialogClass self, GlibString string) => self -> IO [string]
369aboutDialogGetDocumenters self =
370  {# call gtk_about_dialog_get_documenters #}
371    (toAboutDialog self)
372  >>= peekUTFStringArray0
373
374#ifndef DISABLE_DEPRECATED
375-- | Returns the translator credits string which is displayed in the
376-- translators tab of the secondary credits dialog.
377--
378aboutDialogGetTranslatorCredits :: (AboutDialogClass self, GlibString string) => self -> IO string
379aboutDialogGetTranslatorCredits self =
380  {# call gtk_about_dialog_get_translator_credits #}
381    (toAboutDialog self)
382  >>= peekUTFString
383
384-- | Sets the translator credits string which is displayed in the translators
385-- tab of the secondary credits dialog.
386--
387-- The intended use for this string is to display the translator of the
388-- language which is currently used in the user interface.
389--
390aboutDialogSetTranslatorCredits :: (AboutDialogClass self, GlibString string) => self -> string -> IO ()
391aboutDialogSetTranslatorCredits self translatorCredits =
392  withUTFString translatorCredits $ \translatorCreditsPtr ->
393  {# call gtk_about_dialog_set_translator_credits #}
394    (toAboutDialog self)
395    translatorCreditsPtr
396#endif
397
398-- | Returns the pixbuf displayed as logo in the about dialog.
399--
400aboutDialogGetLogo :: AboutDialogClass self => self -> IO Pixbuf
401aboutDialogGetLogo self =
402  makeNewGObject mkPixbuf $
403  {# call gtk_about_dialog_get_logo #}
404    (toAboutDialog self)
405
406-- | Sets the pixbuf to be displayed as logo in the about dialog. If it is
407-- @Nothing@, the default window icon set with 'windowSetDefaultIcon' will be
408-- used.
409--
410aboutDialogSetLogo :: AboutDialogClass self => self
411 -> Maybe Pixbuf -- ^ @logo@ - a 'Pixbuf', or @Nothing@
412 -> IO ()
413aboutDialogSetLogo self logo =
414  {# call gtk_about_dialog_set_logo #}
415    (toAboutDialog self)
416    (fromMaybe (Pixbuf nullForeignPtr) logo)
417
418-- | Returns the icon name displayed as logo in the about dialog.
419--
420aboutDialogGetLogoIconName :: (AboutDialogClass self, GlibString string) => self -> IO string
421aboutDialogGetLogoIconName self =
422  {# call gtk_about_dialog_get_logo_icon_name #}
423    (toAboutDialog self)
424  >>= peekUTFString
425
426-- | Sets the pixbuf to be displayed as logo in the about dialog. If it is
427-- @Nothing@, the default window icon set with 'windowSetDefaultIcon' will be
428-- used.
429--
430aboutDialogSetLogoIconName :: (AboutDialogClass self, GlibString string) => self
431 -> Maybe string -- ^ @iconName@ - an icon name, or @Nothing@
432 -> IO ()
433aboutDialogSetLogoIconName self iconName =
434  maybeWith withUTFString iconName $ \iconNamePtr ->
435  {# call gtk_about_dialog_set_logo_icon_name #}
436    (toAboutDialog self)
437    iconNamePtr
438
439#if GTK_MAJOR_VERSION < 3
440-- | Installs a global function to be called whenever the user activates an
441-- email link in an about dialog.
442--
443-- Removed in Gtk3.
444aboutDialogSetEmailHook :: GlibString string
445 => (string -> IO ()) -- ^ @(\url -> ...)@ - a function to call when an email
446                      -- link is activated.
447 -> IO ()
448aboutDialogSetEmailHook func = do
449  funcPtr <- mkAboutDialogActivateLinkFunc (\_ linkPtr _ -> do
450    link <- peekUTFString linkPtr
451    func link
452    )
453  {# call gtk_about_dialog_set_email_hook #}
454    funcPtr
455    (castFunPtrToPtr funcPtr)
456    destroyFunPtr
457  return ()
458
459-- | Installs a global function to be called whenever the user activates a URL
460-- link in an about dialog.
461--
462-- Removed in Gtk3.
463aboutDialogSetUrlHook ::GlibString string
464 => (string -> IO ()) -- ^ @(\url -> ...)@ - a function to call when a URL link
465                      -- is activated.
466 -> IO ()
467aboutDialogSetUrlHook func = do
468  funcPtr <- mkAboutDialogActivateLinkFunc (\_ linkPtr _ -> do
469    link <- peekUTFString linkPtr
470    func link
471    )
472  {# call gtk_about_dialog_set_url_hook #}
473    funcPtr
474    (castFunPtrToPtr funcPtr)
475    destroyFunPtr
476  return ()
477
478{# pointer AboutDialogActivateLinkFunc #}
479
480foreign import ccall "wrapper" mkAboutDialogActivateLinkFunc ::
481  (Ptr AboutDialog -> CString -> Ptr () -> IO ()) -> IO AboutDialogActivateLinkFunc
482#endif
483
484#ifndef DISABLE_DEPRECATED
485#if GTK_CHECK_VERSION(2,8,0)
486-- | Returns whether the license text in @about@ is automatically wrapped.
487--
488-- * Available since Gtk+ version 2.8
489--
490aboutDialogGetWrapLicense :: AboutDialogClass self => self
491 -> IO Bool -- ^ returns @True@ if the license text is wrapped
492aboutDialogGetWrapLicense self =
493  liftM toBool $
494  {# call gtk_about_dialog_get_wrap_license #}
495    (toAboutDialog self)
496
497-- | Sets whether the license text in @about@ is automatically wrapped.
498--
499-- * Available since Gtk+ version 2.8
500--
501aboutDialogSetWrapLicense :: AboutDialogClass self => self
502 -> Bool  -- ^ @wrapLicense@ - whether to wrap the license
503 -> IO ()
504aboutDialogSetWrapLicense self wrapLicense =
505  {# call gtk_about_dialog_set_wrap_license #}
506    (toAboutDialog self)
507    (fromBool wrapLicense)
508#endif
509#endif
510
511--------------------
512-- Attributes
513
514-- | The name of the program. If this is not set, it defaults to
515-- 'gGetApplicationName'.
516--
517aboutDialogName :: (AboutDialogClass self, GlibString string) => Attr self string
518aboutDialogName = newAttrFromStringProperty "name"
519
520-- | The name of the program. If this is not set, it defaults to
521-- 'gGetApplicationName'.
522--
523#if GTK_CHECK_VERSION(2,12,0)
524aboutDialogProgramName :: (AboutDialogClass self, GlibString string) => Attr self string
525aboutDialogProgramName = newAttrFromStringProperty "program-name"
526#else
527aboutDialogProgramName :: (AboutDialogClass self, GlibString string) => Attr self string
528aboutDialogProgramName = newAttrFromStringProperty "name"
529#endif
530
531-- | The version of the program.
532--
533aboutDialogVersion :: (AboutDialogClass self, GlibString string) => Attr self string
534aboutDialogVersion = newAttrFromStringProperty "version"
535
536-- | Copyright information for the program.
537--
538aboutDialogCopyright :: (AboutDialogClass self, GlibString string) => Attr self string
539aboutDialogCopyright = newAttrFromStringProperty "copyright"
540
541-- | Comments about the program. This string is displayed in a label in the
542-- main dialog, thus it should be a short explanation of the main purpose of
543-- the program, not a detailed list of features.
544--
545aboutDialogComments :: (AboutDialogClass self, GlibString string) => Attr self string
546aboutDialogComments = newAttrFromStringProperty "comments"
547
548-- | The license of the program. This string is displayed in a text view in a
549-- secondary dialog, therefore it is fine to use a long multi-paragraph text.
550-- Note that the text is only wrapped in the text view if the 'aboutDialogWrapLicense'
551-- property is set to @True@; otherwise the text itself must contain the
552-- intended linebreaks.
553--
554-- Default value: @Nothing@
555--
556aboutDialogLicense :: (AboutDialogClass self, GlibString string) => Attr self (Maybe string)
557aboutDialogLicense = newAttrFromMaybeStringProperty "license"
558
559-- | The URL for the link to the website of the program. This should be a
560-- string starting with \"http:\/\/.
561--
562aboutDialogWebsite :: (AboutDialogClass self, GlibString string) => Attr self string
563aboutDialogWebsite = newAttrFromStringProperty "website"
564
565-- | The label for the link to the website of the program. If this is not set,
566-- it defaults to the URL specified in the website property.
567--
568aboutDialogWebsiteLabel :: (AboutDialogClass self, GlibString string) => Attr self string
569aboutDialogWebsiteLabel = newAttrFromStringProperty "website-label"
570
571-- | The authors of the program. Each string may
572-- contain email addresses and URLs, which will be displayed as links, see the
573-- introduction for more details.
574--
575aboutDialogAuthors :: (AboutDialogClass self, GlibString string) => Attr self [string]
576aboutDialogAuthors = newAttr
577  aboutDialogGetAuthors
578  aboutDialogSetAuthors
579
580-- | The people documenting the program.
581-- Each string may contain email addresses and URLs, which will be displayed as
582-- links, see the introduction for more details.
583--
584aboutDialogDocumenters :: (AboutDialogClass self, GlibString string) => Attr self [string]
585aboutDialogDocumenters = newAttr
586  aboutDialogGetDocumenters
587  aboutDialogSetDocumenters
588
589-- | The people who contributed artwork to the program.
590-- Each string may contain email addresses and URLs, which will be
591-- displayed as links, see the introduction for more details.
592--
593aboutDialogArtists :: (AboutDialogClass self, GlibString string) => Attr self [string]
594aboutDialogArtists = newAttr
595  aboutDialogGetArtists
596  aboutDialogSetArtists
597
598-- | Credits to the translators. This string should be marked as translatable.
599-- The string may contain email addresses and URLs, which will be displayed as
600-- links, see the introduction for more details.
601--
602aboutDialogTranslatorCredits :: (AboutDialogClass self, GlibString string) => Attr self string
603aboutDialogTranslatorCredits = newAttrFromStringProperty "translator-credits"
604
605-- | A logo for the about box. If this is not set, it defaults to
606-- 'windowGetDefaultIconList'.
607--
608aboutDialogLogo :: AboutDialogClass self => ReadWriteAttr self Pixbuf (Maybe Pixbuf)
609aboutDialogLogo = newAttr
610  aboutDialogGetLogo
611  aboutDialogSetLogo
612
613-- | A named icon to use as the logo for the about box. This property
614-- overrides the logo property.
615--
616-- Default value: @Nothing@
617--
618aboutDialogLogoIconName :: (AboutDialogClass self, GlibString string) => ReadWriteAttr self string (Maybe string)
619aboutDialogLogoIconName = newAttr
620  aboutDialogGetLogoIconName
621  aboutDialogSetLogoIconName
622#endif
623
624#if GTK_CHECK_VERSION(2,8,0)
625-- | Whether to wrap the text in the license dialog.
626--
627-- Default value: @False@
628--
629aboutDialogWrapLicense :: AboutDialogClass self => Attr self Bool
630aboutDialogWrapLicense = newAttrFromBoolProperty "wrap-license"
631#endif
632