summaryrefslogtreecommitdiffstats
path: root/apol/find.tcl
blob: f3cf5f5179ed4bc1caa290b820c386a5018bdd7f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
# Copyright (C) 2007 Tresys Technology, LLC
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

namespace eval Apol_Find {
    variable dialog .apol_find_dialog
    variable search_string {}
    variable case_sensitive 0
    variable enable_regexp 0
    variable direction "down"
}

proc Apol_Find::find {} {
    variable dialog
    if {![winfo exists $dialog]} {
        _create_dialog
    } else {
        raise $dialog
        variable entry
        focus $entry
        $entry selection range 0 end
    }
}


########## private functions below ##########

proc Apol_Find::_create_dialog {} {
    variable dialog
    Dialog $dialog -title "Find" -separator 0 -parent . \
        -side right -default 0 -cancel 1 -modal none -homogeneous 1
    set top_frame [frame [$dialog getframe].top]
    set bottom_frame [frame [$dialog getframe].bottom]
    pack $top_frame -expand 1 -fill both -padx 10 -pady 5
    pack $bottom_frame -expand 0 -fill both -padx 10 -pady 5

    set entry_label [label $top_frame.l -text "Find:" -anchor e]
    variable entry [entry $top_frame.e -bg white \
                        -textvariable Apol_Find::search_string -width 16]
    pack $entry_label -side left -expand 0 -padx 10
    pack $entry -side left -expand 1 -fill x

    set options_frame [frame $bottom_frame.opts]
    pack $options_frame -side left -padx 5
    set options_case [checkbutton $options_frame.case -text "Match case" \
                          -variable Apol_Find::case_sensitive]
    set options_regex [checkbutton $options_frame.regex -text "Regular expression" \
                           -variable Apol_Find::enable_regexp]
    pack $options_case -anchor w
    pack $options_regex -anchor w

    set dir_frame [TitleFrame $bottom_frame.dir -text Direction]
    pack $dir_frame -side left
    set dir_up [radiobutton [$dir_frame getframe].up -text Up \
                    -variable Apol_Find::direction -value up]
    set dir_down [radiobutton [$dir_frame getframe].down -text Down \
                      -variable Apol_Find::direction -value down]
    pack $dir_up $dir_down -side left

    $dialog add -text "Find Next" -command Apol_Find::_do_find
    $dialog add -text "Cancel" -command [list destroy $dialog]

    focus $entry
    $dialog draw
    wm resizable $dialog 0 0
}

proc Apol_Find::_do_find {} {
    set w [ApolTop::getCurrentTextWidget]
    if {$w == {}} {
        return
    }

    variable search_string
    variable case_sensitive
    variable enable_regexp
    variable direction

    if {$search_string == {}} {
        return
    }

    set opts {}
    if {!$case_sensitive} {
        lappend opts "-nocase"
    }
    if {$enable_regexp} {
        lappend opts "-regexp"
    }
    if {$direction == "down"} {
        lappend opts "-forward"
        set start_pos [$w index insert]
    } else {
        lappend opts "-backward"
        set start_pos [lindex [$w tag ranges sel] 0]
    }
    if {$start_pos == {}} {
        set start_pos "1.0"
    }

    $w tag remove sel 0.0 end

    variable dialog
    if {[catch {eval $w search -count count $opts -- [list $search_string] $start_pos} pos]} {
        tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
                 "Invalid regular expression."
        return
    }

    if {$pos == {}} {
        tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
                 "String not found."
    } else {
        if {$direction == "down"} {
            $w mark set insert "$pos + $count char"
            $w see "$pos + $count char"
        } else {
            $w mark set insert "$pos"
            $w see $pos
        }
        $w tag add sel $pos "$pos + $count char"
    }
}