;; Parts of this file are direct translations of code from 'testgtk.c'
;; distributed with the Gtk+ library, and thus covered by the GNU
;; Lesser General Public License and copyright Peter Mattis, Spencer
-;; Kimball, Josh MacDonald and others.
+;; Kimball, Josh MacDonald and others. To be safe the entire file
+;; should probably be considered as being GPL'ed.
-;; $Id: testgtk.lisp,v 1.39 2007-06-19 12:49:18 espen Exp $
+;; $Id: testgtk.lisp,v 1.44 2008-12-09 19:37:19 espen Exp $
#+sbcl(require :gtk)
#+(or cmu clisp)(asdf:oos 'asdf:load-op :gtk)
:message-type :error :visible t
:text "<b>Failed to load an image</b>"
:secondary-text (glib:gerror-message condition)
- :signal (list :close #'widget-destroy :object t))
+ :signal (list :ok #'widget-destroy :object t))
(return-from load-pixbufs nil))))
t)
(define-simple-dialog create-notebook (dialog "Notebook")
(let ((main (make-instance 'v-box :parent dialog)))
- (let ((book-open (gdk:pixbuf-new-from-xpm-data book-open-xpm))
- (book-closed (gdk:pixbuf-new-from-xpm-data book-closed-xpm))
+ (let ((book-open (make-instance 'gdk:pixbuf :source book-open-xpm))
+ (book-closed (make-instance 'gdk:pixbuf :source book-closed-xpm))
(notebook (make-instance 'notebook
:border-width 10 :tab-pos :top :parent main)))
:tip-private "Toolbar/Horizontal"
:signal (list 'clicked
#'(lambda (toolbar)
- (setf (toolbar-orientation toolbar) :horizontal))
+ (setf (orientable-orientation toolbar) :horizontal))
:object :parent))
:child (make-instance 'tool-button
:tip-private "Toolbar/Vertical"
:signal (list 'clicked
#'(lambda (toolbar)
- (setf (toolbar-orientation toolbar) :vertical))
+ (setf (orientable-orientation toolbar) :vertical))
:object :parent))
:child (make-instance 'separator-tool-item)
:child (create-label "Below")))
-;;; Tooltips test
+;;; Tooltips test. Note that GtkTooltips has been deprecated in GTK+ 2.12
(define-simple-dialog create-tooltips (dialog "Tooltips" :default-width 200)
(let ((tooltips (make-instance 'tooltips)))
;;; Main window
-(defun create-main-window ()
+(defun create-main-window (&optional display)
(let* ((button-specs
'(("button box" create-button-box)
("buttons" create-buttons)
("cursors" create-cursors)
("dialog" create-dialog)
("entry" create-entry)
- ("enxpander" create-expander)
+ ("expander" create-expander)
("file chooser" create-file-chooser)
("font selection" create-font-selection)
("handle box" create-handle-box)
("UI manager" create-ui-manager)))
(main-window (make-instance 'window
+ :display display
:title "testgtk.lisp" :name "main_window"
:default-width 200 :default-height 400
:allow-grow t :allow-shrink nil))
:border-width 10))
(close-button (make-instance 'button
:stock "gtk-close" :can-default t
- :signal (list 'clicked #'widget-destroy :object main-window))))
+ :signal (list 'clicked #'widget-destroy :object main-window))))
(let ((icon (gdk:pixbuf-load #p"clg:examples;gtk.png")))
(setf