1GtkTextPluginWidget subclass: GtkFindWidget [
2    | entry matchCase next previous lastPosition |
3
4    buildEntry [
5	<category: 'user interface'>
6
7	^ entry := GTK.GtkEntry new
8			connectSignal: 'activate' to: self selector: #keyPressed;
9			yourself
10    ]
11
12    buildPreviousButton [
13	<category: 'user interface'>
14
15        ^ previous := GTK.GtkButton previousButton
16			connectSignal: 'clicked' to: self selector: #previousPressed;
17			yourself
18    ]
19
20    buildNextButton [
21        <category: 'user interface'>
22
23        ^ next := GTK.GtkButton nextButton
24			connectSignal: 'clicked' to: self selector: #keyPressed;
25			yourself
26    ]
27
28    buildMatchCaseButton [
29        <category: 'user interface'>
30
31	^ matchCase := GTK.GtkCheckButton newWithLabel: 'match case'
32    ]
33
34    hBox [
35	<category: 'user interface'>
36
37	^ super hBox
38	    packStart: (GTK.GtkLabel new: 'Find:') expand: false fill: false padding: 2;
39	    packStart: self buildEntry expand: false fill: false padding: 15;
40	    packStart: self buildPreviousButton expand: false fill: false padding: 0;
41	    packStart: self buildNextButton expand: false fill: false padding: 0;
42	    packStart: self buildMatchCaseButton expand: false fill: false padding: 0;
43	    yourself
44    ]
45
46    grabFocus [
47	<category: 'focus'>
48
49	entry grabFocus
50    ]
51
52    searchFrom: anInteger [
53	<category: 'text searching'>
54
55	^ textWidget text indexOf: entry getText matchCase: matchCase getActive startingAt: anInteger
56    ]
57
58    searchBackFrom: anInteger [
59	<category: 'text searching'>
60
61	^ textWidget text deindexOf: entry getText matchCase: matchCase getActive startingAt: anInteger
62    ]
63
64    keyPressed [
65	<category: 'entry events'>
66
67	| int |
68	lastPosition := textWidget hasSelection
69					ifTrue: [ textWidget cursorPosition + 2 ]
70					ifFalse: [ textWidget cursorPosition + 1 ].
71	lastPosition > textWidget text size ifTrue: [ lastPosition := 1 ].
72	int := self searchFrom: lastPosition.
73	int ifNil: [ (int := self searchFrom: 1) ifNil: [ int := textWidget cursorPosition + 1 to: textWidget cursorPosition ] ].
74	textWidget selectRange: int first - 1 bound: int last.
75    ]
76
77    previousPressed [
78	<category: 'previous events'>
79
80	| int |
81	lastPosition := textWidget hasSelection
82					ifTrue: [ textWidget cursorPosition ]
83					ifFalse: [ textWidget cursorPosition + 1 ].
84	lastPosition = 0 ifTrue: [ lastPosition := textWidget text size ].
85	int := self searchBackFrom: lastPosition.
86	int ifNil: [ (int := self searchBackFrom: textWidget text size) ifNil: [ int := textWidget cursorPosition + 1 to: textWidget cursorPosition ] ].
87	textWidget selectRange: int first - 1 bound: int last.
88    ]
89]
90
91