← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to lisp/sawfish/gtk/widget-dialog.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2002-01-20 17:42:28 UTC
  • Revision ID: james.westby@ubuntu.com-20020120174228-4q1ydztbkvfq1ht2
Tags: upstream-1.0.1.20020116
Import upstream version 1.0.1.20020116

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/gtk/widget-dialog.jl
 
1
#| nokogiri-widget-dialog.jl -- simple dialogs from widgets
 
2
 
 
3
   $Id: widget-dialog.jl,v 1.6 2000/09/01 20:00:04 john Exp $
 
4
 
 
5
   Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
 
6
 
 
7
   This file is part of sawfish.
 
8
 
 
9
   sawfish is free software; you can redistribute it and/or modify it
 
10
   under the terms of the GNU General Public License as published by
 
11
   the Free Software Foundation; either version 2, or (at your option)
 
12
   any later version.
 
13
 
 
14
   sawfish is distributed in the hope that it will be useful, but
 
15
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
   GNU General Public License for more details.
 
18
 
 
19
   You should have received a copy of the GNU General Public License
 
20
   along with sawfish; see the file COPYING.  If not, write to
 
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
|#
 
23
 
 
24
(define-structure sawfish.gtk.widget-dialog
 
25
 
 
26
    (export widget-dialog)
 
27
 
 
28
    (open rep
 
29
          gui.gtk
 
30
          sawfish.gtk.stock
 
31
          sawfish.gtk.widget)
 
32
 
 
33
  (define (widget-dialog title spec callback
 
34
                         #!optional initial-value main-window)
 
35
 
 
36
    (let* ((widget (make-widget spec))
 
37
           (vbox (gtk-vbox-new nil box-spacing))
 
38
           (hbox (gtk-hbox-new nil 0)))
 
39
 
 
40
      (when initial-value
 
41
        (widget-set widget initial-value))
 
42
 
 
43
      (gtk-box-pack-start hbox (gtk-label-new title))
 
44
      (gtk-container-add vbox hbox)
 
45
      (gtk-container-add vbox (widget-gtk-widget widget))
 
46
      (gtk-widget-show-all vbox)
 
47
      (simple-dialog title vbox
 
48
                     (lambda () (callback (widget-ref widget)))
 
49
                     main-window))))