gtk/gtk.lisp: Apparently when you ask for a stock Button, you get a Bin.

[clg] / examples / testdnd.lisp

diff --git a/examples/testdnd.lisp b/examples/testdnd.lisp
index 2e6c656f141bdab9215bba98e367798763323fb8..ff6702c0f2faa406befc1e05b61c02df80f932da 100644 (file)
--- 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)
 ;;;; 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")
 
 (defpackage "TESTDND"
   (:use "COMMON-LISP" "GTK")


@@ -61,7 +61,7 @@ (defvar gtk-xpm
 (defvar *target-type-text* 80)
 (defvar *target-type-image* 81)
 
 (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*)))
   (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*))
 
 (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))))
 (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)
          ((= 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)
          ((= 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)))
     (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))
     (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) 
         (when (= target-type *target-type-text*)
           (setf 
            (button-label button) 


@@ -145,4 +144,4 @@ (defun create-test ()
    :child (create-layout 600 600)))
 
 (clg-init)
    :child (create-layout 600 600)))
 
 (clg-init)

-(create-test)
+(within-main-loop (create-test))