suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk on-drop-file

Browse Source 
original commit: 24b016c8d5918116a1c2eeebb3e14baa4371083b
This commit is contained in:
Matthew Flatt 2010-09-19 18:05:11 -06:00
parent dd79f9bae7
commit b3267c7dba
2 changed files with 44 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mred/private/wx/gtk/clipboard.rkt
View File

@ -11,7 +11,10 @@
(unsafe!) (unsafe!)
(provide clipboard-driver% (provide clipboard-driver%
has-x-selection?) has-x-selection?
_GtkSelectionData
gtk_selection_data_get_length
gtk_selection_data_get_data)
(define (has-x-selection?) #t) (define (has-x-selection?) #t)

42
collects/mred/private/wx/gtk/window.rkt
View File

@ -9,13 +9,15 @@
"../common/queue.rkt" "../common/queue.rkt"
"../common/local.rkt" "../common/local.rkt"
"../common/delay.rkt" "../common/delay.rkt"
"../common/bstr.rkt"
"keycode.rkt" "keycode.rkt"
"keymap.rkt" "keymap.rkt"
"queue.rkt" "queue.rkt"
"utils.rkt" "utils.rkt"
"const.rkt" "const.rkt"
"types.rkt" "types.rkt"
"widget.rkt") "widget.rkt"
"clipboard.rkt")
(provide window% (provide window%
gtk->wx gtk->wx
@ -96,6 +98,30 @@
(define (widget-window gtk) (define (widget-window gtk)
(GtkWidgetT-window (cast gtk _GtkWidget _GtkWidgetT-pointer))) (GtkWidgetT-window (cast gtk _GtkWidget _GtkWidgetT-pointer)))
(define-gtk gtk_drag_dest_add_uri_targets (_fun _GtkWidget -> _void))
(define-gtk gtk_drag_dest_set (_fun _GtkWidget _int (_pointer = #f) (_int = 0) _int -> _void))
(define-gtk gtk_drag_dest_unset (_fun _GtkWidget -> _void))
(define GTK_DEST_DEFAULT_ALL #x07)
(define GDK_ACTION_COPY (arithmetic-shift 1 1))
(define-signal-handler connect-drag-data-received "drag-data-received"
(_fun _GtkWidget _pointer _int _int _GtkSelectionData _uint _uint -> _void)
(lambda (gtk context x y data info time)
(let ([wx (gtk->wx gtk)])
(when wx
(let ([bstr (scheme_make_sized_byte_string
(gtk_selection_data_get_data data)
(gtk_selection_data_get_length data)
1)])
(cond
[(regexp-match #rx#"^file://(.*)\r\n$" bstr)
=> (lambda (m)
(queue-window-event wx
(lambda ()
(let ([path (bytes->path (cadr m))])
(send wx on-drop-file path)))))]))))))
;; ---------------------------------------- ;; ----------------------------------------
(define-signal-handler connect-focus-in "focus-in-event" (define-signal-handler connect-focus-in "focus-in-event"
@ -497,7 +523,16 @@
(gtk_widget_set_sensitive gtk on?)) (gtk_widget_set_sensitive gtk on?))
(define/public (is-window-enabled?) enabled?) (define/public (is-window-enabled?) enabled?)
(define/public (drag-accept-files on?) (void)) (define drag-connected? #f)
(define/public (drag-accept-files on?)
(if on?
(begin
(unless drag-connected?
(connect-drag-data-received gtk)
(set! drag-connected? #t))
(gtk_drag_dest_set gtk GTK_DEST_DEFAULT_ALL GDK_ACTION_COPY)
(gtk_drag_dest_add_uri_targets gtk))
(gtk_drag_dest_unset gtk)))
(define/public (set-focus) (define/public (set-focus)
(gtk_widget_grab_focus (get-client-gtk))) (gtk_widget_grab_focus (get-client-gtk)))
@ -571,7 +606,8 @@
(define/public (paint-children) (define/public (paint-children)
(void)) (void))
(def/public-unimplemented on-drop-file) (define/public (on-drop-file path) (void))
(def/public-unimplemented get-handle) (def/public-unimplemented get-handle)
(def/public-unimplemented set-phantom-size) (def/public-unimplemented set-phantom-size)