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