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: themer.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 10/04/2013 00022 # Brief: Allows the user to customize, create, export and import themes. 00023 ###################################################################### 00024 00025 # msgcat::note Select "Tools / Theme Editor" to view window containing these strings 00026 00027 source [file join $::tke_dir lib bitmap.tcl] 00028 00029 namespace eval themer { 00030 00031 array set data { 00032 max_swatches 8 00033 copy_mode 0 00034 search 0 00035 theme_buffer {} 00036 } 00037 00038 if {[catch { ttk::spinbox .__tmp }]} { 00039 set bg [utils::get_default_background] 00040 set fg [utils::get_default_foreground] 00041 set data(sb) "spinbox" 00042 set data(sb_opts) "-relief flat -buttondownrelief flat -buttonuprelief flat -background $bg -foreground $fg" 00043 set data(sb_normal) "configure -state normal" 00044 set data(sb_disabled) "configure -state disabled" 00045 } else { 00046 set data(sb) "ttk::spinbox" 00047 set data(sb_opts) "" 00048 set data(sb_normal) "state !disabled" 00049 set data(sb_disabled) "state disabled" 00050 destroy .__tmp 00051 } 00052 00053 ###################################################################### 00054 # Returns the given color based on the embeddable color string. 00055 proc get_color {value} { 00056 00057 switch [llength [set values [split $value ,]]] { 00058 0 { return #ffffff } 00059 1 { return [lindex $values 0] } 00060 2 { return [utils::auto_adjust_color [lindex $values 0] [lindex $values 1] manual] } 00061 3 { return [utils::auto_mix_colors [lindex $values 0] [lindex $values 1] [lindex $values 2]] } 00062 } 00063 00064 } 00065 00066 ###################################################################### 00067 # Sets the given table cell color. 00068 proc set_cell_color {row color_str {color ""}} { 00069 00070 variable data 00071 00072 # Get the color 00073 if {$color eq ""} { 00074 set color [get_color $color_str] 00075 } 00076 00077 # Set the cell 00078 $data(widgets,cat) cellconfigure $row,value -text $color_str \ 00079 -background $color -foreground [utils::get_complementary_mono_color $color] 00080 00081 return $color 00082 00083 } 00084 00085 ###################################################################### 00086 # Displays the theme editor with the specified theme information. 00087 proc edit_current_theme {} { 00088 00089 variable data 00090 00091 # If we have not set the original_theme, set it to the current application theme 00092 if {![info exists data(original_theme)]} { 00093 set data(original_theme) [theme::get_current_theme] 00094 } 00095 00096 # Initialize the themer 00097 initialize 00098 00099 # Save the current theme 00100 set_current_theme_to $data(original_theme) 00101 00102 } 00103 00104 ###################################################################### 00105 # Applies the current settings to the current TKE session. 00106 proc apply_theme {} { 00107 00108 variable data 00109 00110 # Apply the updates to the theme 00111 theme::update_theme 00112 00113 # Update the background/foreground color of the description box 00114 $data(widgets,desc) configure -background [utils::get_default_background] -foreground [utils::get_default_foreground] 00115 00116 } 00117 00118 ###################################################################### 00119 # Checks to see if the current theme needs to be saved. If it has 00120 # changed since the last save, prompts the user for direction and saves 00121 # the theme if specified. Returns 1 if the save was handled (or no 00122 # save was necessary). Returns 0 if the user canceled the save operation. 00123 proc check_for_save {} { 00124 00125 # First, check to see if the current theme needs to be saved 00126 if {[theme_needs_saving]} { 00127 switch [tk_messageBox -parent .thmwin -icon question -message [msgcat::mc "Save theme changes?"] -detail [msgcat::mc "The current theme has unsaved changes."] -type yesnocancel -default yes] { 00128 yes { save_current_theme } 00129 cancel { return 0 } 00130 } 00131 } 00132 00133 return 1 00134 00135 } 00136 00137 ###################################################################### 00138 # Sets the title with the given information (including attribution 00139 # information from the current theme. 00140 proc set_title {modified} { 00141 00142 variable data 00143 00144 # Set the theme name/attribution string to the theme 00145 set theme_attr $data(curr_theme) 00146 00147 # Create the attribution portion of the title bar 00148 array set attr [theme::get_attributions] 00149 00150 if {[info exists attr(creator)]} { 00151 if {[info exists attr(website)]} { 00152 append theme_attr [format " (%s: %s, %s)" [msgcat::mc "By"] $attr(creator) $attr(website)] 00153 } else { 00154 append theme_attr [format " (%s: %s)" [msgcat::mc "By"] $attr(creator)] 00155 } 00156 } elseif {[info exists attr(website)]} { 00157 append theme_attr " ($attr(website))" 00158 } 00159 00160 # Finally, set the title bar 00161 wm title .thmwin [format "%s %s %s" [msgcat::mc "Theme Editor"] [expr {$modified ? "*" : "-"}] $theme_attr] 00162 00163 } 00164 00165 ###################################################################### 00166 # Sets the current theme to the given name and updates the title bar. 00167 proc set_current_theme_to {theme} { 00168 00169 variable data 00170 00171 # Set the variable value 00172 set data(curr_theme) $theme 00173 00174 # Update the title bar 00175 set_title 0 00176 00177 } 00178 00179 ###################################################################### 00180 # This should be called whenever the current theme has been modified. 00181 proc set_theme_modified {} { 00182 00183 variable data 00184 00185 # If the open frame is shown, show the normal button bar 00186 end_open_frame 00187 00188 # Update the title bar 00189 set_title 1 00190 00191 } 00192 00193 ###################################################################### 00194 # Returns true if the current theme needs to be saved; otherwise, returns 0. 00195 proc theme_needs_saving {} { 00196 00197 return [expr {[winfo exists .thmwin] && ([string first "*" [wm title .thmwin]] != -1)}] 00198 00199 } 00200 00201 ###################################################################### 00202 # Creates the UI for the importer, automatically populating it with 00203 # the default values. 00204 proc create {} { 00205 00206 variable data 00207 00208 if {![info exists data(image,plus)]} { 00209 set name [file join $::tke_dir lib images plus.bmp] 00210 set data(image,plus) [image create bitmap -file $name -maskfile $name -foreground grey] 00211 } 00212 00213 if {![winfo exists .thmwin]} { 00214 00215 toplevel .thmwin 00216 wm title .thmwin [msgcat::mc "Theme Editor"] 00217 wm geometry .thmwin 800x650 00218 wm transient .thmwin . 00219 wm protocol .thmwin WM_DELETE_WINDOW [list themer::close_window 0] 00220 00221 # Add the swatch panel 00222 set data(widgets,sf) [ttk::labelframe .thmwin.sf -text [msgcat::mc "Swatch"]] 00223 pack [set data(widgets,plus) [ttk::frame .thmwin.sf.plus]] -side left -padx 2 -pady 2 00224 pack [ttk::button .thmwin.sf.plus.b -style BButton -image $data(image,plus) -command [list themer::add_swatch]] 00225 set data(widgets,plus_text) [ttk::label .thmwin.sf.plus.l -text ""] 00226 00227 ttk::panedwindow .thmwin.pw -orient horizontal 00228 00229 # Add the categories panel 00230 .thmwin.pw add [ttk::labelframe .thmwin.pw.lf -text [msgcat::mc "Categories"]] 00231 00232 set data(widgets,search) [wmarkentry::wmarkentry .thmwin.pw.lf.search -watermark [msgcat::mc "Search"] -validate key -validatecommand [list themer::perform_search %P]] 00233 00234 bind [$data(widgets,search) entrytag] <Escape> [list themer::close_search] 00235 bind [$data(widgets,search) entrytag] <Return> [list themer::select_search] 00236 00237 set data(widgets,cat) [tablelist::tablelist .thmwin.pw.lf.tbl \ 00238 -columns [list 0 [msgcat::mc "Options"] 0 [msgcat::mc "Value"] 0 {} 0 {}] -treecolumn 0 -exportselection 0 -width 0 \ 00239 -borderwidth 0 -highlightthickness 0 \ 00240 -labelcommand [list themer::show_filter_menu] \ 00241 -yscrollcommand { .thmwin.pw.lf.vb set } \ 00242 ] 00243 scroller::scroller .thmwin.pw.lf.vb -orient vertical -command { .thmwin.pw.lf.tbl yview } 00244 00245 $data(widgets,cat) columnconfigure 0 -name opt 00246 $data(widgets,cat) columnconfigure 1 -name value -formatcommand [list themer::format_category_value] 00247 $data(widgets,cat) columnconfigure 2 -name category -hide 1 00248 $data(widgets,cat) columnconfigure 3 -name desc -hide 1 00249 00250 bind $data(widgets,cat) <<TablelistSelect>> [list themer::handle_category_selection] 00251 00252 set data(widgets,copy_frame) [ttk::frame .thmwin.pw.lf.cf] 00253 ttk::button $data(widgets,copy_frame).copy -text [msgcat::mc "Copy"] -width 6 -command [list themer::copy_to_buffer] 00254 ttk::button $data(widgets,copy_frame).cancel -text [msgcat::mc "Done"] -width 6 -command [list themer::close_copy] 00255 00256 pack $data(widgets,copy_frame).copy -side left -padx 2 -pady 2 00257 pack $data(widgets,copy_frame).cancel -side right -padx 2 -pady 2 00258 00259 grid rowconfigure .thmwin.pw.lf 2 -weight 1 00260 grid columnconfigure .thmwin.pw.lf 0 -weight 1 00261 grid .thmwin.pw.lf.search -row 0 -column 0 -sticky ew -columnspan 2 00262 grid .thmwin.pw.lf.tbl -row 1 -column 0 -sticky news -rowspan 2 00263 grid [.thmwin.pw.lf.tbl cornerpath] -row 1 -column 1 -sticky news 00264 grid .thmwin.pw.lf.vb -row 2 -column 1 -sticky ns 00265 grid .thmwin.pw.lf.cf -row 3 -column 0 -sticky ew -columnspan 2 00266 00267 # Hide the search and copy frames 00268 grid remove $data(widgets,search) 00269 grid remove $data(widgets,copy_frame) 00270 00271 # Add the right paned window 00272 .thmwin.pw add [ttk::frame .thmwin.pw.rf] -weight 1 00273 00274 # Add the detail frame 00275 set data(widgets,df) [ttk::labelframe .thmwin.pw.rf.df -text [msgcat::mc "Details"]] 00276 00277 # Add the description frame 00278 ttk::labelframe .thmwin.pw.rf.def -text [msgcat::mc "Description"] 00279 set data(widgets,desc) [text .thmwin.pw.rf.def.t -height 4 -relief flat \ 00280 -background [utils::get_default_background] -foreground [utils::get_default_foreground] \ 00281 -borderwidth 0 -highlightthickness 0 -wrap word -state disabled \ 00282 -yscrollcommand { utils::set_yscrollbar .thmwin.pw.rf.def.vb }] 00283 scroller::scroller .thmwin.pw.rf.def.vb -orient vertical -command { .thmwin.pw.rf.def.t yview } 00284 00285 theme::register_widget .thmwin.pw.rf.def.vb misc_scrollbar 00286 00287 grid rowconfigure .thmwin.pw.rf.def 0 -weight 1 00288 grid columnconfigure .thmwin.pw.rf.def 0 -weight 1 00289 grid .thmwin.pw.rf.def.t -row 0 -column 0 -sticky news 00290 grid .thmwin.pw.rf.def.vb -row 0 -column 1 -sticky ns 00291 00292 pack .thmwin.pw.rf.df -fill both -expand yes 00293 pack .thmwin.pw.rf.def -fill x 00294 00295 # Get the width of all buttons 00296 set bwidth [msgcat::mcmax "Open" "Save" "Create" "Save" "Cancel" "Preview" "Done" "Import" "Export"] 00297 00298 # Create the button frame 00299 set data(widgets,bf) [ttk::frame .thmwin.bf] 00300 set data(widgets,open) [ttk::button .thmwin.bf.open -style BButton -text [msgcat::mc "Open"] -width $bwidth -command [list themer::start_open_frame]] 00301 set data(widgets,preview) [ttk::button .thmwin.bf.preview -style BButton -text [msgcat::mc "Preview"] -width $bwidth -command [list themer::apply_theme]] 00302 set data(widgets,save) [ttk::button .thmwin.bf.save -style BButton -text [msgcat::mc "Save"] -width $bwidth -command [list themer::start_save_frame]] 00303 00304 bind $data(widgets,save) <Button-$::right_click> [list themer::save_current_theme] 00305 00306 grid columnconfigure .thmwin.bf 0 -weight 1 00307 grid columnconfigure .thmwin.bf 1 -weight 1 00308 grid columnconfigure .thmwin.bf 2 -weight 1 00309 grid $data(widgets,open) -row 0 -column 0 -sticky w -padx 2 -pady 2 00310 grid $data(widgets,preview) -row 0 -column 1 -sticky ns -padx 2 -pady 2 00311 grid $data(widgets,save) -row 0 -column 2 -sticky e -padx 2 -pady 2 00312 00313 # Create the open frame 00314 set data(widgets,of) [ttk::frame .thmwin.of] 00315 ttk::button .thmwin.of.import -style BButton -text [msgcat::mc "Import"] -width $bwidth -command [list themer::import] 00316 menu .thmwin.of.mnu -tearoff 0 -postcommand [list themer::add_menu_themes .thmwin.of.mnu] 00317 set data(widgets,open_mb) [ttk::menubutton .thmwin.of.mb -direction above -text [msgcat::mc "Choose Theme"] -menu .thmwin.of.mnu] 00318 ttk::button .thmwin.of.close -style BButton -text [msgcat::mc "Done"] -width $bwidth -command [list themer::end_open_frame] 00319 00320 grid columnconfigure .thmwin.of 0 -weight 1 00321 grid columnconfigure .thmwin.of 1 -weight 1 00322 grid columnconfigure .thmwin.of 2 -weight 1 00323 grid .thmwin.of.import -row 0 -column 0 -sticky w -padx 2 -pady 2 00324 grid .thmwin.of.mb -row 0 -column 1 -sticky ns -padx 2 -pady 2 00325 grid .thmwin.of.close -row 0 -column 2 -sticky e -padx 2 -pady 2 00326 00327 # Create the save frame 00328 set data(widgets,wf) [ttk::frame .thmwin.wf] 00329 ttk::button .thmwin.wf.export -style BButton -text [msgcat::mc "Export"] -width $bwidth -command [list themer::export] 00330 ttk::label .thmwin.wf.l -text [msgcat::mc "Save As:"] 00331 if {[::tke_development] && ![namespace exists ::freewrap]} { 00332 set mb_width [expr [msgcat::mcmax "User Directory" "Installation Directory"] - 5] 00333 set data(widgets,save_mb) [ttk::menubutton .thmwin.wf.mb -width $mb_width -menu [menu .thmwin.wf.mb_menu -tearoff 0]] 00334 .thmwin.wf.mb_menu add command -label [msgcat::mc "User Directory"] -command [list themer::save_to_directory "user"] 00335 .thmwin.wf.mb_menu add command -label [msgcat::mc "Installation Directory"] -command [list themer::save_to_directory "install"] 00336 } 00337 set data(widgets,save_cb) [ttk::combobox .thmwin.wf.cb -width 30 -postcommand [list themer::add_combobox_themes .thmwin.wf.cb]] 00338 set data(widgets,save_b) [ttk::button .thmwin.wf.save -style BButton -text [msgcat::mc "Save"] -width $bwidth -command [list themer::save_theme]] 00339 ttk::button .thmwin.wf.cancel -style BButton -text [msgcat::mc "Cancel"] -width $bwidth -command [list themer::end_save_frame] 00340 00341 pack .thmwin.wf.cancel -side right -padx 2 -pady 2 00342 pack .thmwin.wf.save -side right -padx 2 -pady 2 00343 pack .thmwin.wf.cb -side right -padx 2 -pady 2 00344 if {[::tke_development] && ![namespace exists ::freewrap]} { 00345 pack .thmwin.wf.mb -side right -padx 2 -pady 2 00346 } 00347 pack .thmwin.wf.l -side right -padx 2 -pady 2 00348 pack .thmwin.wf.export -side left -padx 2 -pady 2 00349 00350 pack .thmwin.sf -fill x 00351 pack .thmwin.pw -fill both -expand yes 00352 pack .thmwin.bf -fill x 00353 00354 # Create the detail panels 00355 create_detail_relief 00356 create_detail_number 00357 create_detail_color 00358 create_detail_image 00359 create_detail_treestyle 00360 00361 # Create the filter menu 00362 create_table_menu 00363 00364 } 00365 00366 } 00367 00368 ###################################################################### 00369 # Sets the save directory type. 00370 proc save_to_directory {type} { 00371 00372 variable data 00373 00374 set data(save_directory) $type 00375 00376 if {[info exists data(widgets,save_mb)]} { 00377 switch $type { 00378 user { set lbl [msgcat::mc "User Directory"] } 00379 install { set lbl [msgcat::mc "Installation Directory"] } 00380 } 00381 $data(widgets,save_mb) configure -text $lbl 00382 $data(widgets,save_b) configure -state normal 00383 } 00384 00385 } 00386 00387 ###################################################################### 00388 # Returns true if the themer window exists; otherwise, returns false. 00389 proc window_exists {} { 00390 00391 return [winfo exists .thmwin] 00392 00393 } 00394 00395 00396 ###################################################################### 00397 # Called whenever the theme editor window is closed. 00398 proc close_window {on_exit} { 00399 00400 variable data 00401 00402 # If the theme window is not currently open, there's nothing left to do 00403 if {![winfo exists .thmwin]} { 00404 return 00405 } 00406 00407 # Save the theme if it needs saving and the user agrees to it 00408 if {[theme_needs_saving]} { 00409 if {[tk_messageBox -parent .thmwin -icon question -message [msgcat::mc "Save theme changes?"] -detail [msgcat::mc "The current theme has unsaved changes."] -type yesno -default yes] eq "yes"} { 00410 save_current_theme 00411 } 00412 } 00413 00414 # If we are close because the application is being quit, don't bother with the rest 00415 if {$on_exit} { 00416 return 00417 } 00418 00419 # Delete the swatch images 00420 foreach swatch [winfo children $data(widgets,sf)] { 00421 lappend images [$swatch.b cget -image] 00422 } 00423 image delete {*}$images 00424 00425 # Delete the data array 00426 array unset data *,* 00427 unset data(swatch_index) 00428 00429 # Destroy the window 00430 destroy .thmwin 00431 00432 # Cause the original theme to be reloaded in the UI 00433 theme::load_theme [themes::get_file $data(original_theme)] 00434 unset data(original_theme) 00435 00436 } 00437 00438 ###################################################################### 00439 # Closes the button frame and displays the open frame. 00440 proc start_open_frame {} { 00441 00442 variable data 00443 00444 pack forget $data(widgets,bf) 00445 pack $data(widgets,of) -fill x 00446 00447 } 00448 00449 ###################################################################### 00450 # Closes the open frame and redisplays the button frame. 00451 proc end_open_frame {} { 00452 00453 variable data 00454 00455 pack forget $data(widgets,of) 00456 pack $data(widgets,bf) -fill x 00457 00458 } 00459 00460 ###################################################################### 00461 # Closes the button frame and displays the save frame. 00462 proc start_save_frame {} { 00463 00464 variable data 00465 00466 # Display the save panel 00467 pack forget $data(widgets,bf) 00468 pack $data(widgets,wf) -fill x 00469 00470 # Set the combobox data to the current theme name 00471 $data(widgets,save_cb) set $data(curr_theme) 00472 00473 # Set the save to directory status 00474 if {[::tke_development] && ![namespace exists ::freewrap]} { 00475 if {[catch { themes::get_file $data(curr_theme) } fname]} { 00476 $data(widgets,save_mb) configure -text [msgcat::mc "Select Directory"] 00477 $data(widgets,save_b) configure -state disabled 00478 } elseif {[file dirname $fname] eq [file join $::tke_dir data themes]} { 00479 save_to_directory "install" 00480 } else { 00481 save_to_directory "user" 00482 } 00483 } else { 00484 save_to_directory "user" 00485 } 00486 00487 } 00488 00489 ###################################################################### 00490 # Saves the current theme using selected name. 00491 proc save_theme {} { 00492 00493 variable data 00494 00495 # Get the theme name from the combobox 00496 set theme_name [$data(widgets,save_cb) get] 00497 00498 if {$data(save_directory) eq "user"} { 00499 set theme_file [file join [themes::get_user_directory] $theme_name $theme_name.tketheme] 00500 } else { 00501 set theme_file [file join $::tke_dir data themes $theme_name.tketheme] 00502 } 00503 00504 # Write the theme to disk 00505 if {[catch { theme::write_tketheme $data(widgets,cat) $theme_file } rc]} { 00506 tk_messageBox -parent .thmwin -icon error -default ok -type ok -message [msgcat::mc "Save error"] -detail $rc 00507 return 00508 } 00509 00510 # Reload the themes 00511 themes::load 00512 00513 # Set the current theme 00514 set_current_theme_to $theme_name 00515 00516 # End the save frame 00517 end_save_frame 00518 00519 # Refresh the detail information (in case it has changed) 00520 handle_category_selection 00521 00522 } 00523 00524 ###################################################################### 00525 # Performs a save of the current theme to disk. 00526 proc save_current_theme {} { 00527 00528 variable data 00529 00530 # Get the current theme file 00531 if {[::tke_development] && ![namespace exists ::freewrap]} { 00532 if {[catch { themes::get_file $data(curr_theme) } theme_file]} { 00533 start_save_frame 00534 return 00535 } 00536 } else { 00537 set theme_file [file join [themes::get_user_directory] $data(curr_theme) $data(curr_theme).tketheme] 00538 file mkdir [file dirname $theme_file] 00539 } 00540 00541 # Write the theme to disk 00542 if {[catch { theme::write_tketheme $data(widgets,cat) $theme_file } rc]} { 00543 tk_messageBox -parent .thmwin -icon error -default ok -type ok -message [msgcat::mc "Save error"] -detail $rc 00544 return 00545 } 00546 00547 # Indicate that the theme was saved 00548 set_title 0 00549 00550 # Refresh the detail information (in case it has changed) 00551 handle_category_selection 00552 00553 } 00554 00555 ###################################################################### 00556 # Closes the save frame and redisplays the button frame. 00557 proc end_save_frame {} { 00558 00559 variable data 00560 00561 # Redisplay the button frame 00562 pack forget $data(widgets,wf) 00563 pack $data(widgets,bf) -fill x 00564 00565 } 00566 00567 ###################################################################### 00568 # Formats the category value. 00569 proc format_category_value {value} { 00570 00571 variable data 00572 00573 lassign [$data(widgets,cat) formatinfo] key row col 00574 00575 # Category identifier and images should return the empty string; otherwise, return the value 00576 if {([$data(widgets,cat) parentkey $row] eq "root") || 00577 ([$data(widgets,cat) cellcget $row,category -text] eq "images")} { 00578 return "" 00579 } else { 00580 return $value 00581 } 00582 00583 } 00584 00585 ###################################################################### 00586 # Returns the current row number. 00587 proc get_current_row {} { 00588 00589 variable data 00590 00591 # Get the category table 00592 set w $data(widgets,cat) 00593 00594 # Get the X and Y screen coordinates of the cursor 00595 lassign [winfo pointerxy .thmwin] x y 00596 00597 set x [expr $x - [winfo rootx $w]] 00598 set y [expr $y - [winfo rooty $w]] 00599 00600 return [$w index @$x,$y] 00601 00602 } 00603 00604 ###################################################################### 00605 # Handle a selection of the category table selection when we are in 00606 # copy mode. 00607 proc handle_copy_selection {} { 00608 00609 variable data 00610 00611 # Get the current row 00612 set current [get_current_row] 00613 00614 # If the current row is a category, select/deselect the entire category 00615 if {[$data(widgets,cat) parentkey $current] eq "root"} { 00616 00617 # Get the child rows 00618 set children [$data(widgets,cat) childkeys $current] 00619 00620 # Clear the category value field 00621 $data(widgets,cat) cellselection clear $current,value 00622 00623 # If the selection includes the current row, select the children 00624 if {[$data(widgets,cat) selection includes $current]} { 00625 00626 # Set the child rows 00627 $data(widgets,cat) selection set $children 00628 foreach index $children { 00629 $data(widgets,cat) cellselection clear $index,value 00630 } 00631 00632 # Display the last child row 00633 $data(widgets,cat) see [lindex $children end] 00634 00635 # Otherwise, deselect the children 00636 } else { 00637 $data(widgets,cat) selection clear $children 00638 } 00639 00640 } 00641 00642 } 00643 00644 ###################################################################### 00645 # Handles a change to the category selection. 00646 proc handle_category_selection {} { 00647 00648 variable data 00649 00650 # Clear the details frame 00651 catch { pack forget {*}[pack slaves $data(widgets,df)] } 00652 00653 # If we are currently in copy mode, avoid displaying the details frame 00654 if {$data(copy_mode)} { 00655 handle_copy_selection 00656 return 00657 } 00658 00659 # Get the currently selected row 00660 if {([set row [$data(widgets,cat) curselection]] ne "") && ([set parent [$data(widgets,cat) parentkey $row]] ne "root")} { 00661 00662 # Get the row values 00663 set data(row) $row 00664 set data(opt) [$data(widgets,cat) cellcget $row,opt -text] 00665 set data(category) [$data(widgets,cat) cellcget $row,category -text] 00666 set value [$data(widgets,cat) cellcget $row,value -text] 00667 00668 lassign [theme::get_type $data(category) $data(opt)] type values 00669 00670 # Remove the selection from the color cell 00671 $data(widgets,cat) cellselection clear $row,value 00672 00673 switch $type { 00674 image { 00675 switch [llength $value] { 00676 4 { detail_show_image photo $value } 00677 6 { detail_show_image mono $value } 00678 8 { detail_show_image dual $value } 00679 } 00680 } 00681 relief { 00682 detail_show_relief $value $values 00683 } 00684 number { 00685 set title [string totitle [string map {{_} { }} [expr {([string index $data(opt) 0] eq "-") ? [string range $data(opt) 1 end] : $data(opt)}]]] 00686 detail_show_number $title $value {*}$values 00687 } 00688 treestyle { 00689 detail_show_treestyle $value 00690 } 00691 color { 00692 if {[theme::meta_do exists $data(category) $data(opt)]} { 00693 detail_show_color [theme::meta_do get $data(category) $data(opt)] 00694 } else { 00695 detail_show_color $value 00696 } 00697 } 00698 } 00699 00700 } 00701 00702 # Show the option description 00703 $data(widgets,desc) configure -state normal 00704 $data(widgets,desc) delete 1.0 end 00705 $data(widgets,desc) insert end [$data(widgets,cat) cellcget $row,desc -text] 00706 $data(widgets,desc) configure -state disabled 00707 00708 } 00709 00710 ###################################################################### 00711 # Adds the available themes to the given menu. 00712 proc add_menu_themes {mnu} { 00713 00714 variable data 00715 00716 # Clear the menu 00717 $mnu delete 0 end 00718 00719 # Add all available themes (in alphabetical order) to the menu 00720 foreach theme_name [themes::get_visible_themes] { 00721 $mnu add command -label $theme_name -command [list themer::preview_theme $theme_name] 00722 } 00723 00724 } 00725 00726 ###################################################################### 00727 # Previews the given theme. 00728 proc preview_theme {theme} { 00729 00730 variable data 00731 00732 # If we have not set the original_theme, set it to the current application theme 00733 if {![info exists data(original_theme)]} { 00734 set data(original_theme) [theme::get_current_theme] 00735 } 00736 00737 # Save the current theme 00738 if {[check_for_save]} { 00739 00740 # Reads the contents of the given theme 00741 theme::read_tketheme [themes::get_file $theme] 00742 00743 # Display the theme contents in the UI 00744 initialize 00745 00746 # Set the current theme to the given theme 00747 set_current_theme_to $theme 00748 00749 # Apply the theme 00750 apply_theme 00751 00752 # Set the menubutton text to the selected theme 00753 $data(widgets,open_mb) configure -text [file rootname [file tail $theme]] 00754 00755 } 00756 00757 } 00758 00759 ###################################################################### 00760 # Add the available themes to the combobox. 00761 proc add_combobox_themes {cb} { 00762 00763 variable data 00764 00765 # Set the combobox list to the list of theme values 00766 $data(widgets,save_cb) configure -values [themes::get_all_themes] 00767 00768 } 00769 00770 ###################################################################### 00771 # Creates the relief detail panel. 00772 proc create_detail_relief {} { 00773 00774 variable data 00775 00776 # Create the frame 00777 set data(widgets,relief) [ttk::frame $data(widgets,df).rf] 00778 00779 # Create the relief widgets 00780 ttk::frame $data(widgets,relief).f 00781 ttk::label $data(widgets,relief).f.l -text [msgcat::mc "Relief: "] 00782 set data(widgets,relief_mb) [ttk::menubutton $data(widgets,relief).f.mb -width -20 \ 00783 -menu [set data(widgets,relief_menu) [menu $data(widgets,relief).menu -tearoff 0]]] 00784 00785 # Pack the widgets 00786 pack $data(widgets,relief).f.l -side left -padx 2 -pady 2 00787 pack $data(widgets,relief).f.mb -side left -padx 2 -pady 2 00788 00789 pack $data(widgets,relief).f -padx 2 -pady 2 00790 00791 } 00792 00793 ###################################################################### 00794 # Creates the number detail panel. 00795 proc create_detail_number {} { 00796 00797 variable data 00798 00799 # Create the frame 00800 set data(widgets,number) [ttk::frame $data(widgets,df).nf] 00801 00802 # Create the widgets 00803 ttk::label $data(widgets,number).f 00804 set data(widgets,number_lbl) [ttk::label $data(widgets,number).f.l -text [msgcat::mc "Value: "]] 00805 set data(widgets,number_sb) [ttk::spinbox $data(widgets,number).f.sb -command [list themer::handle_number_change]] 00806 00807 # Pack the widgets 00808 pack $data(widgets,number).f.l -side left -padx 2 -pady 2 00809 pack $data(widgets,number).f.sb -side left -padx 2 -pady 2 00810 00811 pack $data(widgets,number).f -padx 2 -pady 2 00812 00813 } 00814 00815 ###################################################################### 00816 # Creates the color detail panel. 00817 proc create_detail_color {} { 00818 00819 variable data 00820 00821 # Create the frame 00822 set data(widgets,color) [ttk::frame $data(widgets,df).cf] 00823 00824 # Create the canvas 00825 set data(widgets,color_canvas) [canvas $data(widgets,color).c -relief flat -width 60 -height 40] 00826 set data(widgets,color_base) [$data(widgets,color_canvas) create rectangle 15 5 48 36 -width 0] 00827 set data(widgets,color_mod) [$data(widgets,color_canvas) create rectangle 31 5 48 36 -width 0] 00828 00829 # Create color modification menubutton 00830 menu $data(widgets,color).base_mnu -tearoff 0 -postcommand [list themer::post_base_color_menu $data(widgets,color).base_mnu] 00831 ttk::menubutton $data(widgets,color).mb -text [msgcat::mc "Change Base Color"] -menu $data(widgets,color).base_mnu 00832 00833 # Create the modification frames 00834 ttk::labelframe $data(widgets,color).mod -text [msgcat::mc "Modifications"] 00835 grid [ttk::radiobutton $data(widgets,color).mod.lnone -text [msgcat::mc "None"] -value none -variable themer::data(mod) -command [list themer::color_mod_changed none]] -row 0 -column 0 -sticky w -padx 2 -pady 2 00836 set i 1 00837 foreach {lbl mod max} [list [msgcat::mc "Value"] v 127 "R" r 255 "G" g 255 "B" b 255] { 00838 grid [ttk::radiobutton $data(widgets,color).mod.l$mod -text "$lbl:" -value $mod -variable themer::data(mod) -command [list themer::color_mod_changed $mod]] -row $i -column 0 -sticky w -padx 2 -pady 2 00839 grid [set data(widgets,color_${mod}_scale) [ttk::scale $data(widgets,color).mod.s$mod -orient horizontal -from 0 -to $max -command [list themer::detail_scale_change $mod]]] -row $i -column 1 -padx 2 -pady 2 00840 grid [set data(widgets,color_${mod}_entry) [$data(sb) $data(widgets,color).mod.e$mod {*}$data(sb_opts) -width 3 -from 0 -to $max -command [list themer::detail_spinbox_change $mod]]] -row $i -column 2 -padx 2 -pady 2 00841 incr i 00842 } 00843 00844 pack $data(widgets,color_canvas) -pady 5 00845 pack $data(widgets,color).mb -pady 2 00846 pack $data(widgets,color).mod -pady 2 00847 00848 } 00849 00850 ###################################################################### 00851 # Create the image detail panel. 00852 proc create_detail_image {} { 00853 00854 variable data 00855 00856 set data(widgets,image) [ttk::frame $data(widgets,df).if] 00857 00858 # Create and pack the image selection menubutton 00859 pack [set data(widgets,image_mb) [ttk::menubutton $data(widgets,df).if.mb -menu [menu $data(widgets,image).mnu -tearoff 0]]] -padx 2 -pady 2 00860 00861 # Populate the menu 00862 $data(widgets,image).mnu add radiobutton -label [msgcat::mc "One-Color Bitmap"] -value mono -variable themer::data(image_type) -command [list themer::show_image_frame mono] 00863 $data(widgets,image).mnu add radiobutton -label [msgcat::mc "Two-Color Bitmap"] -value dual -variable themer::data(image_type) -command [list themer::show_image_frame dual] 00864 $data(widgets,image).mnu add radiobutton -label [msgcat::mc "GIF Photo"] -value photo -variable themer::data(image_type) -command [list themer::show_image_frame photo] 00865 00866 # Create mono frame 00867 set data(widgets,image_mf) [ttk::frame $data(widgets,image).mf] 00868 grid [set data(widgets,image_mf_bm) [bitmap::create $data(widgets,image_mf).bm mono]] -row 0 -column 0 -sticky news -padx 2 -pady 2 -columnspan 2 00869 grid [ttk::button $data(widgets,image_mf).di -text [msgcat::mc "Import Bitmap Data"] -command [list bitmap::import $data(widgets,image_mf_bm) 3]] -row 1 -column 0 -sticky news -padx 2 -pady 2 00870 grid [ttk::button $data(widgets,image_mf).de -text [msgcat::mc "Export Bitmap Data"] -command [list bitmap::export $data(widgets,image_mf_bm) data]] -row 1 -column 1 -sticky news -padx 2 -pady 2 00871 00872 bind $data(widgets,image_mf_bm) <<BitmapChanged>> [list themer::handle_bitmap_changed %d] 00873 00874 # Create dual frame 00875 set data(widgets,image_df) [ttk::frame $data(widgets,image).df] 00876 grid [set data(widgets,image_df_bm) [bitmap::create $data(widgets,image_df).bm dual]] -row 0 -column 0 -padx 2 -pady 2 -columnspan 2 00877 grid [ttk::button $data(widgets,image_df).di -text [msgcat::mc "Import BMP Data"] -command [list bitmap::import $data(widgets,image_df_bm) 1]] -row 1 -column 0 -sticky news -padx 2 -pady 2 00878 grid [ttk::button $data(widgets,image_df).mi -text [msgcat::mc "Import BMP Mask"] -command [list bitmap::import $data(widgets,image_df_bm) 2]] -row 2 -column 0 -sticky news -padx 2 -pady 2 00879 grid [ttk::button $data(widgets,image_df).de -text [msgcat::mc "Export BMP Data"] -command [list bitmap::export $data(widgets,image_df_bm) data]] -row 1 -column 1 -sticky news -padx 2 -pady 2 00880 grid [ttk::button $data(widgets,image_df).me -text [msgcat::mc "Export BMP Mask"] -command [list bitmap::export $data(widgets,image_df_bm) mask]] -row 2 -column 1 -sticky news -padx 2 -pady 2 00881 00882 bind $data(widgets,image_df_bm) <<BitmapChanged>> [list themer::handle_bitmap_changed %d] 00883 00884 # Create photo frame 00885 set data(widgets,image_pf) [ttk::frame $data(widgets,image).pf] 00886 set data(widgets,image_pf_mb_dir) [ttk::menubutton $data(widgets,image).pf.mb -menu [menu $data(widgets,image).pf.mnu -tearoff 0]] 00887 set data(widgets,image_pf_tl_file) [tablelist::tablelist $data(widgets,image).pf.tl \ 00888 -columns {0 {} center 0 {} center 0 {} center} -showlabels 0 -selecttype cell -stretch all \ 00889 -borderwidth 0 -highlightthickness 0 \ 00890 -yscrollcommand [list $data(widgets,image).pf.vb set] -exportselection 0 \ 00891 ] 00892 scroller::scroller $data(widgets,image).pf.vb -orient vertical -command [list $data(widgets,image_pf_tl_file) yview] 00893 00894 theme::register_widget $data(widgets,image).pf.vb misc_scrollbar 00895 00896 # Configure the table columns 00897 for {set i 0} {$i < 3} {incr i} { 00898 $data(widgets,image_pf_tl_file) columnconfigure $i -formatcommand [list themer::format_image_cell] -editable 0 -width -100 -maxwidth -100 00899 } 00900 00901 # Handle any tablelist selections 00902 bind $data(widgets,image_pf_tl_file) <<TablelistSelect>> [list themer::handle_image_select %W %x %y] 00903 00904 grid rowconfigure $data(widgets,image_pf) 1 -weight 1 00905 grid columnconfigure $data(widgets,image_pf) 0 -weight 1 00906 grid $data(widgets,image_pf).mb -row 0 -column 0 -sticky ew -padx 2 -pady 2 00907 grid $data(widgets,image_pf).tl -row 1 -column 0 -sticky news -padx 2 -pady 2 00908 grid $data(widgets,image_pf).vb -row 1 -column 1 -sticky ns -padx 2 -pady 2 00909 00910 # Populate the photo menus 00911 $data(widgets,image).pf.mnu add command -label [msgcat::mc "Installation Directory"] -command [list themer::image_photo_dir install *.gif] 00912 $data(widgets,image).pf.mnu add command -label [msgcat::mc "User Directory"] -command [list themer::image_photo_dir user *.gif] 00913 $data(widgets,image).pf.mnu add separator 00914 $data(widgets,image).pf.mnu add command -label [msgcat::mc "Custom Directory"] -command [list themer::image_photo_dir custom *.gif] 00915 00916 } 00917 00918 ###################################################################### 00919 # Handles formatting an cell in the image table. 00920 proc format_image_cell {value} { 00921 00922 return "" 00923 00924 } 00925 00926 ###################################################################### 00927 # Handles a selection in the image table. 00928 proc handle_image_select {W x y} { 00929 00930 variable data 00931 00932 # Get the selected cell 00933 set cell [$data(widgets,image_pf_tl_file) curcellselection] 00934 00935 # Set the tablelist data and indicate that the theme has changed 00936 if {![catch { $data(widgets,image_pf_tl_file) cellcget $cell -text } value] && ($value ne "")} { 00937 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $value 00938 set_theme_modified 00939 } 00940 00941 } 00942 00943 ###################################################################### 00944 # Gets all of the GIF photos from 00945 proc image_photo_dir {type pattern {fname ""}} { 00946 00947 variable data 00948 00949 switch $type { 00950 install { 00951 set dirname [msgcat::mc "Installation Directory"] 00952 set inames [utils::glob_install [file join $::tke_dir lib images] $pattern] 00953 } 00954 user { 00955 set dirname [msgcat::mc "User Directory"] 00956 set inames [glob -nocomplain -directory [file join [themes::get_user_directory] [theme::get_current_theme]] $pattern] 00957 } 00958 custom { 00959 if {$fname eq ""} { 00960 if {[set dir [tk_chooseDirectory -parent .thmwin]] eq ""} { 00961 return 00962 } 00963 } else { 00964 set dir [file dirname $fname] 00965 set fname [file tail $fname] 00966 } 00967 set dirname $dir 00968 set type $dir 00969 set inames [glob -nocomplain -directory $dir $pattern] 00970 } 00971 } 00972 00973 # Set the directory menubutton text 00974 $data(widgets,image_pf_mb_dir) configure -text $dirname 00975 00976 # Delete any previous images 00977 if {[$data(widgets,image_pf_tl_file) size] > 0} { 00978 foreach value [$data(widgets,image_pf_tl_file) getcells 0,0 last] { 00979 array set value_array $value 00980 catch { image delete img_[file rootname $value_array(file)] } 00981 array unset value_array $value 00982 } 00983 $data(widgets,image_pf_tl_file) delete 0 end 00984 } 00985 00986 # Make the tablelist visible 00987 grid $data(widgets,image_pf_tl_file) 00988 00989 # Get all of the files in the directory that match the given file pattern 00990 set i 0 00991 set match_cell "" 00992 foreach iname $inames { 00993 if {[expr $i % 3] == 0} { 00994 $data(widgets,image_pf_tl_file) insert end [list [list] [list] [list]] 00995 } 00996 set cell [expr $i / 3],[expr $i % 3] 00997 set img [image create photo img_[file rootname [file tail $iname]] -file $iname] 00998 $data(widgets,image_pf_tl_file) cellconfigure $cell -text [list dir $type file [file tail $iname]] -image $img 00999 if {[file tail $iname] eq $fname} { 01000 set match_cell $cell 01001 } 01002 incr i 01003 } 01004 01005 # Set the filename menubutton text 01006 if {$match_cell ne ""} { 01007 $data(widgets,image_pf_tl_file) cellselection set $match_cell 01008 $data(widgets,image_pf_tl_file) seecell $match_cell 01009 } 01010 01011 } 01012 01013 ###################################################################### 01014 # Called whenever the user updates the bitmap widget. 01015 proc handle_bitmap_changed {bm_data} { 01016 01017 variable data 01018 01019 # Set the tablelist data 01020 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $bm_data 01021 01022 # Specify that the apply button should be enabled 01023 set_theme_modified 01024 01025 } 01026 01027 ###################################################################### 01028 # Creates the treestyle detail frame. 01029 proc create_detail_treestyle {} { 01030 01031 variable data 01032 01033 # Create the tree style detail frame 01034 set data(widgets,treestyle) [ttk::frame $data(widgets,df).tf] 01035 01036 # Create the treestyle widgets 01037 ttk::frame $data(widgets,treestyle).f 01038 ttk::label $data(widgets,treestyle).f.l -text [msgcat::mc "Tree Style: "] 01039 set data(widgets,treestyle_mb) [ttk::menubutton $data(widgets,treestyle).f.mb -width -20 \ 01040 -menu [set data(widgets,treestyle_menu) [menu $data(widgets,treestyle).menu -tearoff 0]]] 01041 01042 # Add the available treestyles to the menubutton (note: tablelist::treeStyles is a private, 01043 # undocumented variable; however, the developer recommended that this be used for this purpose) 01044 foreach treestyle $tablelist::treeStyles { 01045 $data(widgets,treestyle_menu) add command -label $treestyle -command [list themer::set_treestyle $treestyle] 01046 } 01047 01048 # Pack the widgets 01049 pack $data(widgets,treestyle).f.l -side left -padx 2 -pady 2 01050 pack $data(widgets,treestyle).f.mb -side left -padx 2 -pady 2 01051 01052 pack $data(widgets,treestyle).f -padx 2 -pady 2 01053 01054 } 01055 01056 ###################################################################### 01057 # Updates the category tablelist. 01058 proc set_treestyle {treestyle} { 01059 01060 variable data 01061 01062 # Update the menubutton text 01063 $data(widgets,treestyle_mb) configure -text $treestyle 01064 01065 # Update the category table 01066 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $treestyle 01067 01068 # Specify that the apply button should be enabled 01069 set_theme_modified 01070 01071 } 01072 01073 ###################################################################### 01074 # Called before the base color menu is posted. Updates itself with 01075 # the current list of swatch colors. 01076 proc post_base_color_menu {mnu} { 01077 01078 variable data 01079 01080 # Clear the menu 01081 $mnu delete 0 end 01082 01083 # Add the "Custom..." menu item 01084 $mnu add command -label [msgcat::mc "Custom..."] -command [list themer::choose_custom_base_color] 01085 01086 # Add each swatch colors to the menu, if available 01087 if {[theme::swatch_do length] > 0} { 01088 $mnu add separator 01089 $mnu add command -label [msgcat::mc "Swatch Colors"] -state disabled 01090 foreach color [theme::swatch_do get] { 01091 $mnu add command -label $color -command [list themer::set_base_color $color] 01092 } 01093 } 01094 01095 } 01096 01097 ###################################################################### 01098 # Calls up the color picker and, if a color is chosen, update the UI. 01099 proc choose_custom_base_color {} { 01100 01101 variable data 01102 01103 # Get the current base color 01104 set orig_color [$data(widgets,color_canvas) itemcget $data(widgets,color_base) -fill] 01105 01106 # Get the color from the user 01107 if {[set color [tk_chooseColor -initialcolor $orig_color -parent .thmwin]] eq ""} { 01108 return 01109 } 01110 01111 # Set the color in the UI 01112 set_base_color $color 01113 01114 } 01115 01116 ###################################################################### 01117 # Called when a new base color is selected, updates the UI. 01118 proc set_base_color {color} { 01119 01120 variable data 01121 01122 # Set the base color to the given color 01123 $data(widgets,color_canvas) itemconfigure $data(widgets,color_base) -fill $color 01124 01125 # Apply any modifications 01126 detail_update_color $data(mod) 01127 01128 } 01129 01130 ###################################################################### 01131 # Handles any changes to the color modification radiobutton status. 01132 proc color_mod_changed {new_mod} { 01133 01134 variable data 01135 01136 # Disable all entries 01137 foreach mod [list v r g b] { 01138 $data(widgets,color_${mod}_scale) state disabled 01139 $data(widgets,color_${mod}_entry) {*}$data(sb_disabled) 01140 } 01141 01142 # If the type is not none, allow it to be configured 01143 if {$new_mod ne "none"} { 01144 $data(widgets,color_${new_mod}_scale) state !disabled 01145 $data(widgets,color_${new_mod}_entry) {*}$data(sb_normal) 01146 } 01147 01148 # Update the color details 01149 detail_update_color $new_mod 01150 01151 } 01152 01153 ###################################################################### 01154 # Handles any changes to the scaling. 01155 proc detail_scale_change {mod value} { 01156 01157 variable data 01158 01159 # Insert the value in the spinbox 01160 $data(widgets,color_${mod}_entry) delete 0 end 01161 $data(widgets,color_${mod}_entry) insert end [expr int( $value )] 01162 01163 # Update the UI 01164 detail_update_color $mod 01165 01166 } 01167 01168 ###################################################################### 01169 # Validate the detail entry fields. 01170 proc detail_spinbox_change {mod} { 01171 01172 variable data 01173 01174 # Get the current spinbox value 01175 set value [$data(widgets,color_${mod}_entry) get] 01176 01177 # Set the scale value 01178 $data(widgets,color_${mod}_scale) configure -value [expr {($value eq "") ? 0 : $value}] 01179 01180 # Update the UI 01181 detail_update_color $mod 01182 01183 } 01184 01185 ###################################################################### 01186 # Updates the various color attributes given the modification setting. 01187 proc detail_update_color {mod} { 01188 01189 variable data 01190 01191 # Get the base color 01192 set base_color [$data(widgets,color_canvas) itemcget $data(widgets,color_base) -fill] 01193 01194 # Get the entry value 01195 set diff [expr {($mod ne "none") ? [$data(widgets,color_${mod}_entry) get] : 0}] 01196 01197 # Calculate the value 01198 switch $mod { 01199 none { 01200 set new_color $base_color 01201 set value $base_color 01202 } 01203 v { 01204 set new_color [utils::auto_adjust_color $base_color $diff auto] 01205 set value $base_color,v,$diff 01206 } 01207 default { 01208 set new_color [utils::auto_mix_colors $base_color $mod $diff] 01209 set value $base_color,$mod,$diff 01210 } 01211 } 01212 01213 # Update the color UI 01214 $data(widgets,color_canvas) itemconfigure $data(widgets,color_mod) -fill $new_color 01215 $data(widgets,color_canvas) raise $data(widgets,color_mod) 01216 01217 # Update the data value 01218 if {$mod eq "none"} { 01219 theme::meta_do delete $data(category) $data(opt) 01220 } else { 01221 theme::meta_do set $data(category) $data(opt) $value 01222 } 01223 01224 # Update the table row 01225 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $new_color 01226 01227 # Specify that the apply button should be enabled 01228 set_theme_modified 01229 01230 } 01231 01232 ###################################################################### 01233 # Show the relief panel. 01234 proc detail_show_relief {value values} { 01235 01236 variable data 01237 01238 # Add the relief panel 01239 pack $data(widgets,relief) -fill both -expand yes 01240 01241 # Delete the menu contents 01242 $data(widgets,relief_menu) delete 0 end 01243 01244 # Add the values 01245 foreach val $values { 01246 $data(widgets,relief_menu) add command -label $val -command [list themer::handle_relief_change $val] 01247 } 01248 01249 # Set the detail 01250 $data(widgets,relief_mb) configure -text $value 01251 01252 } 01253 01254 ###################################################################### 01255 # Handles any changes to the relief widget. 01256 proc handle_relief_change {value} { 01257 01258 variable data 01259 01260 # Set the menubutton 01261 $data(widgets,relief_mb) configure -text $value 01262 01263 # Update the configuration table 01264 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $value 01265 01266 # Enable the apply button 01267 set_theme_modified 01268 01269 } 01270 01271 ###################################################################### 01272 # Displays the number selection panel. 01273 proc detail_show_number {lbl value min max} { 01274 01275 variable data 01276 01277 # Add the number panel 01278 pack $data(widgets,number) -fill both -expand yes 01279 01280 # Create the range of values 01281 for {set i $min} {$i <= $max} {incr i} { 01282 lappend values $i 01283 } 01284 01285 # Configure the label 01286 $data(widgets,number_lbl) configure -text "$lbl:" 01287 01288 # Configure the spinbox 01289 $data(widgets,number_sb) configure -values $values -width [string length $max] 01290 01291 # Set the current value in the spinbox 01292 $data(widgets,number_sb) set $value 01293 01294 } 01295 01296 ###################################################################### 01297 # Handles any changes to the number value. 01298 proc handle_number_change {} { 01299 01300 variable data 01301 01302 # Get the spinbox value 01303 set value [$data(widgets,number_sb) get] 01304 01305 # Update the configuration table 01306 theme::set_themer_category_table_row $data(widgets,cat) $data(row) $value 01307 01308 # Enable the apply button 01309 set_theme_modified 01310 01311 } 01312 01313 ###################################################################### 01314 # Show the color panel. 01315 proc detail_show_color {value} { 01316 01317 variable data 01318 01319 # Add the color panel 01320 pack $data(widgets,color) -fill both -expand yes 01321 01322 # Parse the value 01323 switch [llength [set values [split $value ,]]] { 01324 1 { 01325 set base_color [lindex $values 0] 01326 set data(mod) "none" 01327 } 01328 3 { 01329 lassign $values base_color data(mod) set_value 01330 } 01331 default { 01332 return -code error [format "%s (%s)" [msgcat::mc "Unknown color value format"] $value] 01333 } 01334 } 01335 01336 # Colorize the widgets 01337 $data(widgets,color_canvas) configure -background [theme::get_value syntax background] 01338 $data(widgets,color_canvas) itemconfigure $data(widgets,color_base) -fill $base_color 01339 01340 switch $data(mod) { 01341 none { $data(widgets,color_canvas) itemconfigure $data(widgets,color_mod) -fill $base_color } 01342 v { $data(widgets,color_canvas) itemconfigure $data(widgets,color_mod) -fill [utils::auto_adjust_color $base_color $set_value auto] } 01343 default { $data(widgets,color_canvas) itemconfigure $data(widgets,color_mod) -fill [utils::auto_mix_colors $base_color $data(mod) $set_value] } 01344 } 01345 01346 # Get all of the color values 01347 lassign [utils::get_color_values $base_color] base(value) base(r) base(g) base(b) 01348 01349 # Set the from/to values in the scales and entries 01350 foreach mod [list v r g b] { 01351 if {$mod eq $data(mod)} { 01352 $data(widgets,color_${mod}_scale) configure -value $set_value 01353 $data(widgets,color_${mod}_entry) set $set_value 01354 $data(widgets,color_${mod}_scale) state !disabled 01355 $data(widgets,color_${mod}_entry) {*}$data(sb_normal) 01356 } else { 01357 $data(widgets,color_${mod}_scale) configure -value 0 01358 $data(widgets,color_${mod}_entry) set 0 01359 $data(widgets,color_${mod}_scale) state disabled 01360 $data(widgets,color_${mod}_entry) {*}$data(sb_disabled) 01361 } 01362 } 01363 01364 } 01365 01366 ###################################################################### 01367 # Displays the given image type in the detail image frame. 01368 proc show_image_frame {type {value ""}} { 01369 01370 variable data 01371 01372 set orig_value $value 01373 01374 # Unpack any children in the image frame 01375 catch { pack forget {*}[pack slaves $data(widgets,image)] } 01376 01377 # Make the image type selection menubutton visible again 01378 pack $data(widgets,image_mb) -padx 2 -pady 2 01379 01380 # Get the value from the table if we dont have it 01381 if {$value eq ""} { 01382 set value [$data(widgets,cat) cellcget $data(row),value -text] 01383 } 01384 01385 # Get the image base color from the table 01386 set base_color [$data(widgets,cat) cellcget $data(row),value -background] 01387 01388 # Organize the value into an array 01389 array set value_array $value 01390 01391 # Make sure that the value arrays are 01392 if {[info exists value_array(fg)]} { 01393 set value_array(fg) [theme::get_image_color $value_array(fg)] 01394 } 01395 if {[info exists value_array(bg)]} { 01396 set value_array(bg) [theme::get_image_color $value_array(bg)] 01397 } 01398 01399 switch $type { 01400 mono { 01401 $data(widgets,image_mb) configure -text [msgcat::mc "One-Color Bitmap"] 01402 $data(widgets,image_mf_bm) configure -swatches [theme::swatch_do get] -background $base_color 01403 catch { 01404 if {[info exists value_array(dat)]} { 01405 bitmap::set_from_info $data(widgets,image_mf_bm) [array get value_array] 01406 if {$orig_value eq ""} { 01407 handle_bitmap_changed [bitmap::get_info $data(widgets,image_mf_bm)] 01408 } 01409 } 01410 } 01411 pack $data(widgets,image_mf) -padx 2 -pady 2 01412 } 01413 dual { 01414 $data(widgets,image_mb) configure -text [msgcat::mc "Two-Color Bitmap"] 01415 $data(widgets,image_df_bm) configure -swatches [theme::swatch_do get] -background $base_color 01416 catch { 01417 if {[info exists value_array(dat)]} { 01418 bitmap::set_from_info $data(widgets,image_df_bm) [array get value_array] 01419 if {$orig_value eq ""} { 01420 handle_bitmap_changed [bitmap::get_info $data(widgets,image_df_bm)] 01421 } 01422 } 01423 } 01424 pack $data(widgets,image_df) -padx 2 -pady 2 01425 } 01426 photo { 01427 $data(widgets,image_mb) configure -text [msgcat::mc "GIF Photo"] 01428 $data(widgets,image_pf_tl_file) configure -background $base_color 01429 if {[info exists value_array(dir)]} { 01430 switch $value_array(dir) { 01431 install { image_photo_dir install *.gif $value_array(file) } 01432 user { image_photo_dir user *.gif $value_array(file) } 01433 default { image_photo_dir custom *.gif [file join $value_array(dir) $value_array(file)] } 01434 } 01435 } else { 01436 $data(widgets,image_pf_mb_dir) configure -text [msgcat::mc "Select Directory"] 01437 grid remove $data(widgets,image_pf_tl_file) 01438 } 01439 pack $data(widgets,image_pf) -fill both -expand yes -padx 2 -pady 2 01440 } 01441 } 01442 01443 # Set the image type 01444 set data(image_type) $type 01445 01446 } 01447 01448 ###################################################################### 01449 # Displays the bitmap detail window and populates it with the given 01450 # information. 01451 proc detail_show_image {type value} { 01452 01453 variable data 01454 01455 # Show the image panel 01456 pack $data(widgets,image) -fill both -expand yes 01457 01458 # Display the appropriate image detail frame 01459 show_image_frame $type $value 01460 01461 } 01462 01463 ###################################################################### 01464 # Displays the treestyle detail frame. 01465 proc detail_show_treestyle {value} { 01466 01467 variable data 01468 01469 # Display the treestyle frame 01470 pack $data(widgets,treestyle) -fill both -expand yes 01471 01472 # Set the menubutton 01473 $data(widgets,treestyle_mb) configure -text $value 01474 01475 } 01476 01477 ###################################################################### 01478 # Creates and initializes the UI. 01479 proc initialize {} { 01480 01481 variable data 01482 01483 # Create the UI 01484 create 01485 01486 # Delete any existing swatches 01487 if {[info exists data(swatch_index)]} { 01488 for {set i 1} {$i <= $data(swatch_index)} {incr i} { 01489 delete_swatch $i 1 01490 } 01491 set data(swatch_index) 0 01492 } 01493 01494 # Get the swatches and clear the list 01495 set colors [theme::swatch_do get] 01496 theme::swatch_do clear 01497 01498 # Insert the swatches 01499 foreach color $colors { 01500 add_swatch $color 01501 } 01502 01503 # Clear the detail frame 01504 catch { pack forget {*}[pack slaves $data(widgets,df)] } 01505 01506 # Close the search frame 01507 close_search 01508 01509 # Close the copy frame 01510 close_copy 01511 01512 # Insert categories 01513 theme::populate_themer_category_table $data(widgets,cat) 01514 01515 } 01516 01517 ###################################################################### 01518 # Adds a new swatch color. 01519 proc add_swatch {{color ""}} { 01520 01521 variable data 01522 01523 set orig_color $color 01524 01525 # Get the color from the user 01526 if {$color eq ""} { 01527 set choose_color_opts [list] 01528 if {[set select [$data(widgets,cat) curselection]] ne ""} { 01529 if {[theme::get_type [$data(widgets,cat) cellcget $select,category -text] [$data(widgets,cat) cellcget $select,opt -text]] eq "color"} { 01530 lappend choose_color_opts -initialcolor [$data(widgets,cat) cellcget $select,value -background] 01531 } 01532 } 01533 if {[set color [tk_chooseColor -parent .thmwin {*}$choose_color_opts]] eq ""} { 01534 return 01535 } 01536 } 01537 01538 # Create button 01539 set index [incr data(swatch_index)] 01540 set col [theme::swatch_do length] 01541 set ifile [file join $::tke_dir lib images square32.bmp] 01542 set img [image create bitmap -file $ifile -maskfile $ifile -foreground $color] 01543 set frm $data(widgets,sf).f$index 01544 01545 # Move the plus button up if the swatch is no longer going to be empty 01546 if {$col == 0} { 01547 pack $data(widgets,plus_text) 01548 } 01549 01550 # Create widgets 01551 pack [ttk::frame $frm] -before $data(widgets,plus) -side left -padx 2 -pady 2 01552 pack [ttk::button $frm.b -style BButton -image $img -command [list themer::edit_swatch $index]] 01553 pack [ttk::label $frm.l -text $color] 01554 01555 # Add binding to delete swatch 01556 bind $frm.b <ButtonRelease-$::right_click> [list themer::delete_swatch $index] 01557 01558 # Add the swatch 01559 theme::swatch_do append $color 01560 01561 # Insert the value into the swatch list 01562 if {$orig_color eq ""} { 01563 set_theme_modified 01564 } 01565 01566 # If the number of swatch elements exceeds the maximum, remove the plus button 01567 if {[theme::swatch_do length] == $data(max_swatches)} { 01568 pack forget $data(widgets,plus) 01569 } 01570 01571 } 01572 01573 ###################################################################### 01574 # Edit the color of the swatch. 01575 proc edit_swatch {index} { 01576 01577 variable data 01578 01579 # Get the index 01580 set pos [lsearch [pack slaves $data(widgets,sf)] $data(widgets,sf).f$index] 01581 01582 # Get the original color 01583 set orig_color [theme::swatch_do index $pos] 01584 01585 # Get the new color from the user 01586 if {[set color [tk_chooseColor -initialcolor $orig_color -parent .thmwin]] eq ""} { 01587 return 01588 } 01589 01590 # Change the widgets 01591 [$data(widgets,sf).f$index.b cget -image] configure -foreground $color 01592 $data(widgets,sf).f$index.l configure -text $color 01593 01594 # Change the swatch value 01595 theme::swatch_do set $pos $color 01596 01597 # Change table values 01598 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 01599 if {[set category [$data(widgets,cat) cellcget $i,category -text]] ne ""} { 01600 set opt [$data(widgets,cat) cellcget $i,opt -text] 01601 switch [theme::get_type $category $opt] { 01602 color { 01603 if {[theme::meta_do exists $category $opt]} { 01604 set value [split [theme::meta_do get $category $opt] ,] 01605 if {[lindex $value 0] eq $orig_color} { 01606 lset value 0 $color 01607 theme::meta_do set $category $opt [join $value ,] 01608 theme::set_themer_category_table_row $data(widgets,cat) $i [get_color [join $value ,]] 01609 } 01610 } elseif {[theme::get_value $category $opt] eq $orig_color} { 01611 theme::set_themer_category_table_row $data(widgets,cat) $i $color 01612 } 01613 } 01614 image { 01615 array set values [theme::get_value $category $opt] 01616 if {[info exists values(fg)] && ($values(fg) eq $orig_color)} { 01617 set values(fg) $color 01618 } 01619 if {[info exists values(bg)] && ($values(bg) eq $orig_color)} { 01620 set values(bg) $color 01621 } 01622 theme::set_themer_category_table_row $data(widgets,cat) $i [array get values] 01623 array unset values 01624 } 01625 } 01626 } 01627 } 01628 01629 # Specify that the theme has been modified 01630 set_theme_modified 01631 01632 } 01633 01634 ###################################################################### 01635 # Deletes the given swatch after confirming from the user. 01636 proc delete_swatch {index {force 0}} { 01637 01638 variable data 01639 01640 # Confirm from the user 01641 if {!$force && [tk_messageBox -parent .thmwin -message [msgcat::mc "Delete swatch?"] -default no -type yesno] eq "no"} { 01642 return 01643 } 01644 01645 # Get position 01646 set pos [lsearch [pack slaves $data(widgets,sf)] $data(widgets,sf).f$index] 01647 01648 # Delete image 01649 image delete [$data(widgets,sf).f$index.b cget -image] 01650 01651 # Destroy the widgets 01652 destroy $data(widgets,sf).f$index 01653 01654 # Make sure that the plus button is displayed since we will have room in the swatch bar 01655 pack $data(widgets,plus) -side left -padx 2 -pady 2 01656 01657 # Get the color being deleted 01658 set orig_color [theme::swatch_do index $pos] 01659 01660 # Delete the swatch value from the list 01661 if {!$force} { 01662 01663 theme::swatch_do delete $pos 01664 set_theme_modified 01665 01666 # Make table colors dependent on this color independent 01667 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 01668 if {[set category [$data(widgets,cat) cellcget $i,category -text]] ne ""} { 01669 set opt [$data(widgets,cat) cellcget $i,opt -text] 01670 if {([theme::get_type $category $opt] eq "color") && [theme::meta_do exists $category $opt]} { 01671 if {[lindex [split [theme::meta_do get $category $opt] ,] 0] eq $orig_color} { 01672 theme::meta_do delete $category $opt 01673 } 01674 } 01675 } 01676 } 01677 01678 } 01679 01680 } 01681 01682 ###################################################################### 01683 # Imports a TextMate or TKE theme file after prompting user to import 01684 # a file. 01685 proc import {{parent .thmwin}} { 01686 01687 variable data 01688 01689 # Get the theme file to import 01690 if {[set theme [tk_getOpenFile -parent $parent -title [msgcat::mc "Import Theme File"] -filetypes {{{TKE Theme} {.tkethemz}} {{TextMate Theme} {.tmtheme .tmTheme}}}]] ne ""} { 01691 switch -exact [string tolower [file extension $theme]] { 01692 .tkethemz { 01693 import_tke $theme .thmwin 01694 return 1 01695 } 01696 .tmtheme { 01697 import_tm $theme .thmwin 01698 return 1 01699 } 01700 default { 01701 return 0 01702 } 01703 } 01704 } 01705 01706 return 0 01707 01708 } 01709 01710 ###################################################################### 01711 # Imports the given TextMate theme and displays the result in the UI. 01712 proc import_tm {theme {parent .}} { 01713 01714 variable data 01715 01716 # If we have not set the original_theme, set it to the current application theme 01717 if {![info exists data(original_theme)]} { 01718 set data(original_theme) [theme::get_current_theme] 01719 } 01720 01721 # Set the theme 01722 if {[check_for_save]} { 01723 01724 # Read the theme 01725 if {[catch { theme::read_tmtheme $theme } rc]} { 01726 tk_messageBox -parent $parent -icon error -message [msgcat::mc "Import Error"] -detail $rc -default ok -type ok 01727 return 01728 } 01729 01730 # Initialize the themer 01731 initialize 01732 01733 # Set the current theme 01734 set_current_theme_to [file rootname [file tail $theme]] 01735 01736 # Apply the theme to the UI 01737 apply_theme 01738 01739 # Specify that a save is required 01740 set_theme_modified 01741 01742 } 01743 01744 } 01745 01746 ###################################################################### 01747 # Imports the given tke theme and displays the result in the UI. 01748 proc import_tke {theme {parent .}} { 01749 01750 variable data 01751 01752 # If we have not set the original_theme, set it to the current application theme 01753 if {![info exists data(original_theme)]} { 01754 set data(original_theme) [theme::get_current_theme] 01755 } 01756 01757 # Perform the tkethemz import 01758 set theme_file [themes::import $parent $theme] 01759 01760 # Set the theme 01761 if {[check_for_save]} { 01762 01763 # Read the theme 01764 if {[catch { theme::read_tketheme $theme_file } rc]} { 01765 tk_messageBox -parent $parent -icon error -message [msgcat::mc "Import Error"] -detail $rc -default ok -type ok 01766 return 01767 } 01768 01769 # Initialize the themer 01770 initialize 01771 01772 # Set the current theme 01773 set_current_theme_to [file rootname [file tail $theme]] 01774 01775 # Apply the theme to the UI 01776 apply_theme 01777 01778 # Specify that a save is required 01779 set_theme_modified 01780 01781 } 01782 01783 } 01784 01785 ###################################################################### 01786 # Exports the current theme information to a tketheme file on the 01787 # filesystem. 01788 proc export {} { 01789 01790 # Get the export information 01791 array set expdata [export_win] 01792 01793 # If the export information exists, export the theme 01794 if {[info exists expdata(name)]} { 01795 01796 # Export the theme 01797 themes::export .thmwin $expdata(name) $expdata(dir) $expdata(creator) $expdata(website) $expdata(license) 01798 01799 # Make the save frame disappear 01800 end_save_frame 01801 01802 } 01803 01804 } 01805 01806 ###################################################################### 01807 # Displays export window and returns when the user has supplied the 01808 # needed information. Returns the empty list of the user cancels 01809 # the export function. 01810 proc export_win {} { 01811 01812 variable export_retval 01813 01814 toplevel .expwin 01815 wm title .expwin [msgcat::mc "Export Theme As"] 01816 wm resizable .expwin 0 0 01817 wm transient .expwin .thmwin 01818 wm protocol .expwin WM_DELETE_WINDOW { 01819 set themer::export_retval [list] 01820 destroy .expwin 01821 } 01822 01823 ttk::frame .expwin.f 01824 ttk::label .expwin.f.cl -text [format "%s:" [msgcat::mc "Created By"]] 01825 ttk::entry .expwin.f.ce -width 50 01826 ttk::label .expwin.f.wl -text [format "%s:" [msgcat::mc "Website"]] 01827 ttk::entry .expwin.f.we -width 50 01828 ttk::label .expwin.f.ll -text [format "%s:" [msgcat::mc "License File"]] 01829 ttk::entry .expwin.f.le -width 50 -state disabled 01830 ttk::button .expwin.f.lb -style BButton -text [msgcat::mc "Choose"] -command { 01831 lappend opts -parent .expwin 01832 if {[set license [.expwin.f.le get]] ne ""} { 01833 lappend opts -initialfile $license 01834 lappend opts -initialdir [file dirname $license] 01835 } 01836 if {[set license [tk_getOpenFile {*}$opts]] ne ""} { 01837 .expwin.f.le configure -state normal 01838 .expwin.f.le delete 0 end 01839 .expwin.f.le insert end $license 01840 .expwin.f.le configure -state disabled 01841 themer::validate_export 01842 } 01843 } 01844 ttk::label .expwin.f.nl -text [format "%s:" [msgcat::mc "Theme Name"]] 01845 ttk::entry .expwin.f.ne -width 50 -validate key -validatecommand themer::validate_export 01846 ttk::label .expwin.f.dl -text [format "%s:" [msgcat::mc "Output Directory"]] 01847 ttk::entry .expwin.f.de -width 50 -state disabled 01848 ttk::button .expwin.f.db -style BButton -text [msgcat::mc "Choose"] -command { 01849 lappend opts -parent .expwin -mustexist 1 01850 if {[set dir [.expwin.f.de get]] ne ""} { 01851 lappend opts -initialdir $dir 01852 } 01853 if {[set dir [tk_chooseDirectory {*}$opts]] ne ""} { 01854 .expwin.f.de configure -state normal 01855 .expwin.f.de delete 0 end 01856 .expwin.f.de insert end $dir 01857 .expwin.f.de configure -state disabled 01858 themer::validate_export 01859 } 01860 } 01861 ttk::separator .expwin.f.sep -orient horizontal 01862 01863 # Make some of the fields drop targets 01864 gui::make_drop_target .expwin.f.we entry -types {text} 01865 gui::make_drop_target .expwin.f.le entry -force 1 -types {files} 01866 gui::make_drop_target .expwin.f.de entry -force 1 -types {dirs} 01867 01868 grid rowconfigure .expwin.f 5 -weight 1 01869 grid columnconfigure .expwin.f 1 -weight 1 01870 grid .expwin.f.cl -row 0 -column 0 -sticky e -padx 2 -pady 2 01871 grid .expwin.f.ce -row 0 -column 1 -sticky news -padx 2 -pady 2 01872 grid .expwin.f.wl -row 1 -column 0 -sticky e -padx 2 -pady 2 01873 grid .expwin.f.we -row 1 -column 1 -sticky news -padx 2 -pady 2 01874 grid .expwin.f.ll -row 2 -column 0 -sticky e -padx 2 -pady 2 01875 grid .expwin.f.le -row 2 -column 1 -sticky news -padx 2 -pady 2 01876 grid .expwin.f.lb -row 2 -column 2 -sticky news -padx 2 -pady 2 01877 grid .expwin.f.nl -row 3 -column 0 -sticky e -padx 2 -pady 2 01878 grid .expwin.f.ne -row 3 -column 1 -sticky news -padx 2 -pady 2 01879 grid .expwin.f.dl -row 4 -column 0 -sticky e -padx 2 -pady 2 01880 grid .expwin.f.de -row 4 -column 1 -sticky news -padx 2 -pady 2 01881 grid .expwin.f.db -row 4 -column 2 -sticky news -padx 2 -pady 2 01882 grid .expwin.f.sep -row 6 -column 0 -sticky news -padx 2 -pady 2 -columnspan 3 01883 01884 ttk::frame .expwin.bf 01885 ttk::button .expwin.bf.export -style BButton -text [msgcat::mc "Export"] -command { 01886 set themer::export_retval [list \ 01887 name [.expwin.f.ne get] \ 01888 dir [.expwin.f.de get] \ 01889 creator [.expwin.f.ce get] \ 01890 website [.expwin.f.we get] \ 01891 license [.expwin.f.le get] \ 01892 ] 01893 destroy .expwin 01894 } -state disabled 01895 ttk::button .expwin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -command { 01896 set themer::export_retval [list] 01897 destroy .expwin 01898 } 01899 01900 pack .expwin.bf.cancel -side right -padx 2 -pady 2 01901 pack .expwin.bf.export -side right -padx 2 -pady 2 01902 01903 # Pack the frames 01904 pack .expwin.f -fill x 01905 pack .expwin.bf -fill x 01906 01907 # Set the focus on the first entry field 01908 focus .expwin.f.ce 01909 01910 # Get the theme attribution information 01911 array set attrs [theme::get_attributions] 01912 01913 # Set the theme name to the current theme name 01914 .expwin.f.ne insert end [theme::get_current_theme] 01915 01916 # Set the creator name 01917 if {[info exists attrs(creator)]} { 01918 .expwin.f.ce insert end $attrs(creator) 01919 } 01920 01921 # Set the export directory to the default value from preferences 01922 if {[file exists [set dir [preferences::get General/DefaultThemeExportDirectory]]]} { 01923 .expwin.f.de configure -state normal 01924 .expwin.f.de insert end $dir 01925 .expwin.f.de configure -state disabled 01926 } 01927 01928 # Make sure that the state of the Export button is correct 01929 validate_export 01930 01931 # Center the window in the .thmwin 01932 ::tk::PlaceWindow .expwin widget .thmwin 01933 01934 # Wait for the window to close 01935 tkwait window .expwin 01936 01937 return $export_retval 01938 01939 } 01940 01941 ###################################################################### 01942 # Checks the window input to determine the state of the Export 01943 # button. 01944 proc validate_export {} { 01945 01946 if {([.expwin.f.ne get] ne "") && ([.expwin.f.de get] ne "")} { 01947 .expwin.bf.export configure -state normal 01948 } else { 01949 .expwin.bf.export configure -state disabled 01950 } 01951 01952 return 1 01953 01954 } 01955 01956 ###################################################################### 01957 # Create the table menu. 01958 proc create_table_menu {} { 01959 01960 variable data 01961 01962 # Create the main category table menu 01963 set data(widgets,tmenu) [menu $data(widgets,cat).mnu -tearoff 1 -postcommand [list themer::handle_filter_menu_post]] 01964 01965 # Add search items 01966 $data(widgets,tmenu) add checkbutton -label [msgcat::mc "Table Search"] -variable themer::data(search) -command [list themer::handle_table_search] 01967 01968 $data(widgets,tmenu) add separator 01969 $data(widgets,tmenu) add command -label [msgcat::mc "Table Filters"] -state disabled 01970 $data(widgets,tmenu) add command -label [format " %s" [msgcat::mc "Show All"]] -command [list themer::filter_all] 01971 $data(widgets,tmenu) add cascade -label [format " %s" [msgcat::mc "Show Category"]] -menu [menu $data(widgets,tmenu).catMenu -tearoff 0] 01972 $data(widgets,tmenu) add cascade -label [format " %s" [msgcat::mc "Show Color"]] -menu [menu $data(widgets,tmenu).colorMenu -tearoff 0 -postcommand [list themer::populate_filter_color_menu]] 01973 $data(widgets,tmenu) add command -label [format " %s" [msgcat::mc "Show Selected Value"]] -command [list themer::filter_selected value] 01974 $data(widgets,tmenu) add command -label [format " %s" [msgcat::mc "Show Selected Option"]] -command [list themer::filter_selected opt] 01975 01976 # Populate the category submenu 01977 foreach title [theme::get_category_titles] { 01978 $data(widgets,tmenu).catMenu add command -label $title -command [list themer::filter_category $title] 01979 } 01980 01981 # Add element copy menu items 01982 $data(widgets,tmenu) add separator 01983 $data(widgets,tmenu) add command -label [msgcat::mc "Table Copy"] -state disabled 01984 $data(widgets,tmenu) add checkbutton -label [format " %s" [msgcat::mc "Enable Copy Mode"]] -variable themer::data(copy_mode) -command [list themer::handle_copy_mode] 01985 $data(widgets,tmenu) add command -label [format " %s" [msgcat::mc "Paste Theme Items"]] -state disabled -command [list themer::paste_buffer] 01986 01987 } 01988 01989 ###################################################################### 01990 # Handles the state of the filter menu. 01991 proc handle_filter_menu_post {} { 01992 01993 variable data 01994 01995 if {[$data(widgets,cat) curselection] eq ""} { 01996 $data(widgets,tmenu) entryconfigure [msgcat::mc " Show Selected Value"] -state disabled 01997 $data(widgets,tmenu) entryconfigure [msgcat::mc " Show Selected Option"] -state disabled 01998 } else { 01999 $data(widgets,tmenu) entryconfigure [msgcat::mc " Show Selected Value"] -state normal 02000 $data(widgets,tmenu) entryconfigure [msgcat::mc " Show Selected Option"] -state normal 02001 } 02002 02003 } 02004 02005 ###################################################################### 02006 # Populates the filter color menu. 02007 proc populate_filter_color_menu {} { 02008 02009 variable data 02010 02011 # Clear the menu contents 02012 $data(widgets,tmenu).colorMenu delete 0 end 02013 02014 # Gather the colors 02015 set first 1 02016 foreach colors [theme::get_all_colors] { 02017 foreach color $colors { 02018 $data(widgets,tmenu).colorMenu add command -label $color -command [list themer::filter_color $color] 02019 } 02020 if {$first} { 02021 $data(widgets,tmenu).colorMenu add separator 02022 set first 0 02023 } 02024 } 02025 02026 } 02027 02028 ###################################################################### 02029 # Displays the filter menu. 02030 proc show_filter_menu {tbl col} { 02031 02032 variable data 02033 02034 tk_popup $data(widgets,tmenu) [winfo rootx $data(widgets,cat)] [winfo rooty $data(widgets,cat)] 02035 02036 } 02037 02038 ###################################################################### 02039 # Show all table lines. 02040 proc filter_all {} { 02041 02042 variable data 02043 02044 # Close the search window 02045 close_search 02046 02047 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 02048 $data(widgets,cat) rowconfigure $i -hide 0 02049 } 02050 02051 } 02052 02053 ###################################################################### 02054 # Only show the given category. 02055 proc filter_category {title} { 02056 02057 variable data 02058 02059 # Close the search window 02060 close_search 02061 02062 foreach cat [$data(widgets,cat) childkeys root] { 02063 if {[$data(widgets,cat) cellcget $cat,opt -text] eq $title} { 02064 $data(widgets,cat) rowconfigure $cat -hide 0 02065 } else { 02066 $data(widgets,cat) rowconfigure $cat -hide 1 02067 } 02068 } 02069 02070 } 02071 02072 ###################################################################### 02073 # Only display rows with the given color. 02074 proc filter_color {color} { 02075 02076 variable data 02077 02078 # Close the search window 02079 close_search 02080 02081 foreach cat [$data(widgets,cat) childkeys root] { 02082 set one_match 0 02083 foreach child [$data(widgets,cat) childkeys $cat] { 02084 set category [$data(widgets,cat) cellcget $child,category -text] 02085 set opt [$data(widgets,cat) cellcget $child,opt -text] 02086 if {([lindex [theme::get_type $category $opt] 0] eq "color") && ([$data(widgets,cat) cellcget $child,value -background] eq $color)} { 02087 $data(widgets,cat) rowconfigure $child -hide 0 02088 set one_match 1 02089 } else { 02090 $data(widgets,cat) rowconfigure $child -hide 1 02091 } 02092 } 02093 $data(widgets,cat) rowconfigure $cat -hide [expr $one_match ^ 1] 02094 } 02095 02096 } 02097 02098 ###################################################################### 02099 # Matches all rows that have the same column value as the currently 02100 # selected row. 02101 proc filter_selected {col} { 02102 02103 variable data 02104 02105 # Close the search window 02106 close_search 02107 02108 # Get the selected row 02109 set value [$data(widgets,cat) cellcget [$data(widgets,cat) curselection],$col -text] 02110 02111 foreach cat [$data(widgets,cat) childkeys root] { 02112 set one_match 0 02113 foreach child [$data(widgets,cat) childkeys $cat] { 02114 if {[$data(widgets,cat) cellcget $child,$col -text] eq $value} { 02115 $data(widgets,cat) rowconfigure $child -hide 0 02116 set one_match 1 02117 } else { 02118 $data(widgets,cat) rowconfigure $child -hide 1 02119 } 02120 } 02121 $data(widgets,cat) rowconfigure $cat -hide [expr $one_match ^ 1] 02122 } 02123 02124 } 02125 02126 ###################################################################### 02127 # Handles a change to the table copy mode variable. 02128 proc handle_copy_mode {} { 02129 02130 variable data 02131 02132 if {$data(copy_mode)} { 02133 02134 # Display the copy frame 02135 grid $data(widgets,copy_frame) 02136 02137 # Clear the selection 02138 $data(widgets,cat) selection clear 0 end 02139 02140 # Set the selection mode back to browse 02141 $data(widgets,cat) configure -selectmode multiple 02142 02143 # Clear the detail frame 02144 catch { pack forget {*}[pack slaves $data(widgets,df)] } 02145 02146 } else { 02147 02148 # Close the copy mode 02149 close_copy 02150 02151 } 02152 02153 } 02154 02155 02156 02157 ###################################################################### 02158 # Handles a change to the table search variable. 02159 proc handle_table_search {} { 02160 02161 variable data 02162 02163 if {$data(search)} { 02164 02165 # Display the search bar 02166 grid $data(widgets,search) 02167 02168 # Clear the search widget 02169 $data(widgets,search) delete 0 end 02170 02171 # Put the focus on the search entry field 02172 focus $data(widgets,search) 02173 02174 } else { 02175 02176 # Close the search frame 02177 close_search 02178 02179 } 02180 02181 } 02182 02183 ###################################################################### 02184 # Closes the search panel and returns the category table to normal 02185 # view. 02186 proc close_search {} { 02187 02188 variable data 02189 02190 # Clear the search value 02191 set data(search) 0 02192 02193 # Hide the search frame 02194 grid remove $data(widgets,search) 02195 02196 # Make sure that the table rows are unhidden 02197 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 02198 $data(widgets,cat) rowconfigure $i -hide 0 02199 } 02200 02201 } 02202 02203 ###################################################################### 02204 # Selects the current search string. 02205 proc select_search {} { 02206 02207 variable data 02208 02209 $data(widgets,search) selection range 0 end 02210 02211 } 02212 02213 ###################################################################### 02214 # Updates the display of the table elements which match the given 02215 # text string. 02216 proc perform_search {value} { 02217 02218 variable data 02219 02220 if {$value eq ""} { 02221 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 02222 $data(widgets,cat) rowconfigure $i -hide 0 02223 } 02224 } else { 02225 set shown 0 02226 for {set i [expr [$data(widgets,cat) size] - 1]} {$i >= 0} {incr i -1} { 02227 if {[$data(widgets,cat) parentkey $i] eq "root"} { 02228 $data(widgets,cat) rowconfigure $i -hide [expr $shown == 0] 02229 set shown 0 02230 } else { 02231 incr shown [set match [string match -nocase *$value* [$data(widgets,cat) cellcget $i,opt -text]]] 02232 $data(widgets,cat) rowconfigure $i -hide [expr $match ? 0 : 1] 02233 } 02234 } 02235 } 02236 02237 return 1 02238 02239 } 02240 02241 ###################################################################### 02242 # Add the selected elements to the theme buffer. 02243 proc copy_to_buffer {} { 02244 02245 variable data 02246 02247 # Add the selected rows to the theme buffer 02248 array set elements $data(theme_buffer) 02249 foreach index [$data(widgets,cat) curselection -nonhidden] { 02250 if {[$data(widgets,cat) parentkey $index] ne "root"} { 02251 set opt [$data(widgets,cat) cellcget $index,opt -text] 02252 set category [$data(widgets,cat) cellcget $index,category -text] 02253 set elements($category,$opt) [$data(widgets,cat) cellcget $index,value -text] 02254 } 02255 } 02256 set data(theme_buffer) [array get elements] 02257 02258 # Enable the paste menu item 02259 $data(widgets,tmenu) entryconfigure [format " %s" [msgcat::mc "Paste Theme Items"]] -state normal 02260 02261 } 02262 02263 ###################################################################### 02264 # Pastes the current theme buffer into the current theme. 02265 proc paste_buffer {} { 02266 02267 variable data 02268 02269 # Put the buffer contents into an array 02270 array set buffer $data(theme_buffer) 02271 02272 for {set i 0} {$i < [$data(widgets,cat) size]} {incr i} { 02273 set opt [$data(widgets,cat) cellcget $i,opt -text] 02274 set category [$data(widgets,cat) cellcget $i,category -text] 02275 if {[info exists buffer($category,$opt)]} { 02276 theme::set_themer_category_table_row $data(widgets,cat) $i $buffer($category,$opt) 02277 } 02278 } 02279 02280 # Specify that the theme has been modified 02281 set_theme_modified 02282 02283 # Clear the theme buffer 02284 clear_buffer 02285 02286 } 02287 02288 ###################################################################### 02289 # Clears the theme buffer. 02290 proc clear_buffer {} { 02291 02292 variable data 02293 02294 # Clear the buffer 02295 set data(theme_buffer) [list] 02296 02297 # Disable the paste menu item 02298 $data(widgets,tmenu) entryconfigure [format " %s" [msgcat::mc "Paste Theme Items"]] -state disabled 02299 02300 } 02301 02302 ###################################################################### 02303 # Closes the copy frame and switches the table back to displaying 02304 # selected information. 02305 proc close_copy {} { 02306 02307 variable data 02308 02309 # Set the copy_mode back to 0 02310 set data(copy_mode) 0 02311 02312 # Removes the copy frame 02313 grid remove $data(widgets,copy_frame) 02314 02315 # Clear the selection 02316 $data(widgets,cat) selection clear 0 end 02317 02318 # Set the selection mode back to browse 02319 $data(widgets,cat) configure -selectmode browse 02320 02321 } 02322 02323 } 02324