This file is indexed.

/usr/share/guile-gnome-2/gnome/gtk.scm is in guile-gnome2-gtk 2.16.4-1.

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
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
;; guile-gnome
;; Copyright (C) 2003,2004,2009 Andy Wingo <wingo at pobox dot com>

;; 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

;;; Commentary:
;;
;;A GTK+ 2.x wrapper for Guile.
;;
;;; Code:

(define-module (gnome gtk)
  #:use-module (oop goops)
  #:use-module (gnome gobject)
  #:use-module (gnome gobject generics)
  #:use-module (gnome gobject utils)
  #:use-module (gnome gw support modules)
  #:export (<guile-gtk-tree-model>
            on-get-flags on-get-n-columns on-get-column-type
            on-get-iter on-get-path on-get-value on-iter-next
            on-iter-children on-iter-has-child on-iter-n-children
            on-iter-nth-child on-iter-parent

            gtk-tree-or-list-store-set
            gtk-text-buffer-create-tag create-tag
            gtk-stock-id))

(define-macro (time-debug . forms)
  `(begin ,@forms))

(eval-when (expand load eval)
  (time-debug (use-modules (gnome gw gdk)))
  (time-debug (use-modules (gnome gw gtk)))
  (re-export-modules (gnome gw gdk)
		     (gnome gw gtk)))

;; Support explicit object destruction.
(define-method (initialize (instance <gtk-object>) initargs)
  (next-method)
  (connect instance 'destroy
           (lambda args
             (gtype-instance-destroy! instance))))

(define <guile-gtk-tree-model> <guile-gtk-generic-tree-model>)

;; FIXME: doc me!
(define-generic-with-docs on-get-flags
  "")
(define-generic-with-docs on-get-n-columns
  "")
(define-generic-with-docs on-get-column-type
  "")
(define-generic-with-docs on-get-iter
  "")
(define-generic-with-docs on-get-path
  "")
(define-generic-with-docs on-get-value
  "")
(define-generic-with-docs on-iter-next
  "")
(define-generic-with-docs on-iter-children
  "")
(define-generic-with-docs on-iter-has-child
  "")
(define-generic-with-docs on-iter-n-children
  "")
(define-generic-with-docs on-iter-nth-child
  "")
(define-generic-with-docs on-iter-parent
  "")

;; Support tree models written in guile.
(define-method (on-get-flags (obj <guile-gtk-tree-model>))
  (make <gtk-tree-model-flags> #:value 0))

;; Miscellany.
(define (gtk-tree-or-list-store-set store iter . args)
  (or (even? (length args)) (scm-error 'gruntime-error #f "Invalid arguments" '() #f))
  (let loop ((args args))
    (if (eq? args '())
        *unspecified*
        (begin
          (set-value store iter (car args) (cadr args))
          (loop (cddr args))))))

(define-method (set (store <gtk-list-store>) (iter <gtk-tree-iter>) . args)
  (apply gtk-tree-or-list-store-set store iter args))

(define-method (set (store <gtk-tree-store>) (iter <gtk-tree-iter>) . args)
  (apply gtk-tree-or-list-store-set store iter args))

(define (gtk-text-buffer-create-tag buffer tag-name . properties)
  (let ((tag (make <gtk-text-tag> #:name tag-name)))
    (if (not (even? (length properties)))
	(scm-error 'gruntime-error #f "Invalid property list: ~A" properties #f))
    (add (get-tag-table buffer) tag)
    (let loop ((props properties))
      (if (null? props)
          tag
          (begin
            (set tag (car props) (cadr props))
            (loop (cddr props)))))))
(define-method (create-tag (buffer <gtk-text-buffer>) tag-name . properties)
  (apply gtk-text-buffer-create-tag buffer tag-name properties))

(eval-when (expand load eval)
  (export create-tag))

(define (gtk-stock-id nick)
  (string-append "gtk-" (symbol->string nick)))