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
