X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/83bab9b6adb24ca6df662788482978f5a3f6c393..031b10c59e6010b802d5fba1b679636d4614becc:/examples/testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index 0a670b7..b3826ed 100644
--- a/examples/testgtk.lisp
+++ b/examples/testgtk.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: testgtk.lisp,v 1.20 2005/02/27 12:44:07 espen Exp $
+;; $Id: testgtk.lisp,v 1.24 2005/03/06 17:12:22 espen Exp $
 
 
 ;(use-package "GTK")
@@ -452,6 +452,12 @@ (define-simple-dialog create-expander (dialog "Expander" :resizable nil)
 ;; File chooser dialog
 
 (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
+  (file-chooser-add-filter dialog 
+   (make-instance 'file-filter :name "All files" :pattern "*"))
+  (file-chooser-add-filter dialog 
+   (make-instance 'file-filter :name "Common Lisp source code" 
+    :patterns '("*.lisp" "*.lsp")))
+
   (dialog-add-button dialog "gtk-cancel" #'widget-destroy :object t)
   (dialog-add-button dialog "gtk-ok" 
    #'(lambda ()
@@ -461,6 +467,15 @@ (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
        (widget-destroy dialog))))
 
 
+;; Font selection dialog
+
+(define-toplevel create-font-selection (window "Font Button" :resizable nil)
+  (make-instance 'h-box 
+   :parent window :spacing 8 :border-width 8
+   :child (make-instance 'label :label "Pick a font")
+   :child (make-instance 'font-button 
+           :use-font t :title "Font Selection Dialog")))
+
 
 ;;; Handle box
 
@@ -486,7 +501,7 @@ (define-toplevel create-handle-box (window "Handle Box Test" :border-width 20)
 
 ;;; Image
 
-(define-toplevel create-image (window "Image")
+(define-toplevel create-image (window "Image" :resizable nil)
   (make-instance 'image :file #p"clg:examples;gtk.png" :parent window))
 
 
@@ -1208,17 +1223,20 @@ (define-simple-dialog create-spins (dialog "Spin buttons" :has-separator nil)
 		      :label label :xalign 0.0 :yalign 0.5)
 	      :child (make-instance 'spin-button
 		      :adjustment adjustment :wrap t))))
-      (make-instance 'frame 
-       :label "Not accelerated" :parent main
-       :child (make-instance 'h-box 
-	       :border-width 10
-	       :child-args '(:padding 5)
-	       :child (create-date-spinner "Day : " 
-		       (adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0) :out)
-	       :child (create-date-spinner "Month : " 
-		       (adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0) :etched-in)
-	       :child (create-date-spinner "Year : " 
-		       (adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0) :in))))
+      (multiple-value-bind (sec min hour date month year day daylight-p zone)
+	  (get-decoded-time)
+	(declare (ignore sec min hour day daylight-p zone))
+	(make-instance 'frame 
+	 :label "Not accelerated" :parent main
+	 :child (make-instance 'h-box 
+	         :border-width 10
+		 :child-args '(:padding 5)
+		 :child (create-date-spinner "Day : " 
+			 (adjustment-new date 1 31 1 5 0) :out)
+		 :child (create-date-spinner "Month : " 
+		         (adjustment-new month 1 12 1 5 0) :etched-in)
+		 :child (create-date-spinner "Year : " 
+		         (adjustment-new year 0 2100 1 100 0) :in)))))
 
     (let ((spinner1 (make-instance 'spin-button
 		     :adjustment (adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
@@ -1702,7 +1720,7 @@ (defun create-main-window ()
 ;; 	    ("event watcher")
  	    ("enxpander" create-expander)
  	    ("file chooser" create-file-chooser)
-;; 	    ("font selection")
+ 	    ("font selection" create-font-selection)
  	    ("handle box" create-handle-box)
  	    ("image" create-image)
  	    ("labels" create-labels)
@@ -1760,6 +1778,13 @@ (defun create-main-window ()
      :child-args '(:expand nil)
      :child (list (make-instance 'label :label (gtk-version)) :fill nil)
      :child (list (make-instance 'label :label "clg CVS version") :fill nil)
+     :child (list (make-instance 'label 			  
+		   :label #-cmu(format nil "~A (~A)" 
+			        (lisp-implementation-type)
+				(lisp-implementation-version))
+		          ;; The version string in CMUCL is far too long
+		          #+cmu(lisp-implementation-type))
+		  :fill nil)
      :child (list scrolled-window :expand t)
      :child (make-instance 'h-separator)
      :child (make-instance 'v-box