OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [finddialog.itk] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
#
2
# Finddialog
3
# ----------------------------------------------------------------------
4
# This class implements a dialog for searching text.  It prompts the
5
# user for a search string and the method of searching which includes
6
# case sensitive, regular expressions, backwards, and all.
7
#
8
# ----------------------------------------------------------------------
9
#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
10
#
11
#  @(#) RCS: $Id: finddialog.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $
12
# ----------------------------------------------------------------------
13
#            Copyright (c) 1996 DSC Technologies Corporation
14
# ======================================================================
15
# Permission to use, copy, modify, distribute and license this software
16
# and its documentation for any purpose, and without fee or written
17
# agreement with DSC, is hereby granted, provided that the above copyright
18
# notice appears in all copies and that both the copyright notice and
19
# warranty disclaimer below appear in supporting documentation, and that
20
# the names of DSC Technologies Corporation or DSC Communications
21
# Corporation not be used in advertising or publicity pertaining to the
22
# software without specific, written prior permission.
23
#
24
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
25
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
26
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
27
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
28
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
29
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
30
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
31
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
32
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
33
# SOFTWARE.
34
# ======================================================================
35
 
36
#
37
# Usual options.
38
#
39
itk::usual Finddialog {
40
    keep -background -cursor -foreground -selectcolor
41
}
42
 
43
# ------------------------------------------------------------------
44
#                          IPRFINDDIALOG
45
# ------------------------------------------------------------------
46
class ::iwidgets::Finddialog {
47
    inherit iwidgets::Dialogshell
48
 
49
    constructor {args} {}
50
 
51
    itk_option define -selectcolor selectColor Background {}
52
    itk_option define -clearcommand clearCommand Command {}
53
    itk_option define -matchcommand matchCommand Command {}
54
    itk_option define -patternbackground patternBackground Background \#707070
55
    itk_option define -patternforeground patternForeground Foreground White
56
    itk_option define -searchbackground searchBackground Background \#c4c4c4
57
    itk_option define -searchforeground searchForeground Foreground Black
58
    itk_option define -textwidget textWidget TextWidget {}
59
 
60
    public {
61
        method clear {}
62
        method find {}
63
    }
64
 
65
    protected {
66
        method _get {setting}
67
        method _textExists {}
68
 
69
        common _optionValues       ;# Current settings of check buttons.
70
        common _searchPoint        ;# Starting location for searches
71
        common _matchLen           ;# Matching pattern string length
72
    }
73
}
74
 
75
#
76
# Provide a lowercased access method for the ::finddialog class.
77
#
78
proc ::iwidgets::finddialog {pathName args} {
79
    uplevel ::iwidgets::Finddialog $pathName $args
80
}
81
 
82
#
83
# Use option database to override default resources of base classes.
84
#
85
option add *Finddialog.title "Find" widgetDefault
86
 
87
# ------------------------------------------------------------------
88
#                            CONSTRUCTOR
89
# ------------------------------------------------------------------
90
body ::iwidgets::Finddialog::constructor {args} {
91
    #
92
    # Add the find pattern entryfield.
93
    #
94
    itk_component add pattern {
95
        iwidgets::Entryfield $itk_interior.pattern -labeltext "Find:"
96
    }
97
    bind [$itk_component(pattern) component entry] \
98
             "[code $this invoke]; break"
99
 
100
    #
101
    # Add the find all checkbutton.
102
    #
103
    itk_component add all {
104
        checkbutton $itk_interior.all \
105
            -variable [scope _optionValues($this-all)] \
106
            -text "All"
107
    }
108
 
109
    #
110
    # Add the case consideration checkbutton.
111
    #
112
    itk_component add case {
113
        checkbutton $itk_interior.case \
114
            -variable [scope _optionValues($this-case)] \
115
            -text "Consider Case"
116
    }
117
 
118
    #
119
    # Add the regular expression checkbutton.
120
    #
121
    itk_component add regexp {
122
        checkbutton $itk_interior.regexp \
123
            -variable [scope _optionValues($this-regexp)] \
124
            -text "Use Regular Expression"
125
    }
126
 
127
    #
128
    # Add the find backwards checkbutton.
129
    #
130
    itk_component add backwards {
131
        checkbutton $itk_interior.backwards \
132
            -variable [scope _optionValues($this-backwards)] \
133
            -text "Find Backwards"
134
    }
135
 
136
    #
137
    # Add the find, clear, and close buttons, making find be the default.
138
    #
139
    add Find -text Find -command [code $this find]
140
    add Clear -text Clear -command [code $this clear]
141
    add Close -text Close -command [code $this deactivate 0]
142
 
143
    default Find
144
 
145
    #
146
    # Use the grid to layout the components.
147
    #
148
    grid $itk_component(pattern) -row 0 -column 0 \
149
        -padx 10 -pady 10 -columnspan 4 -sticky ew
150
    grid $itk_component(all) -row 1 -column 0
151
    grid $itk_component(case) -row 1 -column 1
152
    grid $itk_component(regexp) -row 1 -column 2
153
    grid $itk_component(backwards) -row 1 -column 3
154
 
155
    grid columnconfigure $itk_interior 0 -weight 1
156
    grid columnconfigure $itk_interior 1 -weight 1
157
    grid columnconfigure $itk_interior 2 -weight 1
158
    grid columnconfigure $itk_interior 3 -weight 1
159
 
160
    #
161
    # Initialize all the configuration options.
162
    #
163
    eval itk_initialize $args
164
}
165
 
166
# ------------------------------------------------------------------
167
#                             OPTIONS
168
# ------------------------------------------------------------------
169
 
170
# ------------------------------------------------------------------
171
# OPTION: -clearcommand
172
#
173
# Specifies a command to be invoked following a clear operation.
174
# The command is meant to be a means of notification that the
175
# clear has taken place and allow other actions to take place such
176
# as disabling a find again menu.
177
# ------------------------------------------------------------------
178
configbody iwidgets::Finddialog::clearcommand {}
179
 
180
# ------------------------------------------------------------------
181
# OPTION: -matchcommand
182
#
183
# Specifies a command to be invoked following a find operation.
184
# The command is called with a match point as an argument.  Should
185
# a match not be found the match point is {}.
186
# ------------------------------------------------------------------
187
configbody iwidgets::Finddialog::matchcommand {}
188
 
189
# ------------------------------------------------------------------
190
# OPTION: -patternbackground
191
#
192
# Specifies the background color of the text matching the search
193
# pattern.  It may have any of the forms accepted by Tk_GetColor.
194
# ------------------------------------------------------------------
195
configbody iwidgets::Finddialog::patternbackground {}
196
 
197
# ------------------------------------------------------------------
198
# OPTION: -patternforeground
199
#
200
# Specifies the foreground color of the pattern matching a search
201
# operation.  It may have any of the forms accepted by Tk_GetColor.
202
# ------------------------------------------------------------------
203
configbody iwidgets::Finddialog::patternforeground {}
204
 
205
# ------------------------------------------------------------------
206
# OPTION: -searchforeground
207
#
208
# Specifies the foreground color of the line containing the matching
209
# pattern from a search operation.  It may have any of the forms
210
# accepted by Tk_GetColor.
211
# ------------------------------------------------------------------
212
configbody iwidgets::Finddialog::searchforeground {}
213
 
214
# ------------------------------------------------------------------
215
# OPTION: -searchbackground
216
#
217
# Specifies the background color of the line containing the matching
218
# pattern from a search operation.  It may have any of the forms
219
# accepted by Tk_GetColor.
220
# ------------------------------------------------------------------
221
configbody iwidgets::Finddialog::searchbackground {}
222
 
223
# ------------------------------------------------------------------
224
# OPTION: -textwidget
225
#
226
# Specifies the scrolledtext or text widget to be searched.
227
# ------------------------------------------------------------------
228
configbody iwidgets::Finddialog::textwidget {
229
    if {$itk_option(-textwidget) != {}} {
230
        set _searchPoint($itk_option(-textwidget)) 1.0
231
    }
232
}
233
 
234
# ------------------------------------------------------------------
235
#                            METHODS
236
# ------------------------------------------------------------------
237
 
238
# ------------------------------------------------------------------
239
# PUBLIC METHOD: clear
240
#
241
# Clear the pattern entryfield and the indicators.
242
# ------------------------------------------------------------------
243
body ::iwidgets::Finddialog::clear {} {
244
    $itk_component(pattern) clear
245
 
246
    if {[_textExists]} {
247
        set _searchPoint($itk_option(-textwidget)) 1.0
248
 
249
        $itk_option(-textwidget) tag remove search-line 1.0 end
250
        $itk_option(-textwidget) tag remove search-pattern 1.0 end
251
    }
252
 
253
    if {$itk_option(-clearcommand) != {}} {
254
        $itk_option(-clearcommand)
255
    }
256
}
257
 
258
# ------------------------------------------------------------------
259
# PUBLIC METHOD: find
260
#
261
# Search for a specific text string in the text widget given by
262
# the -textwidget option.  Should this option not be set to an
263
# existing widget, then a quick exit is made.
264
# ------------------------------------------------------------------
265
body ::iwidgets::Finddialog::find {} {
266
    if {! [_textExists]} {
267
        return
268
    }
269
 
270
    #
271
    # Clear any existing indicators in the text widget.
272
    #
273
    $itk_option(-textwidget) tag remove search-line 1.0 end
274
    $itk_option(-textwidget) tag remove search-pattern 1.0 end
275
 
276
    #
277
    # Make sure the search pattern isn't just blank.  If so, skip this.
278
    #
279
    set pattern [_get pattern]
280
 
281
    if {[string trim $pattern] == ""} {
282
        return
283
    }
284
 
285
    #
286
    # After clearing out any old highlight indicators from a previous
287
    # search, we'll be building our search command piece-meal based on
288
    # the current settings of the checkbuttons in the find dialog.  The
289
    # first we'll add is a variable to catch the count of the length
290
    # of the string matching the pattern.
291
    #
292
    set precmd "$itk_option(-textwidget) search \
293
            -count [list [scope _matchLen($this)]]"
294
 
295
    if {! [_get case]} {
296
        append precmd " -nocase"
297
    }
298
 
299
    if {[_get regexp]} {
300
        append precmd " -regexp"
301
    } else {
302
        append precmd " -exact"
303
    }
304
 
305
    #
306
    # If we are going to find all matches, then the start point for
307
    # the search will be the beginning of the text; otherwise, we'll
308
    # use the last known starting point +/- a character depending on
309
    # the direction.
310
    #
311
    if {[_get all]} {
312
        set _searchPoint($itk_option(-textwidget)) 1.0
313
    } else {
314
        if {[_get backwards]} {
315
            append precmd " -backwards"
316
        } else {
317
            append precmd " -forwards"
318
        }
319
    }
320
 
321
    #
322
    # Get the pattern to be matched and add it to the search command.
323
    # Since it may contain embedded spaces, we'll wrap it in a list.
324
    #
325
    append precmd " [list $pattern]"
326
 
327
    #
328
    # If the search is for all matches, then we'll be performing the
329
    # search until no more matches are found; otherwise, we'll break
330
    # out of the loop after one search.
331
    #
332
    while {1} {
333
        if {[_get all]} {
334
            set postcmd " $_searchPoint($itk_option(-textwidget)) end"
335
 
336
        } else {
337
            set postcmd " $_searchPoint($itk_option(-textwidget))"
338
        }
339
 
340
        #
341
        # Create the final search command out of the pre and post parts
342
        # and evaluate it which returns the location of the matching string.
343
        #
344
        set cmd {}
345
        append cmd $precmd $postcmd
346
 
347
        if {[catch {eval $cmd} matchPoint] != 0} {
348
            set _searchPoint($itk_option(-textwidget)) 1.0
349
            return {}
350
        }
351
 
352
        #
353
        # If a match exists, then we'll make this spot be the new starting
354
        # position.  Then we'll tag the line and the pattern in the line.
355
        # The foreground and background settings will lite these positions
356
        # in the text widget up.
357
        #
358
        if {$matchPoint != {}} {
359
            set _searchPoint($itk_option(-textwidget)) $matchPoint
360
 
361
            $itk_option(-textwidget) tag add search-line \
362
              "$_searchPoint($itk_option(-textwidget)) linestart" \
363
                "$_searchPoint($itk_option(-textwidget))"
364
            $itk_option(-textwidget) tag add search-line \
365
              "$_searchPoint($itk_option(-textwidget)) + \
366
               $_matchLen($this) chars" \
367
              "$_searchPoint($itk_option(-textwidget)) lineend"
368
            $itk_option(-textwidget) tag add search-pattern \
369
               $_searchPoint($itk_option(-textwidget)) \
370
                "$_searchPoint($itk_option(-textwidget)) + \
371
                 $_matchLen($this) chars"
372
        }
373
 
374
        #
375
        # Set the search point for the next time through to be one
376
        # character more or less from the current search point based
377
        # on the direction.
378
        #
379
        if {[_get all] || ! [_get backwards]} {
380
            set _searchPoint($itk_option(-textwidget)) \
381
                [$itk_option(-textwidget) index \
382
                     "$_searchPoint($itk_option(-textwidget)) + 1c"]
383
        } else {
384
            set _searchPoint($itk_option(-textwidget)) \
385
                [$itk_option(-textwidget) index \
386
                     "$_searchPoint($itk_option(-textwidget)) - 1c"]
387
        }
388
 
389
        #
390
        # If this isn't a find all operation or we didn't get a match, exit.
391
        #
392
        if {(! [_get all]) || ($matchPoint == {})} {
393
            break
394
        }
395
    }
396
 
397
    #
398
    # Configure the colors for the search-line and search-pattern.
399
    #
400
    $itk_option(-textwidget) tag configure search-line \
401
            -foreground $itk_option(-searchforeground)
402
    $itk_option(-textwidget) tag configure search-line \
403
            -background $itk_option(-searchbackground)
404
    $itk_option(-textwidget) tag configure search-pattern \
405
            -background $itk_option(-patternbackground)
406
    $itk_option(-textwidget) tag configure search-pattern \
407
            -foreground $itk_option(-patternforeground)
408
 
409
    #
410
    # Adjust the view to be the last matched position.
411
    #
412
    if {$matchPoint != {}} {
413
        $itk_option(-textwidget) see $matchPoint
414
    }
415
 
416
    #
417
    # There may be multiple matches of the pattern on a single line,
418
    # so we'll set the tag priorities such that the pattern tag is higher.
419
    #
420
    $itk_option(-textwidget) tag raise search-pattern search-line
421
 
422
    #
423
    # If a match command is defined, then call it with the match point.
424
    #
425
    if {$itk_option(-matchcommand) != {}} {
426
        $itk_option(-matchcommand) $matchPoint
427
    }
428
 
429
    #
430
    # Return the match point to the caller so they know if we found
431
    # anything and if so where
432
    #
433
    return $matchPoint
434
}
435
 
436
# ------------------------------------------------------------------
437
# PROTECTED METHOD: _get setting
438
#
439
# Get the current value for the pattern, case, regexp, or backwards.
440
# ------------------------------------------------------------------
441
body ::iwidgets::Finddialog::_get {setting} {
442
    switch $setting {
443
        pattern {
444
            return [$itk_component(pattern) get]
445
        }
446
        case {
447
            return $_optionValues($this-case)
448
        }
449
        regexp {
450
            return $_optionValues($this-regexp)
451
        }
452
        backwards {
453
            return $_optionValues($this-backwards)
454
        }
455
        all {
456
            return $_optionValues($this-all)
457
        }
458
        default {
459
            error "bad get setting: \"$setting\", should be pattern,\
460
                    case, regexp, backwards, or all"
461
        }
462
    }
463
}
464
 
465
# ------------------------------------------------------------------
466
# PROTECTED METHOD: _textExists
467
#
468
# Check the validity of the text widget option.  Does it exist and
469
# is it of the class Text or Scrolledtext.
470
# ------------------------------------------------------------------
471
body ::iwidgets::Finddialog::_textExists {} {
472
    if {$itk_option(-textwidget) == {}} {
473
        return 0
474
    }
475
 
476
    if {! [winfo exists $itk_option(-textwidget)]} {
477
        error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
478
               the widget doesn't exist"
479
    }
480
 
481
    if {([winfo class $itk_option(-textwidget)] != "Text") &&
482
        ([itcl::find objects -isa iwidgets::Scrolledtext *::$itk_option(-textwidget)] == "")} {
483
        error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
484
               must be of the class Text or based on Scrolledtext"
485
    }
486
 
487
    return 1
488
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.