#!/usr/bin/newlisp
#
# GTK drag and drop example with GTK-server 2.3.1 and newLisp10
#
# The code below shows how to implement drag and drop. The trick is
# to use the "drag_dropped" signal, since the "drag-data-received"
# signal sends the userdata as a pointerstruct which cannot be
# retrieved.
#
# So the procedure is this:
# 1) Setup destinatiopn widget
# 2) Setup source widget
# 3) Connect destination widget to the "drag_dropped" signal
# 4) If drag_dropped signal occurs, jump to callback function
# 5) Retrieve context and time
# 6) Retrieve data from source widget in a normal way
# 7) Call the drag_finish GTK function
#
# June 26, 2005 - PvE.
# Januari 10, 2006 - PvE.
# August 3, 2006 - PvE.
# January 2, 2009 - PvE.
#------------------------------------------------------- GTK binding

# Import GTK-server and create global symbols for GTK function names
(if
    (= ostype "Win32") (import "gtk-server.dll" "gtk")
    (= ostype "OSX") (import "libgtk-server.dylib" "gtk")
    (= ostype "Linux") (import "libgtk-server.so" "gtk")
)

# Now try to find GTK-server configfile
(set 'cfgfile (open "gtk-server.cfg" "read"))
(when (not cfgfile)
    (set 'cfgfile (open "/usr/local/etc/gtk-server.cfg" "read"))
    (when (not cfgfile) (set 'cfgfile (open "/etc/gtk-server.cfg" "read"))))

# No configfile? Exit
(when (not cfgfile)(println "No GTK-server configfile found! Exiting...")(exit))

# Create global GTK symbols
(while (read-line cfgfile)
    (when (and (starts-with (current-line) "FUNCTION_NAME") (regex "gtk_+|gdk_+|g_+" (current-line)))
	(set 'func (chop ((parse (current-line) " ") 2)))
	(set 'lb (append {(lambda()(setq s "} func {")(dolist (x (args))(setq s (string s " " x)))(get-string (gtk s)))}))
	(constant (global (sym func)) (eval-string lb))))

(close cfgfile)

(constant (global 'NULL) "NULL")

#-------------------------------------------------------

# Define some constants ripped from the GTK header files
(constant 'GTK_DEST_DEFAULT_ALL 0x07)
(constant 'GDK_ACTION_COPY (<< 1 1))
(constant 'GDK_ACTION_MOVE (<< 1 2))
(constant 'GDK_BUTTON1_MASK (<< 1 8))
(constant 'GDK_BUTTON3_MASK (<< 1 10))

# Setup targetlist
(constant 'txt "text/plain")
(constant 'targets (pack "ld ld ld" (address txt) 0 0))

# Callback routine
(define (Drag_Drop_Callback)
    (println "Data dropped!")
    # Get the drag context and time as passed to the callback function
    (set 'drag_context (gtk_server_callback_value 1 "INT"))
    (set 'drag_time (gtk_server_callback_value 4 "INT"))
    # Retrieve data from source
    (set 'data (gtk_entry_get_text source_entry))
    (gtk_label_set_text dest_label (append {"} data {"}))
    # Finish the drag action
    (gtk_drag_finish drag_context 1 1 drag_time)
)

# Program starts here
(gtk_server_cfg "log")
(gtk_init NULL NULL)
# Window
(set 'win (gtk_window_new 0))
(gtk_window_set_title win {"Drag and Drop"})
(gtk_widget_set_size_request win 300 150)
(gtk_window_set_position win 1)
(gtk_window_set_resizable win 0)
# Set button
(set 'source_entry (gtk_entry_new))
(gtk_entry_set_text source_entry {"Drag this to the label below"})
(gtk_drag_source_set source_entry (| GDK_BUTTON1_MASK GDK_BUTTON3_MASK) (address targets) 1 (| GDK_ACTION_COPY GDK_ACTION_MOVE))
# Set label
(set 'dest_label (gtk_label_new {"Drop here"}))
(gtk_drag_dest_set dest_label GTK_DEST_DEFAULT_ALL (address targets) 1 (| GDK_ACTION_COPY GDK_ACTION_MOVE))
# Other stuff
(set 'sep1 (gtk_hseparator_new))
(set 'sep2 (gtk_hseparator_new))
(set 'button (gtk_button_new_with_label "Exit"))
(gtk_widget_set_size_request button 75 40)
# Now arrange widgets on window using boxes
(set 'hbox (gtk_hbox_new 0 0))
(gtk_box_pack_end hbox button 0 0 1)
(set 'vbox (gtk_vbox_new 0 0))
(gtk_box_pack_start vbox source_entry 0 0 1)
(gtk_box_pack_start vbox sep1 0 0 1)
(gtk_box_pack_start vbox dest_label 1 1 1)
(gtk_box_pack_start vbox sep2 0 0 1)
(gtk_box_pack_start vbox hbox 0 0 1)
(gtk_container_add win vbox)

# Connect signal to label
(gtk_server_connect dest_label "drag_drop dropped")

# Show all widgets
(gtk_widget_show_all win)

# Mainloop
(do-until (or (= event win)(= event button))
    (begin
	# Get event
	(set 'event (gtk_server_callback "wait"))
	(if (= event "dropped")(Drag_Drop_Callback))
    )
)

(exit)