X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/d73e091e31482cc624570042aeca9502839b0d83..c0bc39e53c16a7e408b7bb0ecb13dc605f0b8ea4:/examples/testdnd.lisp

diff --git a/examples/testdnd.lisp b/examples/testdnd.lisp
index 2e6c656..ff6702c 100644
--- a/examples/testdnd.lisp
+++ b/examples/testdnd.lisp
@@ -1,7 +1,7 @@
 ;;;; Translation of dragndrop.py from the PyGTK 2.0 Tutorial
 
 #+sbcl(require :gtk)
-#+cmu(asdf:oos 'asdf:load-op :gtk)
+#+(or cmu clisp)(asdf:oos 'asdf:load-op :gtk)
 
 (defpackage "TESTDND"
   (:use "COMMON-LISP" "GTK")
@@ -61,7 +61,7 @@ (defvar gtk-xpm
 (defvar *target-type-text* 80)
 (defvar *target-type-image* 81)
 
-(setq from-image 
+(defvar from-image 
   (list
    (make-instance 'target-entry :target "text/plain" :id *target-type-text*)
    (make-instance 'target-entry :target "image/png" :id *target-type-image*)))
@@ -70,8 +70,6 @@ (defvar to-button
 (defvar to-canvas 
   (make-instance 'target-entry :target "image/png" :id *target-type-image*))
 
-
-
 (defun add-image (layout pixbuf xd yd)
   (let ((button (make-instance 'button
 		 :child (make-instance 'image :pixbuf pixbuf))))
@@ -84,12 +82,14 @@ (defun add-image (layout pixbuf xd yd)
 	  ((= target-type *target-type-text*)
 	   (selection-data-set-text selection 
 	    #+cmu(ext:format-universal-time nil (get-universal-time) :style :rfc1123 :print-timezone nil)
-	    #+sbcl(sb-int:format-universal-time nil (get-universal-time) :style :abbreviated :print-timezone nil)))
+	    #+sbcl(sb-int:format-universal-time nil (get-universal-time) :style :abbreviated :print-timezone nil)
+	    #+clisp(os:string-time "%x %X")
+	    #-(or cmu sbcl clisp)(format nil "~D" (get-universal-time))))
 	  ((= target-type *target-type-image*)
 	   (selection-data-set-pixbuf selection pixbuf)))))
      
     (drag-source-set button :button1 from-image :copy)
-      
+ 
     (with-slots (hadjustment vadjustment) layout
       (layout-put layout button
        (truncate (+ xd (adjustment-value hadjustment)))
@@ -123,7 +123,6 @@ (defun create-layout (width height)
     (signal-connect button 'drag-data-received
      #'(lambda (context x y selection target-type time)
 	 (declare (ignore context x y time))
-	 (print 'her)
 	 (when (= target-type *target-type-text*)
 	   (setf 
 	    (button-label button) 
@@ -145,4 +144,4 @@ (defun create-test ()
    :child (create-layout 600 600)))
 
 (clg-init)
-(create-test)
+(within-main-loop (create-test))