00001 # TKE - Advanced Programmer's Editor 00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com) 00003 # 00004 # This program is free software; you can redistribute it and/or modify 00005 # it under the terms of the GNU General Public License as published by 00006 # the Free Software Foundation; either version 2 of the License, or 00007 # (at your option) any later version. 00008 # 00009 # This program is distributed in the hope that it will be useful, 00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of 00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00012 # GNU General Public License for more details. 00013 # 00014 # You should have received a copy of the GNU General Public License along 00015 # with this program; if not, write to the Free Software Foundation, Inc., 00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 00017 00018 ###################################################################### 00019 # Name: startup.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 09/27/2016 00022 # Brief: Namespace containing code to handle the startup wizard. 00023 ###################################################################### 00024 00025 namespace eval startup { 00026 00027 variable current_panel "" 00028 variable type "local" 00029 variable directory "" 00030 00031 array set widgets {} 00032 array set images {} 00033 array set rbs {} 00034 array set items {} 00035 array set locs { 00036 header_y 50 00037 help_y 100 00038 first_y 125 00039 second_y 200 00040 button_y 455 00041 header_x 240 00042 left_x 250 00043 help_x 270 00044 right_x 610 00045 } 00046 array set colors { 00047 help grey50 00048 } 00049 00050 ###################################################################### 00051 # Creates the startup wizard window. 00052 proc create {} { 00053 00054 variable widgets 00055 variable images 00056 variable current_panel 00057 variable type 00058 variable directory 00059 variable items 00060 00061 # Create the images 00062 initialize 00063 00064 toplevel .wizwin 00065 wm title .wizwin [format "TKE %s" [msgcat::mc "Welcome"]] 00066 wm geometry .wizwin 640x480 00067 wm resizable .wizwin 0 0 00068 wm protocol .wizwin WM_DELETE_WINDOW { 00069 set ans [tk_messageBox -parent .wizwin -icon info -type yesno -default yes \ 00070 -message [msgcat::mc "Exit application?"] \ 00071 -detail [msgcat::mc "Closing this window will exit the application immediately."]] 00072 if {$ans eq "yes"} { 00073 exit 00074 } 00075 } 00076 wm withdraw .wizwin 00077 00078 # Add the tabs 00079 foreach window [list welcome settings copy share finish] { 00080 set widgets($window) [canvas .wizwin.$window -highlightthickness 0 -relief flat -background white -width 640 -height 480] 00081 $widgets($window) lower [$widgets($window) create image 0 0 -anchor nw -image $images(bg)] 00082 create_$window 00083 } 00084 00085 # Pack the first window 00086 show_panel welcome 00087 00088 # Allow the window sizes to be calculatable 00089 update 00090 00091 # Place the window in the middle of the screen 00092 center_on_screen 00093 00094 # Display the window 00095 wm deiconify .wizwin 00096 00097 # Wait for the window to be destroyed 00098 tkwait window .wizwin 00099 00100 # Destroy the images 00101 destroy_images 00102 00103 return [list $type $directory [array get items]] 00104 00105 } 00106 00107 ###################################################################### 00108 # Center the wizard window on the screen (including dual monitor setups). 00109 proc center_on_screen {} { 00110 00111 set swidth [winfo screenwidth .wizwin] 00112 set sheight [winfo screenheight .wizwin] 00113 00114 # If we have a dual monitor setup, center the window on the first window 00115 if {[expr ($swidth.0 / $sheight) > 2]} { 00116 set swidth [expr $swidth / 2] 00117 } 00118 00119 # Place the window in the middle of the screen 00120 wm geometry .wizwin +[expr ($swidth / 2) - 320]+[expr ($sheight / 2) - 240] 00121 00122 } 00123 00124 ###################################################################### 00125 # Initializes the startup namespace. 00126 proc initialize {} { 00127 00128 variable items 00129 00130 # Create the images 00131 create_images 00132 00133 # Initialize the items list 00134 foreach {type nspace name} [share::get_share_items] { 00135 set items($type) 1 00136 } 00137 00138 } 00139 00140 ###################################################################### 00141 # Create the images 00142 proc create_images {} { 00143 00144 variable images 00145 00146 set images(bg) [image create photo -file [file join $::tke_dir lib images startup.gif]] 00147 00148 } 00149 00150 ###################################################################### 00151 # Deletes the images. 00152 proc destroy_images {} { 00153 00154 variable images 00155 00156 foreach {name img} [array get images] { 00157 image delete $img 00158 } 00159 00160 } 00161 00162 ###################################################################### 00163 # Shows the given panel name. 00164 proc show_panel {type} { 00165 00166 variable widgets 00167 variable current_panel 00168 00169 if {$current_panel ne ""} { 00170 pack forget $widgets($current_panel) 00171 } 00172 00173 pack $widgets($type) -fill both -expand yes 00174 00175 set current_panel $type 00176 00177 } 00178 00179 ###################################################################### 00180 # Create the welcome window. 00181 proc create_welcome {} { 00182 00183 variable widgets 00184 variable locs 00185 00186 # Header 00187 make_header $widgets(welcome) $locs(header_x) $locs(header_y) [format "%s TKE!" [msgcat::mc "Welcome To"]] 00188 00189 # Add text 00190 make_text $widgets(welcome) $locs(header_x) $locs(first_y) \ 00191 [msgcat::mc "Thanks for using TKE, the advanced programmer's editor. Since this is a new installation of TKE, let's help you get things set up. \\n \\n Click 'Next' below to get things going."] 00192 00193 # Create Next button 00194 make_button $widgets(welcome) [list right] $locs(button_y) [msgcat::mc "Next"] [list startup::show_panel settings] 00195 00196 } 00197 00198 ###################################################################### 00199 # Create the import/share window. 00200 proc create_settings {} { 00201 00202 variable widgets 00203 variable locs 00204 variable colors 00205 00206 array set labels [list \ 00207 local [msgcat::mc "Creates new settings information and places it in your home directory"] \ 00208 copy [msgcat::mc "Copies settings data from an existing directory to your home directory."] \ 00209 share [msgcat::mc "Shares settings data from a new or existing directory (ex., iCloud Drive, Google Drive, Dropbox, etc.). Any changes made to settings data will be available to other sharers."] \ 00210 ] 00211 00212 # Header 00213 make_header $widgets(settings) $locs(header_x) $locs(header_y) [msgcat::mc "Settings Options"] 00214 00215 # Create the radiobutton 00216 set id [make_radiobutton $widgets(settings) $locs(left_x) $locs(first_y) [msgcat::mc "Create settings locally"] startup::type local {}] 00217 set id [make_text $widgets(settings) $locs(help_x) [get_y $widgets(settings) $id 10] $labels(local) $colors(help)] 00218 set id [make_radiobutton $widgets(settings) $locs(left_x) [get_y $widgets(settings) $id 15] [msgcat::mc "Copy settings from directory"] startup::type copy {}] 00219 set id [make_text $widgets(settings) $locs(help_x) [get_y $widgets(settings) $id 10] $labels(copy) $colors(help)] 00220 set id [make_radiobutton $widgets(settings) $locs(left_x) [get_y $widgets(settings) $id 15] [msgcat::mc "Use shared settings"] startup::type share {}] 00221 set id [make_text $widgets(settings) $locs(help_x) [get_y $widgets(settings) $id 10] $labels(share) $colors(help)] 00222 00223 # Create the button bar 00224 set b [make_button $widgets(settings) [list right] $locs(button_y) [msgcat::mc "Next"] \ 00225 [list if {$startup::type eq "local"} { startup::show_panel finish } else { startup::do_directory }]] 00226 make_button $widgets(settings) [list leftof $b] $locs(button_y) [msgcat::mc "Back"] [list startup::show_panel welcome] 00227 00228 } 00229 00230 foreach ptype [list copy share] { 00231 00232 ###################################################################### 00233 # Creates the directory browse panel. 00234 proc create_$ptype [list [list type $ptype]] { 00235 00236 variable widgets 00237 variable locs 00238 variable colors 00239 00240 array set labels [list \ 00241 copy [list [msgcat::mc "Copy"] [msgcat::mc "Items that are selected will be copied to your local home directory. Items that are not selected will be created in your home directory."]] \ 00242 share [list [msgcat::mc "Share"] [msgcat::mc "Items that are selected will be shared with other computers. Items that are not selected will be stored locally and will not be shared."]] \ 00243 ] 00244 00245 # Header 00246 make_header $widgets($type) $locs(header_x) $locs(header_y) [format "%s / %s" [msgcat::mc "Directory"] [msgcat::mc "Settings"]] 00247 00248 # Directory 00249 set id [make_text $widgets($type) $locs(header_x) $locs(first_y) [format "%s:" [msgcat::mc "Directory"]]] 00250 entry $widgets($type).dir_entry -width 40 -state readonly -readonlybackground white -foreground black -relief flat 00251 set id [$widgets($type) create window $locs(header_x) [get_y $widgets($type) $id 10] -anchor nw -window $widgets($type).dir_entry] 00252 00253 set id [make_button $widgets($type) 400 [get_y $widgets($type) $id 10] [msgcat::mc "Change Directory"] [list startup::set_directory]] 00254 00255 # Create help 00256 set id [make_text $widgets($type) $locs(header_x) [get_y $widgets($type) $id 40] [lindex $labels($type) 1] $colors(help)] 00257 00258 # Starting Y position for items 00259 set items_y [get_y $widgets($type) $id 20] 00260 00261 # Create the sharing item checkbuttons 00262 set i 0 00263 foreach {itype nspace name} [share::get_share_items] { 00264 set x [expr $locs(left_x) + (($i < 5) ? 0 : 150)] 00265 set y [expr (($i % 5) == 0) ? $items_y : [get_y $widgets($type) $id 10]] 00266 set id [make_checkbutton $widgets($type) $x $y $name startup::items($itype) {}] 00267 incr i 00268 } 00269 00270 # Create the button bar 00271 set b [make_button $widgets($type) [list right] $locs(button_y) [msgcat::mc "Next"] [list startup::show_panel finish]] 00272 make_button $widgets($type) [list leftof $b] $locs(button_y) [msgcat::mc "Back"] [list startup::show_panel settings] 00273 00274 } 00275 00276 } 00277 00278 ###################################################################### 00279 # Create the finish window. 00280 proc create_finish {} { 00281 00282 variable widgets 00283 variable locs 00284 variable type 00285 00286 # Header 00287 make_header $widgets(finish) $locs(header_x) $locs(header_y) [format "%s!" [msgcat::mc "Setup Complete"]] 00288 00289 # Display text 00290 make_text $widgets(finish) $locs(header_x) $locs(first_y) \ 00291 [msgcat::mc "If you need would like to change your sharing settings, you can do so within Preferences under the General/Sharing tab."] 00292 00293 # Create the button bar 00294 set b [make_button $widgets(finish) [list right] $locs(button_y) [msgcat::mc "Finish"] [list destroy .wizwin]] 00295 make_button $widgets(finish) [list leftof $b] $locs(button_y) [msgcat::mc "Back"] \ 00296 [list if {$startup::type eq "local"} { startup::show_panel settings } else { startup::show_panel $startup::type }] 00297 00298 } 00299 00300 ###################################################################### 00301 # Sets the directory. 00302 proc set_directory {} { 00303 00304 variable widgets 00305 variable directory 00306 variable type 00307 00308 set initialdir [expr {($directory eq "") ? [file normalize ~] : $directory}] 00309 set mustexist [expr {($type eq "copy") ? 1 : 0}] 00310 set directory [tk_chooseDirectory -parent .wizwin -title [msgcat::mc "Select Settings Directory"] -initialdir $initialdir -mustexist $mustexist] 00311 00312 if {$directory ne ""} { 00313 foreach ptype [list copy share] { 00314 $widgets($ptype).dir_entry configure -state normal 00315 $widgets($ptype).dir_entry delete 0 end 00316 $widgets($ptype).dir_entry insert end $directory 00317 $widgets($ptype).dir_entry configure -state readonly 00318 } 00319 } 00320 00321 } 00322 00323 ###################################################################### 00324 # Called when we hit the 'Next' button in the settings panel. Immediately 00325 # display a directory chooser window and display the appropriate panel 00326 # based on the user interation with the window. 00327 proc do_directory {} { 00328 00329 variable widgets 00330 variable directory 00331 variable type 00332 00333 show_panel $type 00334 00335 if {$directory eq ""} { 00336 00337 # Attempt to set the directory 00338 set_directory 00339 00340 # If the directory was not set, go back to settings 00341 if {$directory eq ""} { 00342 show_panel settings 00343 } 00344 00345 } 00346 00347 } 00348 00349 ########### 00350 # WIDGETS # 00351 ########### 00352 00353 ###################################################################### 00354 # Returns the Y-coordinate value which places the affected item 00355 # immediately after the given item with pad pixels between them. 00356 proc get_y {c id pad} { 00357 00358 return [expr [lindex [$c bbox $id] end] + $pad] 00359 00360 } 00361 00362 ###################################################################### 00363 # Creates a header 00364 proc make_header {c x y txt} { 00365 00366 set id [$c create text $x $y -anchor nw -font "-size 24" -text $txt -fill black] 00367 00368 return $id 00369 00370 } 00371 00372 ###################################################################### 00373 # Creates a text widget that automatically wraps. 00374 proc make_text {c x y txt {color black}} { 00375 00376 variable locs 00377 00378 set id [$c create text $x $y -anchor nw -text "" -fill $color] 00379 00380 # Create wrapped text 00381 set lines [list] 00382 set text_width [expr $locs(right_x) - $x] 00383 00384 set line "" 00385 foreach word $txt { 00386 if {([font measure [$c itemcget $id -font] "$line $word"] < $text_width) && \ 00387 ($word ne "\n")} { 00388 append line " $word" 00389 } else { 00390 lappend lines [string trim $line] 00391 set line $word 00392 } 00393 } 00394 00395 if {$line ne ""} { 00396 lappend lines [string trim $line] 00397 } 00398 00399 $c itemconfigure $id -text [join $lines "\n"] 00400 00401 return $id 00402 00403 } 00404 00405 ###################################################################### 00406 # Creates a button. 00407 proc make_button {c xpos y txt command} { 00408 00409 # Create the button 00410 set id [$c create text 0 $y -anchor nw -font "-underline 1" -text $txt -fill black] 00411 00412 # Move the button to the correct position 00413 move_button $c $id $xpos $txt 00414 00415 # Create bindings 00416 $c bind $id <Button-1> $command 00417 $c bind $id <Enter> [list $c itemconfigure $id -fill blue] 00418 $c bind $id <Leave> [list $c itemconfigure $id -fill black] 00419 00420 return $id 00421 00422 } 00423 00424 ###################################################################### 00425 # Calculates the X-position. 00426 proc move_button {c id pos str} { 00427 00428 lassign $pos type value 00429 00430 set padx 30 00431 00432 lassign [$c coords $id] bx by 00433 00434 switch $type { 00435 left { 00436 set bx $padx 00437 } 00438 leftof { 00439 lassign [$c bbox $value] x1 y1 x2 y2 00440 set width [font measure [$c itemcget $id -font] $str] 00441 set bx [expr $x1 - ($width + $padx)] 00442 } 00443 right { 00444 set width [font measure [$c itemcget $id -font] $str] 00445 set bx [expr 640 - ($width + $padx)] 00446 } 00447 rightof { 00448 lappend [$c bbox $value] x1 y1 x2 y2 00449 set bx [expr $x2 + $padx] 00450 } 00451 default { 00452 set bx $type 00453 } 00454 } 00455 00456 # Set the new coordinates 00457 $c coords $id $bx $by 00458 00459 } 00460 00461 ###################################################################### 00462 # Creates a radiobutton. 00463 proc make_radiobutton {c x y txt var value command} { 00464 00465 variable rbs 00466 00467 set csize 11 00468 00469 # Create the radiobutton 00470 set cid1 [$c create oval $x $y [expr $x + $csize] [expr $y + $csize] -outline black -fill white] 00471 set cid [$c create oval [expr $x + 2] [expr $y + 2] [expr $x + $csize - 2] [expr $y + $csize - 2] -outline white -fill white] 00472 set tid [$c create text [expr $x + $csize + 10] [expr $y - 2] -text $txt -anchor nw] 00473 00474 $c bind $cid1 <Button-1> [list set $var $value] 00475 $c bind $cid <Button-1> [list set $var $value] 00476 $c bind $tid <Button-1> [list set $var $value] 00477 00478 set rbs($var,$value) [list $cid $command] 00479 00480 # Make the radiobutton look selected 00481 if {[set $var] eq $value} { 00482 $c itemconfigure $cid -fill black 00483 } 00484 00485 trace add variable $var write [list startup::handle_rb_var_change $c] 00486 00487 return $cid1 00488 00489 } 00490 00491 ###################################################################### 00492 # Handles any changes to the radiobutton variable. 00493 proc handle_rb_var_change {c name1 name2 op} { 00494 00495 variable rbs 00496 00497 lassign $rbs($name1,[set $name1]) cid command 00498 00499 if {$name2 ne ""} { 00500 toggle_radiobutton $c $cid $name1($name2) [set $name1($name2)] $command 00501 } else { 00502 toggle_radiobutton $c $cid $name1 [set $name1] $command 00503 } 00504 00505 } 00506 00507 ###################################################################### 00508 # Toggles the radiobutton. 00509 proc toggle_radiobutton {c id var value command} { 00510 00511 variable rbs 00512 00513 # Clear the radiobuttons 00514 foreach key [array name rbs $var,*] { 00515 $c itemconfigure [lindex $rbs($key) 0] -fill white 00516 } 00517 00518 # Make the item 00519 $c itemconfigure $id -fill black 00520 00521 # Execute the command 00522 if {$command ne ""} { 00523 uplevel #0 $command 00524 } 00525 00526 } 00527 00528 ###################################################################### 00529 # Create the checkbutton. 00530 proc make_checkbutton {c x y txt var command} { 00531 00532 set ssize 11 00533 00534 # Create the checkbutton 00535 set sid1 [$c create rectangle $x $y [expr $x + $ssize] [expr $y + $ssize] -outline black -fill white] 00536 set sid2 [$c create rectangle [expr $x + 2] [expr $y + 2] [expr $x + $ssize - 2] [expr $y + $ssize -2] -outline white -fill white] 00537 set tid [$c create text [expr $x + $ssize + 10] [expr $y - 2] -text $txt -anchor nw] 00538 00539 $c bind $sid1 <Button-1> [list startup::toggle_value $var] 00540 $c bind $sid2 <Button-1> [list startup::toggle_value $var] 00541 $c bind $tid <Button-1> [list startup::toggle_value $var] 00542 00543 # Make the checkbutton look selected 00544 if {[set $var]} { 00545 $c itemconfigure $sid2 -fill black 00546 } 00547 00548 trace add variable $var write [list startup::handle_cb_var_change $c $sid2 $command] 00549 00550 return $sid1 00551 00552 } 00553 00554 ###################################################################### 00555 # Toggles the given value 00556 proc toggle_value {var} { 00557 00558 set $var [expr [set $var] ^ 1] 00559 00560 } 00561 00562 ###################################################################### 00563 # Handles any changes to the checkbutton variable. 00564 proc handle_cb_var_change {c sid command name1 name2 op} { 00565 00566 if {$name2 ne ""} { 00567 toggle_checkbutton $c $sid "$name1\($name2\)" $command 00568 } else { 00569 toggle_checkbutton $c $sid $name1 $command 00570 } 00571 00572 } 00573 00574 ###################################################################### 00575 # Changes the state of the checkbutton. 00576 proc toggle_checkbutton {c id var command} { 00577 00578 set color [expr {[set $var] ? "black" : "white"}] 00579 00580 $c itemconfigure $id -fill $color 00581 00582 # Execute the command 00583 if {$command ne ""} { 00584 uplevel #0 $command 00585 } 00586 00587 } 00588 00589 } 00590