← Back to branch summary

~ubuntu-branches/ubuntu/natty/sawfish/natty

« back to all changes in this revision

Viewing changes to lisp/sawfish/ui/widgets/icon.jl

  • Committer: Bazaar Package Importer
  • Author(s): Luis Rodrigo Gallardo Cruz
  • Date: 2009-11-23 09:05:20 UTC
  • mfrom: (0.1.1 upstream)
  • mto: This revision was merged to the branch mainline in revision 17.
  • Revision ID: james.westby@ubuntu.com-20091123090520-m588qe37wtxzr2b5
Tags: upstream-1.5.3
Import upstream version 1.5.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/ui/widgets/icon.jl
1
1
#| nokogiri-widgets/icon.jl -- GNOME icon entry widget
2
2
 
3
 
   $Id: icon.jl,v 1.6 2003/01/12 20:30:49 jsh Exp $
 
3
   $Id: icon.jl,v 1.1 2000/09/01 20:03:29 john Exp $
4
4
 
5
5
   Originally written by Bruce Miller <docmad@md.prestige.net>
6
6
 
21
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
22
|#
23
23
 
24
 
;; GNOME version of this widget
 
24
;; GNOME-less version of this widget
25
25
 
26
26
(define-structure sawfish.ui.widgets.icon ()
27
27
 
28
28
    (open rep
29
 
          gui.gtk-2.gtk
30
 
          gui.gtk-2.gnome-ui
31
 
          rep.io.files
32
29
          sawfish.gtk.widget)
33
30
 
34
 
  (define (make-icon-item changed-callback)
35
 
    (let* ((widget (gnome-icon-entry-new "IconEntry" (_ "Select Icon"))))
36
 
      (when changed-callback
37
 
        (g-signal-connect (gnome-icon-entry-gtk-entry widget) "changed"
38
 
                            (make-signal-callback changed-callback)))
39
 
      (gtk-widget-show widget)
40
 
      (lambda (op)
41
 
        (case op
42
 
          ((set) (lambda (x)
43
 
                   (if x
44
 
                       (gnome-icon-entry-set-icon widget x)
45
 
                     (gtk-entry-set-text
46
 
                      (gnome-icon-entry-gtk-entry widget) ""))))
47
 
          ((clear) (lambda ()
48
 
                     (gtk-entry-set-text
49
 
                      (gnome-icon-entry-gtk-entry widget) "")))
50
 
          ((ref) (lambda ()
51
 
                   (let ((file (gtk-entry-get-text
52
 
                                (gnome-icon-entry-gtk-entry widget))))
53
 
                     (and (file-regular-p file) file))))
54
 
          ((gtk-widget) widget)
55
 
          ((validp) (lambda (x) (and (stringp x)
56
 
                                     (file-exists-p x))))))))
57
 
 
58
 
  (define-widget-type 'icon make-icon-item))
 
31
  (define-widget-type 'icon (lambda (changed) (make-widget 'file changed))))