/usr/share/doc/guile-gnome2-glib/examples/example-1.scm is in guile-gnome2-glib 2.16.2-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | #! /bin/sh
# -*- scheme -*-
exec guile-gnome-1 -s $0
!#
;; guile-gnome
;; Copyright (C) 2003,2004 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
(use-modules (oop goops)
(gnome gobject))
(debug-enable 'backtrace)
(define (p . args) (for-each display args))
(p "\n============\nGObject test\n============\n\n")
(p "Let's make a closure...")
(define closure
(make <gclosure>
#:return-type <gulong>
#:param-types (list <gulong> <gchar>)
#:func (lambda (x y) (* x 5))))
(p " and invoke it to get the answer "
(gclosure-invoke closure <gulong>
(scm->gvalue <gulong> 6) (scm->gvalue <gchar> #\a))
".\n\n")
(p "We can derive new object types, like ")
(define-class <test> (<gobject>)
(my-property #:gparam (list <gparam-long>))
#:gsignal (list 'touch-me #f))
(p <test> ".\n\n")
(define-method (test:touch-me (obj <test>))
(p "(In the default test::touch-me signal handler)\n"))
(define-method (gobject:set-property (obj <test>) (name <symbol>) init-value)
(p "(In the test::set-property handler. You can implement your own storage\n"
" mechanism, or call (next-method) for a default implementation, as we\n"
" are doing now (value " init-value ").)\n")
(next-method))
(p "We have instantiated the class " <test> ", but we have not\n"
"made any instances of this class. Let's do that.\n")
(define test-instance (make <test>))
(p "\nWe can now emit the touch-me signal on our new object, " test-instance
":\n")
(gtype-instance-signal-emit test-instance 'touch-me)
(p "\nAnd set test::my-property on the new object as well.\n")
(gobject-set-property test-instance 'my-property 2112)
(p "\nOf course, our objects are all first-class GOOPS objects, so they\n"
"can have some nice things as object methods and such:\n")
(define-method (my-method (obj <object>))
(p "my-method for object of type <gobject>.\n"))
(define-method (my-method (obj <test>))
(p "my-method for object of type <test>, chaining up...\n")
(next-method))
(my-method test-instance)
(p "\nShould you ever need to use GValues directly, you can just instantiate\n"
"them as objects, e.g. " (make <gboolean> #:value #f) ", \n"
(make <gchararray> #:value "Hello World!") ", etc.\n")
|