ui.backend.gtk, tools.deploy.unix: support for icons

basis/glib/ffi/ffi.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Anton Gorenko.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.destructors
-alien.libraries alien.syntax combinators compiler.units gir
-kernel system vocabs.parser words ;
+alien.libraries alien.strings alien.syntax combinators gir
+io.encodings.utf8 kernel system vocabs.parser words ;
 IN: glib.ffi
 
 <<
@@ -78,3 +78,17 @@ CALLBACK: gboolean GSourceFuncsPrepareFunc ( GSource* source, gint* timeout_ ) ;
 CALLBACK: gboolean GSourceFuncsCheckFunc ( GSource* source ) ;
 CALLBACK: gboolean GSourceFuncsDispatchFunc ( GSource* source, GSourceFunc callback, gpointer user_data ) ;
 
+ERROR: g-error domain code message ;
+
+: GError>g-error ( GError -- g-error )
+    [ domain>> g_quark_to_string utf8 alien>string ]
+    [ code>> ]
+    [ message>> utf8 alien>string ] tri
+    \ g-error boa ;
+
+: handle-GError ( GError/f -- )
+    [
+        [ GError>g-error ]
+        [ g_error_free ] bi
+        throw
+    ] when* ;

basis/images/gtk/gtk.factor

@@ -18,27 +18,12 @@ SINGLETON: gtk-image
 "bmp"  gtk-image register-image-class
 "ico"  gtk-image register-image-class
 
-ERROR: g-error domain code message ;
-
 <PRIVATE
 
 : data>GInputStream ( data -- GInputStream )
     [ malloc-byte-array &free ] [ length ] bi
     f g_memory_input_stream_new_from_data &g_object_unref ;
 
-: GError>g-error ( GError -- g-error )
-    [ domain>> g_quark_to_string utf8 alien>string ]
-    [ code>> ]
-    [ message>> utf8 alien>string ] tri
-    \ g-error boa ;
-
-: handle-GError ( GError/f -- )
-    [
-        [ GError>g-error ]
-        [ g_error_free ] bi
-        throw
-    ] when* ;
-
 : GInputStream>GdkPixbuf ( GInputStream -- GdkPixbuf )
     f { { pointer: GError initial: f } }
     [ gdk_pixbuf_new_from_stream ] with-out-parameters

basis/tools/deploy/unix/unix.factor

@@ -1,25 +1,34 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.pathnames io.directories io.files
-io.files.info.unix io.backend kernel namespaces make sequences
-system tools.deploy.backend tools.deploy.config
-tools.deploy.config.editor assocs hashtables prettyprint ;
+USING: io io.backend io.directories io.files io.files.info.unix
+io.pathnames kernel namespaces sequences system
+tools.deploy.backend tools.deploy.config
+tools.deploy.config.editor vocabs.loader vocabs.metadata ;
 IN: tools.deploy.unix
 
+: used-ico ( vocab -- ico )
+    dup vocab-windows-icon-path vocab-append-path
+    [ exists? ] keep "vocab:ui/backend/gtk/icon.ico" ? ;
+
+: copy-ico ( vocab bundle-name -- )
+    [ used-ico ]
+    [ "ui/backend/gtk/icon.ico" append-path ] bi*
+    copy-file ;
+
 : create-app-dir ( vocab bundle-name -- vm )
-    copy-vm
+    [ copy-vm ] [ copy-ico ] 2bi
     dup OCT: 755 set-file-permissions ;
 
 : bundle-name ( -- str )
     deploy-name get ;
 
 M: unix deploy* ( vocab -- )
-    "." resource-path [
+    "resource:" [
         dup deploy-config [
             [ bundle-name create-app-dir ] keep
             [ bundle-name image-name ] keep
             namespace make-deploy-image
             bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
-            bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
+            bundle-name normalize-path "Binary deployed to " "." surround print
         ] bind
     ] with-directory ;

basis/ui/backend/gtk/gtk.factor

@@ -1,14 +1,16 @@
 ! Copyright (C) 2010 Anton Gorenko, Philipp Brüschweiler.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.accessors alien.c-types alien.data
-alien.strings arrays assocs classes.struct command-line destructors
-gdk.ffi gdk.gl.ffi glib.ffi gobject.ffi gtk.ffi gtk.gl.ffi
-io.backend.unix.multiplexers io.encodings.utf8 io.thread kernel libc
-literals locals math math.bitwise math.order math.vectors namespaces
-sequences strings system threads ui ui.backend ui.clipboards
-ui.commands ui.event-loop ui.gadgets ui.gadgets.menus
-ui.gadgets.private ui.gadgets.worlds ui.gestures ui.pixel-formats
-ui.pixel-formats.private ui.private ;
+alien.strings alien.syntax arrays assocs classes.struct
+command-line destructors gdk.ffi gdk.gl.ffi glib.ffi
+gobject.ffi gtk.ffi gtk.gl.ffi io.backend
+io.backend.unix.multiplexers io.encodings.utf8 io.thread kernel
+libc literals locals math math.bitwise math.order math.vectors
+namespaces sequences strings system threads ui ui.backend
+ui.clipboards ui.commands ui.event-loop ui.gadgets
+ui.gadgets.menus ui.gadgets.private ui.gadgets.worlds
+ui.gestures ui.pixel-formats ui.pixel-formats.private
+ui.private ;
 RENAME: windows ui.private => ui:windows
 EXCLUDE: ui.gadgets.editors => change-caret ;
 RENAME: change-caret ui.gadgets.editors => editors:change-caret
@@ -264,10 +266,21 @@ SYMBOL: next-timeout
     f g_source_attach drop
     nano-count next-timeout set-global ;
 
+: load-icon ( -- )
+    ! This file is not in a resource.txt because it can be
+    ! overwritten when deploying. See 'Vocabulary icons'
+    ! in the docs.
+    "vocab:ui/backend/gtk/icon.ico"
+    normalize-path utf8 string>alien
+    { { pointer: GError initial: f } }
+    [ gtk_window_set_default_icon_from_file ] with-out-parameters
+    handle-GError drop ;
+
 M: gtk-ui-backend (with-ui)
     [
         f f gtk_init
         f f gtk_gl_init
+        load-icon
         init-clipboard
         start-ui
         stop-io-thread

core/vocabs/loader/loader-docs.factor

@@ -28,7 +28,7 @@ ARTICLE: "vocabs.roots" "Vocabulary roots"
 { $subsections "add-vocab-roots" } ;
 
 ARTICLE: "vocabs.icons" "Vocabulary icons"
-"An icon file representing the vocabulary can be provided for use by " { $link "tools.deploy" } ". A file named " { $snippet "icon.ico" } " will be used as the application icon when the application is deployed on Windows. A file named " { $snippet "icon.icns" } " will be used when the application is deployed on MacOS X." ;
+"An icon file representing the vocabulary can be provided for use by " { $link "tools.deploy" } ". A file named " { $snippet "icon.ico" } " will be used as the application icon when the application is deployed on Windows, Linux or the *BSD. A file named " { $snippet "icon.icns" } " will be used when the application is deployed on MacOS X." ;
 
 ARTICLE: "vocabs.loader" "Vocabulary loader"
 "The " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " words load vocabularies using the vocabulary loader. The vocabulary loader is implemented in the " { $vocab-link "vocabs.loader" } " vocabulary."