1#
2# TkGnats PR folders module
3#
4
5#
6# -- globals
7#
8set Tkprfolder(site_print_dir)   "$TkGnats(SiteServerDir)/print"
9set Tkprfolder(site_query_dir)   "$TkGnats(SiteServerDir)/query"
10set Tkprfolder(site_sort_dir)    "$TkGnats(SiteServerDir)/sort"
11set Tkprfolder(user_query_dir)   "$TkGnats(UserServerDir)/query"
12set Tkprfolder(user_sort_dir)    "$TkGnats(UserServerDir)/sort"
13set Tkprfolder(build_query_menu) build_query_menu
14set Tkprfolder(build_sort_menu)  build_sort_menu
15set Tkprfolder(foldernameregexp) {^[a-zA-Z0-9]+[a-zA-Z0-9_.]*}
16
17proc tkprfolder_button_cmd {cmd top lbox type} {
18    global Tkprfolder Query
19    if {"$cmd" == "Close"} {
20	destroy $top
21	return
22    }
23    if {"$cmd" == "New"} {
24	tkprfolder_new $top $type
25	return
26    }
27    # get the selected item (if there is one)
28    set x  [$lbox curselection]
29    if {"$x" == ""} {
30	Msg "No selection available in the folder list box!"
31	return
32    }
33    set idx [lindex $x 0]
34    set folder [$lbox get $idx]
35    if {"$cmd" == "Rename"} {
36        if {[catch {entryDialog "Enter new name for $folder" Cancel "" 0 $top} newname]} {
37            return ""
38        }
39	regexp $Tkprfolder(foldernameregexp) $newname match
40	if {$newname != $match} {
41	    Msg "Folder names must be composed only of letters, numbers, underscores and periods."
42	    return
43	}
44        if {[file exists $Tkprfolder(user_${type}_dir)/$newname]} {
45            bell
46            if {[tk_dialog .tkprfolder_delete "Confirm_Rename" "$newname already exists" \
47                    "warning" -1 "Rename" "Cancel"] != 0} {
48                return
49            }
50        }
51	file rename -force \
52		$Tkprfolder(user_${type}_dir)/$folder $Tkprfolder(user_${type}_dir)/$newname
53	tkprfolder_resync $top $type $newname
54        $Tkprfolder(build_${type}_menu)
55	return
56    }
57    if {"$cmd" == "Delete"} {
58#####	if {"$folder" == "Backup--Folder"} {
59#####	    Msg "You are not allowed to delete $folder."
60#####	    return
61#####	}
62#####	file rename $Tkprfolder(user_${type}_dir)/$folder $Tkprfolder(user_${type}_dir)/Backup--Folder
63        bell
64        if {[tk_dialog .tkprfolder_delete "Confirm_Delete" "Delete $folder?" "warning" -1 \
65                "Delete" "Cancel"] == 0} {
66            file delete $Tkprfolder(user_${type}_dir)/$folder
67            tkprfolder_resync $top $type
68            $Tkprfolder(build_${type}_menu)
69        }
70	return
71    }
72    if {"$cmd" == "Edit"} {
73#####	if {"$folder" == "Backup--Folder"} {
74#####	    Msg "You are not allowed to edit $folder."
75#####	    return
76#####	}
77#####	file copy $Tkprfolder(user_${type}_dir)/$folder $Tkprfolder(user_${type}_dir)/Backup--Folder
78	tkprfolder_edit $folder $top $type
79	return
80    }
81    Msg "tkprfolder_button_cmd:\n" "do not understand the '$cmd' operation"
82}
83
84proc tkprfolder_edit_Cancel {top txt fname flisttop type} {
85    destroy $top
86}
87proc tkprfolder_edit_Save {top txt fname flisttop type} {
88    global Tkprfolder
89    file_put_text $Tkprfolder(user_${type}_dir)/$fname [$txt get 1.0 end]
90    destroy $top
91    tkprfolder_resync $flisttop $type $fname
92    $Tkprfolder(build_${type}_menu)
93}
94
95proc tkprfolder_resync {w type {activate ""}} {
96    global Tkprfolder
97    #####    if {[winfo exists $flisttop]} {
98    #####	tkprfolder_dialog $flisttop
99    #####    }
100    # first get the list of folders for this person
101    set folder_list {}
102    set ltemp ""
103    catch {[set ltemp [lsort [glob $Tkprfolder(user_${type}_dir)/*]]]}
104    foreach file $ltemp {
105        lappend folder_list [file tail $file]
106    }
107    # decide which element from the new list to activate
108    if {$activate == ""} {
109        set active [$w.list index active]
110    } {
111        set active [lsearch -exact $folder_list $activate]
112    }
113    $w.list delete 0 end
114    eval $w.list insert end $folder_list
115    $w.list activate $active
116    $w.list selection set active
117}
118
119proc tkprfolder_edit {fname flisttop type} {
120    global TkGnats Tkprfolder
121    set f .tkprfolder_edit_file
122    if {[winfo exists $f]} {
123	Msg "You can only edit one folder at a time."
124	return
125    }
126    toplevel $f
127    frame $f.buttons
128    foreach x {Save Cancel} {
129	button $f.buttons._$x -text $x \
130	    -command "tkprfolder_edit_$x $f $f.text $fname $flisttop $type"
131	pack $f.buttons._$x -side left -padx 4
132    }
133    scrollbar $f.sb -command "$f.text yview" -relief sunken
134    text $f.text \
135	-font $TkGnats(textfont) \
136	-yscrollcommand "$f.sb set" \
137	-height 20 -width 90 -relief sunken -padx 4 -insertwidth 1 \
138	-insertofftime 400 -borderwidth 2 -background $TkGnats(EditFieldBackground)
139    set_focus_style $f.text
140    bind $f.text <Control-g> {
141	set s [prid_from_selection]
142	if {"$s" != ""} {
143	    %W insert 1.0 "$s\n"
144	}
145    }
146    bind $f.text <3> "clipboard_post $f.text %X %Y"
147
148    pack $f.buttons -side bottom
149    pack $f.sb      -side left  -fill y
150    pack $f.text    -side right -fill both -expand true
151    if {[file exists $Tkprfolder(user_${type}_dir)/$fname]} {
152	$f.text insert 1.0 [file_get_text $Tkprfolder(user_${type}_dir)/$fname]
153    }
154    wm title $f "Tkprfolder: $fname"
155}
156
157
158proc tkprfolder_new {flisttop type} {
159    global Tkprfolder
160    if {[catch {entryDialog "Enter name of folder file" Cancel "" 0 $flisttop} fname]} {
161        return ""
162    }
163    regexp $Tkprfolder(foldernameregexp) $fname match
164    if {$fname != $match} {
165	Msg "Folder names must be composed only of letters, numbers, underscores and periods."
166	return
167    }
168    if {[file exists $Tkprfolder(user_${type}_dir)/$fname]} {
169        bell
170        if {[tk_dialog .tkprfolder_delete "Confirm_New" "$fname already exists" \
171                "warning" -1 "Edit" "Cancel"] != 0} {
172            return
173        }
174    }
175    tkprfolder_edit $fname $flisttop $type
176}
177
178proc XXXXXtkprfolder_cmd {cmd w y} {
179    set idx [$w nearest $y]
180    set fname [$w get $idx]
181    query_cmd [split [file_get_text $fname] " \n\t"]
182}
183
184proc tkprfolder_dialog {w type title} {
185    global Tkprfolder TkGnats env
186    if {[winfo exists $w]} {
187	$w.list delete 0 end
188    } {
189	toplevel $w
190        wm title      $w "TkGnats - $title"
191        wm iconbitmap $w  @$TkGnats(lib)/tkgnats.xbm
192        wm iconname   $w "$TkGnats(LogName)'s tkquerypr $title"
193
194	message   $w.msg -anchor center -text $title -aspect 10000
195	scrollbar $w.sb -borderwidth 2 -relief sunken -command "$w.list yview"
196	listbox   $w.list -yscroll "$w.sb set" -setgrid 1 -relief sunken -borderwidth 2 \
197                -width 24 -height 8 -exportselection false
198	frame     $w.buttons
199	foreach x {Close Edit Delete Rename New} {
200	    button $w.buttons._$x -text $x -width 6 \
201		-command "tkprfolder_button_cmd $x $w $w.list $type"
202	    pack $w.buttons._$x -side top -padx 5 -pady 5
203	}
204	pack $w.msg     -side top   -fill x
205	pack $w.buttons -side right
206	pack $w.sb      -side left  -fill y
207	pack $w.list    -side right -fill both -expand true
208    }
209    tkprfolder_resync $w $type
210}
211