File: gtkaux.scm

package info (click to toggle)
gauche-gtk 0.4.1-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,520 kB
  • ctags: 3,230
  • sloc: ansic: 6,655; lisp: 4,159; sh: 2,707; makefile: 344
file content (58 lines) | stat: -rw-r--r-- 2,062 bytes parent folder | download | duplicates (4)
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
;;;
;;; gtk/gtkaux.scm - Auxiliary defs
;;;
;;;  Copyright(C) 2002 by Shiro Kawai (shiro@acm.org)
;;;
;;;  Permission to use, copy, modify, distribute this software and
;;;  accompanying documentation for any purpose is hereby granted,
;;;  provided that existing copyright notices are retained in all
;;;  copies and that this notice is included verbatim in all
;;;  distributions.
;;;  This software is provided as is, without express or implied
;;;  warranty.  In no circumstances the author(s) shall be liable
;;;  for any damages arising out of the use of this software.
;;;
;;;  $Id: gtkaux.scm,v 1.3 2002/10/21 20:12:13 shirok Exp $
;;;

(select-module gtk)

;; GtkListStore --------------------------------------

(define (gtk-list-store-set list-store iter . args)
  (check-arg (cut is-a? <> <gtk-list-store>) list-store)
  (check-arg (cut is-a? <> <gtk-tree-iter>) iter)
  (unless (even? (length args))
    (error "even number of arguments required, but got" args))
  (let loop ((args args))
    (unless (null? args)
      (gtk-list-store-set-value list-store iter (car args) (cadr args))
      (loop (cddr args)))))

;; GtkTreeViewColumn ---------------------------------

(define (gtk-tree-view-column-new-with-attributes title renderer . args)
  (check-arg string? title)
  (check-arg (cut is-a? <> <gtk-cell-renderer>) renderer)
  (unless (even? (length args))
    (error "cell renderer option arguments must be even number"))
  (let1 column (gtk-tree-view-column-new)
    (gtk-tree-view-column-set-title column title)
    (gtk-tree-view-column-pack-start column renderer #t)
    (let loop ((args args))
      (unless (null? args)
        (gtk-tree-view-column-add-attribute column renderer (car args) (cadr args))
        (loop (cddr args))))
    column)
  )

;; GtkTreeSelection -----------------------------------

(define (gtk-tree-selection-get-selected-multi selection)
  (let ((sels '()))
    (gtk-tree-selection-selected-foreach
     selection
     (lambda (model path iter) (push! sels iter)))
    (reverse sels)))

(provide "gtk/gtkaux")