Re: [Help-smalltalk] BLOX vs GTK

[Mike Anderson]

Paolo Bonzini wrote:
> Mike Anderson wrote:
> 
>> Paolo Bonzini wrote:
>>  
>>
>>> The browser is another story.  The model-dispatcher system is incredibly
>>> complicated and I never really unravelled it.  Even the Namespace
>>> browser was mostly done by cut'n'paste'n'hope-it-works, I'm not very
>>> pleased to say...
>>>     
>>
>>
>> I think the model-dispatcher system is quite elegant,
> 
> You mean you understood how PList and friend are updated? :-P

Well I thought I did... more-or-less... but you're making me doubt
myself :-s

>>  but I couldn't
>> apply it easily to widgets like the GtkTextBuffer/View, where a lot of
>> the state is held outside of the image (unless you want to do a lot of
>> duplication).
> 
> Yes, and the same is true also for relatively simpler widgets like a
> single-column TreeView.

Yes :-)

What I forgot to say earlier is that, while I think the bindings are
very usable for small Gtk apps, if I was going to write a large Gtk
application, I would have another go at improving the header parser.
Currently there are quite a lot of things missing which are actually
quite crucial, even though they don't appear so at first. I'm thinking
of things like support for drag and drop.

What it needs most of all is a test suite so that it is possible to see
what has been parsed and what hasn't (because it uses some arcane C). It
occurred to me that searching for the comments used to auto-generate the
Gtk docs might be a good way to get that.

BTW The attached files are a working example of drag and drop if anyone
has a use for that.

Mike

CStruct subclass: #GtkTargetEntry
        declaration: #(               
                        #(#target #string)     
            #(#flags #uInt)
            #(#info #uInt)
        )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

CStruct subclass: #GtkTargetPair
        declaration: #(               
                        #(#target #int)     
            #(#flags #uInt)
            #(#info #uInt)
        )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

CStruct subclass: #GtkTargetList
        declaration: #(               
                        #(#list #(#ptr #int))     
            #(#refCount #uInt)
        )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

CStruct subclass: #GtkSelectionData
        declaration: #(
                        #(#selection #uLong)
                        #(#target #uLong)
                        #(#type #uLong)
                        #(#format #int)
                        #(#data #(#ptr #uChar))
                        #(#length #int)
                        #(#display (#ptr #uLong))
                )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

GList methodsFor: 'C call-outs'!

length
    <cCall: 'g_list_length' returning: #uInt args: #( #self )>
!

nthData: n
    <cCall: 'g_list_nth_data' returning: #cObject args: #( #self #uInt )>
!
!

"CStruct subclass: #GTypeInstance
        declaration: #(
                #(#gType #int)
                )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

GTypeInstance subclass: #GObject
        declaration: #(
                #(#refCount #uInt)
                #(#qdata #(#ptr #int))
                )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!

Transcript << 'Recompiled GObject'; nl.
!

GObject subclass: #GdkDragContext
        declaration: #(
          #(#protocol #int)
          #(#isSource #int)
          #(#sourceWindow #(#ptr #int))
          #(#destWindow #(#ptr #int))
          #(#targets #(#ptr #int)) -- GList
          #(#actions #int)
          #(#suggestedAction #int)
          #(#action #int)
          #(#startTime #int)  
                )
        classVariableNames: ''
        poolDictionaries: ''
        category: ''
!"

| reqs |
reqs := #( 'MUtility' 'GTK' ).
(Smalltalk hasFeatures: reqs) ifFalse:
    [ PackageLoader fileInPackages: reqs.
    ObjectMemory snapshot: 'ncdroptarget.im'.
    Transcript << 'Snapshotted with packages loaded to ncdroptarget.im' ].
!

Namespace current: GTK
!

#('GtkChanges.st' 'GtkConvenience.st') do:
        [ :each | FileStream fileIn: each ].
!

Namespace current: Smalltalk
!

Object subclass: #NcDropTarget instVarNames: 'wnd img'
!

NcDropTarget methodsFor: 'everything'!

dropEvent: widget context: context x: x y: y time: t
        | a a1 a2 |
        Transcript << 'dropEvent'; nl.
        widget = img ifFalse: [ Transcript << 'Wrong widget!'; nl. ].
        a := GTK.Gdk atomIntern: 'text/uri-list'  onlyIfExists: false.
        (GTK.Gdk atomName: a) printNl.
        "a := context suggestedAction value."
        GTK.Gtk dragGetData: widget context: context target: a time: t.
        ^true
!

dragDataReceived: widget context: context x: x y: y data: data info: info "int" 
time: t 
        | n d |
        Transcript << 'dragDataReceived'; nl.
        
        "Process drop"
        data changeClassTo: GTK.GtkSelectionData.
        n := data length value.
        Transcript << 'Length: ' << n ; nl.
        n > 0 ifTrue: 
                [ d := data data value.
                0 to: n - 1 do:
                        [ :i | Transcript << (d at: i) << ' ' .].
                Transcript nl. ].
        
        GTK.Gtk dragFinish: context success: true del: false time: t
!

dragMotion: widget context: context x: x y: y time: t userData: aString
        GTK.Gdk dragStatus:  context action: GTK.Gdk gdkActionCopy time: t.
        ^true
!
        
buildWindow
        | tgt n |
        wnd := GTK.GtkWindow new: GTK.Gtk gtkWindowToplevel.
        img := GTK.GtkImage newFromFile: 'target.png'.
        wnd add: img.

        GTK.Gtk 
                dragDestSet: img
                flags: 0 "(GTK.Gtk gtkDestDefaultHighlight)"
                targets: nil
                nTargets: 0
                actions: 1 "default".
        GTK.Gtk dragDestAddTextTargets: img.
        GTK.Gtk dragDestAddUriTargets: img.
        
        tgt := GTK.Gtk dragDestGetTargetList: img.
        tgt := tgt list value changeClassTo: GTK.GList.
        n := tgt length.
        Transcript << 'Target list: ' << n; nl.
        0 to: n - 1 do:
                [ :i | | p |
                p := (tgt nthData: i) changeClassTo: GTK.GtkTargetPair.
                (GTK.Gdk atomName: p target value) printNl. ].
        Transcript << 'end of list.'; nl.
                                                
        tgt := 
                [ :name | | e | 
                e := GTK.GtkTargetEntry new.
                e target value: name.
                e flags value: 0.
                e info value: 57.
                img  ].
        tgt value: 'PRIMARY'; value: 'SECONDARY'.
                
                
        img
                when: 'drag-drop' 
                        send: #dropEvent:context:x:y:time: 
                                to: self;
                when: 'drag-data-received' 
                        send: #dragDataReceived:context:x:y:data:info:time: 
                                to: self;
                when: 'drag_data_received' 
                        send: #dragDataReceived:context:x:y:data:info:time: 
                                to: self;
                when: 'drag-motion'
                        send: #dragMotion:context:x:y:time:userData:
                                to: self
                                        with: 'img'.
!

run
        wnd isNil ifTrue: [ self buildWindow ].
        wnd showAll.
        GTK.Gtk main
!
!

GTK.Gtk gstGtkInit
!

NcDropTarget new run
!