1
#| nokogiri-no-gnome.jl -- workaround lack of GNOME widgets -*- lisp -*-
3
$Id: stock.jl.gtk,v 1.9 2003/01/12 20:30:43 jsh Exp $
5
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of sawfish.
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)
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.
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.
24
(define-structure sawfish.gtk.stock
35
;; same as in gnome now
36
(define (stock-button type)
37
(gtk-button-new-from-stock
40
((cancel) "gtk-cancel")
41
((revert) "gtk-revert-to-saved")
46
((help) "gtk-help"))))
48
(define (simple-dialog title widget #!optional ok-callback main-window)
50
(let ((window (gtk-window-new 'toplevel))
51
(vbox (gtk-vbox-new nil box-spacing))
52
(hbbox (gtk-hbutton-box-new))
53
(ok (stock-button 'ok))
54
(cancel (and ok-callback (stock-button 'cancel))))
57
(gtk-widget-destroy window))
61
(gtk-widget-destroy window))
63
(gtk-window-set-title window title)
64
(gtk-window-set-wmclass window "ok_cancel_dialog" "Nokogiri")
65
(gtk-container-set-border-width window box-border)
67
(gtk-window-set-transient-for window main-window))
69
(gtk-box-set-spacing hbbox button-box-spacing)
70
(gtk-button-box-set-layout hbbox 'end)
72
(gtk-box-pack-end hbbox cancel))
73
(gtk-box-pack-end hbbox ok)
74
(gtk-box-pack-end vbox hbbox)
75
(gtk-container-add window vbox)
76
(gtk-widget-show-all vbox)
78
(gtk-container-add vbox widget)
81
(g-signal-connect cancel "clicked" on-cancel))
82
(g-signal-connect ok "clicked" (if ok-callback on-ok on-cancel))
83
(g-signal-connect window "delete_event" on-cancel)
85
(gtk-widget-show window)
86
(gtk-window-set-modal window t)
87
(gtk-widget-grab-focus widget)
91
(define (about-dialog title version copyright
92
authors comments #!key logo extra)
93
(declare (unused logo))
94
(let* ((box (gtk-vbox-new nil 4))
95
(text-view (gtk-text-view-new))
96
(text-buffer (gtk-text-view-get-buffer text-view)))
98
(gtk-text-buffer-insert-at-cursor text-buffer s (length s)))
99
(insert (format nil "%s %s\n" title version))
100
(insert (format nil "%s\n\n" copyright))
102
(insert "Authors:\n")
103
(mapc (lambda (x) (insert (format nil " %s\n" x))) authors))
104
(insert (format nil "\n%s\n" comments))
105
(gtk-text-view-set-editable text-view nil)
106
(gtk-container-add box text-view)
108
(gtk-box-pack-end box extra))
109
(gtk-widget-show-all box)
110
(simple-dialog "About" box)))
112
(define (make-url-widget url label)
113
(gtk-label-new (format nil "%s <%s>" label url))))