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: theme.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 10/04/2013 00022 # Brief: Handles the current theme. 00023 ###################################################################### 00024 00025 namespace eval theme { 00026 00027 variable colorizers {keywords comments strings numbers punctuation precompile miscellaneous1 miscellaneous2 miscellaneous3} 00028 variable extra_content {swatch creator website date} 00029 00030 array set fields { 00031 type 0 00032 default 1 00033 value 2 00034 changed 3 00035 desc 4 00036 } 00037 00038 variable category_titles [list \ 00039 syntax [msgcat::mc "Syntax Colors"] \ 00040 ttk_style [msgcat::mc "ttk Widget Colors"] \ 00041 misc_scrollbar [msgcat::mc "Standard Scrollbars"] \ 00042 menus [msgcat::mc "Menu Options"] \ 00043 tabs [msgcat::mc "Tab Options"] \ 00044 text_scrollbar [msgcat::mc "Text Scrollbar Options"] \ 00045 sidebar [msgcat::mc "Sidebar Options"] \ 00046 sidebar_scrollbar [msgcat::mc "Sidebar Scrollbar Options"] \ 00047 sidebar_info [msgcat::mc "Sidebar Info Panel Options"] \ 00048 launcher [msgcat::mc "Command Launcher Options"] \ 00049 images [msgcat::mc "Images"] \ 00050 ] 00051 00052 array set orig_data { 00053 ttk_style,disabled_foreground {color {#999999} {} {0} {msgcat::mc "Default foreground text color to use for all ttk widgets that are in a disabled state."}} 00054 ttk_style,disabled_background {color {1} {} {0} {msgcat::mc "Default background color to use for all ttk widgets that are in a disabled state."}} 00055 ttk_style,background {color {1} {} {0} {msgcat::mc "Default background color to use for all ttk widgets."}} 00056 ttk_style,foreground {color {2} {} {0} {msgcat::mc "Default foreground text color to use for all ttk widgets."}} 00057 ttk_style,active_color {color {0} {} {0} {msgcat::mc "Default background color to use for all ttk widgets when the mouse cursor hovers over the widget."}} 00058 ttk_style,dark_color {color {#cfcdc8} {} {0} {msgcat::mc "Default 'darkcolor' for all ttk widgets."}} 00059 ttk_style,pressed_color {color {#bab5ab} {} {0} {msgcat::mc "Background color to display when a button-like ttk widget is pressed."}} 00060 ttk_style,border_color {color {#9e9a91} {} {0} {msgcat::mc "Default border color for all ttk widgets."}} 00061 ttk_style,entry_border {color {#4a6984} {} {0} {msgcat::mc "Color of ttk entry widget text border when the entry has keyboard focus."}} 00062 ttk_style,select_background {color {#4a6984} {} {0} {msgcat::mc "Specifies the default background color to use for text that is selected in a standard ttk widget (this does not include the editing buffer)."}} 00063 ttk_style,select_foreground {color {#ffffff} {} {0} {msgcat::mc "Specifies the default foreground text color to use for text that is selected in a standard ttk widget (this does not include the editing buffer)."}} 00064 ttk_style,relief {{relief {raised sunken flat ridge solid groove}} {flat} {} {0} {msgcat::mc "Specifies the default relief to use when drawing ttk widgets."}} 00065 ttk_style,grip_thickness {{number {2 10}} {5} {} {0} {msgcat::mc "Determines the thickness of the grip area between resizable panes."}} 00066 ttk_style,grip_count {{number {0 20}} {10} {} {0} {msgcat::mc "Determines the number of grips strips to display in the grip area between resizable panes."}} 00067 misc_scrollbar,-background {color {1} {} {0} {msgcat::mc "Background (trough) color used in a standard scrollbar."}} 00068 misc_scrollbar,-foreground {color {0} {} {0} {msgcat::mc "Foreground (slider) color used in a standard scrollbar."}} 00069 misc_scrollbar,-thickness {{number {5 20}} {15} {} {0} {msgcat::mc "Maximum thickness of the text scrollbars when they are active."}} 00070 menus,-background {color {white} {} {0} {msgcat::mc "Background color used in menus."}} 00071 menus,-foreground {color {black} {} {0} {msgcat::mc "Foreground text color used in menus."}} 00072 menus,-activebackground {color {light blue} {} {0} {msgcat::mc "Background color used for the current/active menu item."}} 00073 menus,-activeforeground {color {white} {} {0} {msgcat::mc "Foreground text color used for the current/active menu item."}} 00074 menus,-disabledforeground {color {grey} {} {0} {msgcat::mc "Foreground text color used for menus item that are disabled."}} 00075 menus,-selectcolor {color {black} {} {0} {msgcat::mc "Foreground color used in menu items with checks or buttons."}} 00076 menus,-relief {{relief {raised sunken flat ridge solid groove}} {flat} {} {0} {msgcat::mc "Menu relief value."}} 00077 tabs,-background {color {1} {} {0} {msgcat::mc "Background color used in the tabbar area."}} 00078 tabs,-foreground {color {2} {} {0} {msgcat::mc "Foreground text/image color used in tabbar and tabs."}} 00079 tabs,-activebackground {color {0} {} {0} {msgcat::mc "Background color used for the current/active tab in the tabbar."}} 00080 tabs,-activeforeground {color {2} {} {0} {msgcat::mc "Foreground text color used for the current/active tab in the tabbar."}} 00081 tabs,-inactivebackground {color {1} {} {0} {msgcat::mc "Background color used for all other tabs that are not the current/active tab in the tabbar."}} 00082 tabs,-inactiveforeground {color {2} {} {0} {msgcat::mc "Foreground text color used for all other tabs that are not the current/active tab in the tabbar."}} 00083 tabs,-bordercolor {color {0} {} {0} {msgcat::mc "Color of space between tabs."}} 00084 tabs,-height {{number {20 40}} {25} {} {0} {msgcat::mc "Pixel height of the tabbar widget."}} 00085 tabs,-relief {{relief {flat raised}} {flat} {} {0} {msgcat::mc "Relief used in drawing the tabs."}} 00086 text_scrollbar,-background {color {0} {} {0} {msgcat::mc "Background (trough) color used in the text scrollbars."}} 00087 text_scrollbar,-foreground {color {1} {} {0} {msgcat::mc "Foreground (slider) color used in the text scrollbars."}} 00088 text_scrollbar,-altforeground {color {red} {} {0} {msgcat::mc "Foreground (slider) color used in the text scrollbars when pane synchronization is enabled."}} 00089 text_scrollbar,-thickness {{number {5 20}} {15} {} {0} {msgcat::mc "Maximum thickness of the text scrollbars when they are active."}} 00090 syntax,background {color {black} {} {0} {msgcat::mc "Background color of the editing buffer."}} 00091 syntax,border_highlight {color {black} {} {0} {msgcat::mc "Color of border drawn around active editing buffer."}} 00092 syntax,comments {color {white} {} {0} {msgcat::mc "Foreground text color to use for comments."}} 00093 syntax,cursor {color {grey} {} {0} {msgcat::mc "Background color of insertion cursor and background marker colors."}} 00094 syntax,difference_add {color {dark green} {} {0} {msgcat::mc "Background color in difference viewer that shows added lines."}} 00095 syntax,difference_sub {color {dark red} {} {0} {msgcat::mc "Background color in difference viewer that shows deleted lines."}} 00096 syntax,foreground {color {white} {} {0} {msgcat::mc "Default color for non-syntax highlighted text."}} 00097 syntax,highlighter {color {yellow} {} {0} {msgcat::mc "Background color used in highlighted text."}} 00098 syntax,keywords {color {white} {} {0} {msgcat::mc "Foreground text color to use for language-specific keywords."}} 00099 syntax,functions {color {white} {} {0} {msgcat::mc "Foreground text color to use for function calls."}} 00100 syntax,variables {color {white} {} {0} {msgcat::mc "Foreground text color to use for variables."}} 00101 syntax,linemap {color {black} {} {0} {msgcat::mc "Background color of linemap area."}} 00102 syntax,linemap_separator {color {grey} {} {0} {msgcat::mc "Color used to draw the line which separates the linemap from the text area."}} 00103 syntax,line_number {color {grey} {} {0} {msgcat::mc "Foreground text color to use for displaying line numbers."}} 00104 syntax,meta {color {grey} {} {0} {msgcat::mc "Foreground text color to use for meta syntax."}} 00105 syntax,readmeta {color {grey80} {} {0} {msgcat::mc "Foreground text color to use for readable meta syntax."}} 00106 syntax,miscellaneous1 {color {white} {} {0} {msgcat::mc "Foreground text color to use for all miscellaneous1 labeled text."}} 00107 syntax,miscellaneous2 {color {white} {} {0} {msgcat::mc "Foreground text color to use for all miscellaneous2 labeled text."}} 00108 syntax,miscellaneous3 {color {white} {} {0} {msgcat::mc "Foreground text color to use for all miscellaneous3 labeled text."}} 00109 syntax,numbers {color {white} {} {0} {msgcat::mc "Foreground text color to use for displaying numbers."}} 00110 syntax,precompile {color {white} {} {0} {msgcat::mc "Foreground text color to use for precompiler syntax."}} 00111 syntax,punctuation {color {white} {} {0} {msgcat::mc "Foreground text color to use for language-specific punctuation."}} 00112 syntax,select_background {color {blue} {} {0} {msgcat::mc "Background color to use for selected text."}} 00113 syntax,select_foreground {color {white} {} {0} {msgcat::mc "Foreground text color to use for selected text."}} 00114 syntax,strings {color {grey} {} {0} {msgcat::mc "Foreground text color for strings."}} 00115 syntax,warning_width {color {grey} {} {0} {msgcat::mc "Color used to draw the warning width line in the editing buffer (as well as the line separating the gutter from the editing buffer)."}} 00116 syntax,embedded {color {#141414} {} {0} {msgcat::mc "Background color displayed in embedded language code."}} 00117 syntax,attention {color {red} {} {0} {msgcat::mc "Background color to use for displaying character information that requires the user's attention."}} 00118 syntax,search_background {color {yellow} {} {0} {msgcat::mc "Background color for matching search text"}} 00119 syntax,search_foreground {color {black} {} {0} {msgcat::mc "Foreground color for matching search text"}} 00120 syntax,marker {color {orange} {} {0} {msgcat::mc "Background color for markers in the line gutter and scrollbar"}} 00121 syntax,closed_fold {color {orange} {} {0} {msgcat::mc "Color to use for highlighting closed folds in the line number gutter"}} 00122 sidebar,-background {color {2} {} {0} {msgcat::mc "Background color for all sidebar items that are not selected."}} 00123 sidebar,-foreground {color {1} {} {0} {msgcat::mc "Text color for all sidebar items that are not selected."}} 00124 sidebar,-selectbackground {color {1} {} {0} {msgcat::mc "Background color for all sidebar items that are selected."}} 00125 sidebar,-selectforeground {color {2} {} {0} {msgcat::mc "Text color for all sidebar items that are selected."}} 00126 sidebar,-movebackground {color {black} {} {0} {msgcat::mc "Background color of move bar."}} 00127 sidebar,-moveforeground {color {white} {} {0} {msgcat::mc "Foreground color of move bar."}} 00128 sidebar,-highlightbackground {color {2} {} {0} {msgcat::mc "Specifies the color to display around the sidebar when the sidebar does not have the focus."}} 00129 sidebar,-highlightcolor {color {2} {} {0} {msgcat::mc "Specifies the color to display around the sidebar when the sidebar has the focus."}} 00130 sidebar,-dropcolor {color {green} {} {0} {msgcat::mc "Specifies the color drawn around the border of the sidebar when a dragged file is droppable"}} 00131 sidebar,-highlightthickness {{number {1 5}} {1} {} {0} {msgcat::mc "Specifies the pixel thickness of the highlight line."}} 00132 sidebar,-relief {{relief {raised sunken flat ridge solid groove}} {flat} {} {0} {msgcat::mc "Relief value of the sidebar area."}} 00133 sidebar_scrollbar,-background {color {2} {} {0} {msgcat::mc "Background (trough) color used in the sidebar scrollbar."}} 00134 sidebar_scrollbar,-foreground {color {1} {} {0} {msgcat::mc "Foreground (slider) color used in the sidebar scrollbar."}} 00135 sidebar_scrollbar,-thickness {{number {5 20}} {15} {} {0} {msgcat::mc "Maximum thickness of the text scrollbar when it is active."}} 00136 sidebar_info,-background {color {2} {} {0} {msgcat::mc "Background color to use for the file information panel."}} 00137 sidebar_info,-active_background {color {0} {} {0} {msgcat::mc "Background color to use for active information values to indicate they are clickable."}} 00138 sidebar_info,-title_foreground {color {1} {} {0} {msgcat::mc "Foreground color to use for title text in the information panel."}} 00139 sidebar_info,-value_foreground {color {1} {} {0} {msgcat::mc "Foreground color to use for value text in the information panel."}} 00140 launcher,-background {color {white} {} {0} {msgcat::mc "Specifies background color of command launcher entry and list"}} 00141 launcher,-foreground {color {black} {} {0} {msgcat::mc "Specifies foreground color of command launcher entry and list"}} 00142 launcher,-selectbackground {color {light blue} {} {0} {msgcat::mc "Background color of selection in command launcher"}} 00143 launcher,-selectforeground {color {black} {} {0} {msgcat::mc "Foreground color of selection in command launcher"}} 00144 launcher,-listbackground {color {white} {} {0} {msgcat::mc "Background color of list items when not selected"}} 00145 launcher,-listforeground {color {black} {} {0} {msgcat::mc "Foreground color of list items when not selected"}} 00146 launcher,-textbackground {color {0} {} {0} {msgcat::mc "Background color of textual display in command launcher"}} 00147 launcher,-textforeground {color {2} {} {0} {msgcat::mc "Foreground color of textual display in command launcher"}} 00148 launcher,-bordercolor {color {grey90} {} {0} {msgcat::mc "Color of border around command launcher"}} 00149 launcher,-borderwidth {{number {0 20}} {5} {} {0} {msgcat::mc "Amount of border to display around command launcher in pixels"}} 00150 launcher,-spacercolor {color {white} {} {0} {msgcat::mc "Color of the spacer between the command launcher entry field and the result list"}} 00151 launcher,-spacerheight {{number {0 20}} {5} {} {0} {msgcat::mc "Pixel height of the spacer between the command launcher entry field and the result list"}} 00152 launcher,-scrollcolor {color {grey90} {} {0} {msgcat::mc "Scrollbar slider color used in the command launcher results list"}} 00153 launcher,-scrollwidth {{number {5 20}} {10} {} {0} {msgcat::mc "Maximum thickness of the command launcher scrollbar when it is active."}} 00154 } 00155 00156 array set tm_scope_map { 00157 comment comments 00158 keyword keywords 00159 string strings 00160 entity punctuation 00161 entity.name.tag punctuation 00162 punctuation punctuation 00163 meta.preprocessor.c precompile 00164 other.preprocessor.c precompile 00165 constant numbers 00166 constant.numeric numbers 00167 meta.tag miscellaneous1 00168 support miscellaneous1 00169 support.function functions 00170 support.type miscellaneous1 00171 variable variables 00172 variable.other miscellaneous2 00173 variable.parameter miscellaneous2 00174 storage miscellaneous3 00175 constant.other miscellaneous3 00176 } 00177 00178 array set data {} 00179 array set widgets {} 00180 array set syntax {} 00181 array set basecolor_map {} 00182 00183 # Initialize the widgets array 00184 foreach {category dummy} [list {*}$category_titles syntax_split 1 syntax_prefs 1] { 00185 set widgets($category) [list] 00186 } 00187 00188 # Add a few styles to the default (light) theme 00189 ttk::style theme settings clam { 00190 00191 # BButton 00192 ttk::style configure BButton [ttk::style configure TButton] 00193 ttk::style configure BButton -anchor center -padding 2 -relief flat 00194 ttk::style map BButton [ttk::style map TButton] 00195 ttk::style layout BButton [ttk::style layout TButton] 00196 00197 # HLabel 00198 ttk::style configure HLabel [ttk::style configure TLabel] 00199 ttk::style map HLabel [ttk::style map TLabel] 00200 ttk::style layout HLabel [ttk::style layout TLabel] 00201 00202 # Sidebar 00203 foreach {old new} [list Treeview SBTreeview Treeview.Item SBTreeview.Item] { 00204 ttk::style configure $new [ttk::style configure $old] 00205 ttk::style map $new [ttk::style map $old] 00206 ttk::style layout $new [ttk::style layout $old] 00207 } 00208 00209 # Sidebar frame 00210 ttk::style configure SBFrame [ttk::style configure TFrame] 00211 ttk::style map SBFrame [ttk::style map TFrame] 00212 ttk::style layout SBFrame [ttk::style layout TFrame] 00213 00214 # Notebook that hides the tabs from view (use -style Plain.TNotebook) 00215 ttk::style configure Plain.TNotebook.Tab -relief flat -bd 0 00216 ttk::style layout Plain.TNotebook.Tab null 00217 00218 } 00219 00220 # Use the clam style by default 00221 ttk::style theme use clam 00222 00223 ###################################################################### 00224 # Registers the given widget as the given type. 00225 proc register_widget {w type} { 00226 00227 variable widgets 00228 00229 if {![info exists widgets($type)]} { 00230 return -code error "Called theme::register_widget with unknown type ($type)" 00231 } 00232 00233 # Add the widget to the type list 00234 lappend widgets($type) $w 00235 00236 # Configure the widget's theme information 00237 catch { $w configure {*}[get_category_options $type 1] } 00238 00239 # Create a binding on the widget's Destroy event to unregister it 00240 bind $w <Destroy> [list theme::unregister_widget $w $type] 00241 00242 } 00243 00244 ###################################################################### 00245 # Returns the color to use for the given image. 00246 proc get_image_color {value} { 00247 00248 variable data 00249 00250 if {[string is integer $value]} { 00251 return [lindex $data(swatch) $value] 00252 } 00253 00254 return $value 00255 00256 } 00257 00258 ###################################################################### 00259 # Creates the given image and adds it to the orig_data array. 00260 # Arguments: 00261 # name Unique name that identifies this image. 00262 # type Specifies the image type (legal values are bitmap, photo) 00263 # bgcat Specifies the theme category in which this image will be placed 00264 # bgopt Specifies the option name within the category that should be used 00265 # for setting the background color of the image (only used in bitmap 00266 # but must be specified) 00267 # desc Short description of how the image is used and what it means 00268 # args Arguments that will be passed to the "image" TK command when 00269 # the image is created/transformed. If the -foreground option is 00270 # specified, specifying a numerical value of 0, 1 or 2 will specify 00271 # which of the three primary swatch colors to use for the foreground. 00272 proc register_image {name type bgcat bgopt desc args} { 00273 00274 variable orig_data 00275 00276 array set opts $args 00277 array set img_opts $args 00278 array set img_info [list basecolor $bgcat,$bgopt] 00279 00280 # Transform the background/foreground colors, if necessary 00281 if {[info exists img_opts(-background)]} { 00282 set img_opts(-background) "black" 00283 } 00284 if {[info exists opts(-foreground)]} { 00285 set img_opts(-foreground) "white" 00286 } 00287 00288 # First, create the image 00289 image create $type $name {*}[array get img_opts] 00290 00291 # Discern the image information 00292 switch $type { 00293 bitmap { 00294 if {[info exists opts(-file)]} { 00295 if {![catch { open $opts(-file) r } rc]} { 00296 set img_info(dat) [read $rc] 00297 close $rc 00298 } 00299 } else { 00300 set img_info(dat) $opts(-data) 00301 } 00302 if {[info exists opts(-maskfile)]} { 00303 if {![catch { open $opts(-maskfile) r } rc]} { 00304 set img_info(msk) [read $rc] 00305 close $rc 00306 } 00307 } elseif {[info exists opts(-maskdata)]} { 00308 set img_info(msk) $opts(-maskdata) 00309 } 00310 if {[info exists opts(-background)]} { 00311 set img_info(bg) $opts(-background) 00312 } 00313 if {[info exists opts(-foreground)]} { 00314 set img_info(fg) $opts(-foreground) 00315 } 00316 } 00317 photo { 00318 if {[info exists opts(-file)]} { 00319 set img_info(dir) "install" 00320 set img_info(file) [file tail $opts(-file)] 00321 } else { 00322 return -code error "photo image type only supports -file option" 00323 } 00324 } 00325 } 00326 00327 # Add the image information to the orig_data structure 00328 set orig_data(images,$name) [list image [array get img_info] [list] 0 $desc] 00329 00330 } 00331 00332 ###################################################################### 00333 # Unregisters the given widget of the given type. 00334 proc unregister_widget {w type} { 00335 00336 variable widgets 00337 00338 if {![info exists widgets($type)]} { 00339 return -code error "Called theme::register_widget with unknown type ($type)" 00340 } 00341 00342 if {[set index [lsearch $widgets($type) $w]] != -1} { 00343 set widgets($type) [lreplace $widgets($type) $index $index] 00344 } 00345 00346 } 00347 00348 ###################################################################### 00349 # Loads the given theme file. 00350 proc load_theme {theme_file} { 00351 00352 variable data 00353 00354 # Read the TKE theme file contents and store them in the data array 00355 read_tketheme $theme_file 00356 00357 # If the theme currently does not exist, create the ttk theme 00358 if {[lsearch [ttk::style theme names] $data(name)] == -1} { 00359 create_ttk_theme $data(name) 00360 } 00361 00362 # Set the ttk theme 00363 ttk::style theme use $data(name) 00364 00365 # Update all UI widgets 00366 update_theme 00367 00368 # Allow any plugins waiting for this event 00369 plugins::handle_on_theme_changed 00370 00371 } 00372 00373 ###################################################################### 00374 # Reads the contents of the tketheme and stores the results. 00375 proc read_tketheme {theme_file} { 00376 00377 variable data 00378 variable fields 00379 variable orig_data 00380 variable extra_content 00381 00382 # Open the tketheme file 00383 if {[catch { open $theme_file r } rc]} { 00384 return -code error [format "%s %s" [msgcat::mc "ERROR: Unable to read"] $theme_file] 00385 } 00386 00387 # Read the contents from the file and close 00388 array set contents [read $rc] 00389 close $rc 00390 00391 # Make things backwards compatible 00392 if {![info exists contents(syntax,background)]} { 00393 set bg $contents(background) 00394 set fg $contents(foreground) 00395 set abg [utils::auto_adjust_color $contents(background) 40] 00396 set contents(syntax) [array get contents] 00397 set contents(swatch) [list $bg $fg $abg] 00398 } 00399 00400 # Copy the original data structure into the current data structure 00401 array unset data 00402 array set data [array get orig_data] 00403 00404 # Load the swatch and extra data 00405 set data(name) [file rootname [file tail $theme_file]] 00406 set data(fname) $theme_file 00407 00408 foreach item $extra_content { 00409 if {[info exists contents($item)]} { 00410 set data($item) $contents($item) 00411 } 00412 } 00413 00414 # Set the date from either the contents of the file or the file's modification time 00415 if {![info exists contents(date)]} { 00416 set data(date) [file mtime $theme_file] 00417 } 00418 00419 # Load the meta data 00420 foreach {key val} [array get contents meta,*,*] { 00421 set data($key) $val 00422 } 00423 00424 # Load the categories 00425 foreach key [array names orig_data] { 00426 if {[info exists contents($key)]} { 00427 lset data($key) $fields(value) $contents($key) 00428 } else { 00429 set default_value [lindex $data($key) $fields(default)] 00430 switch [lindex $data($key) $fields(type)] { 00431 color { 00432 lset data($key) $fields(value) [expr {[string is integer $default_value] ? [lindex $data(swatch) $default_value] : $default_value}] 00433 } 00434 image { 00435 array set value $default_value 00436 unset -nocomplain value(basecolor) 00437 lset data($key) $fields(value) [array get value] 00438 array unset value 00439 } 00440 default { 00441 lset data($key) $fields(value) $default_value 00442 } 00443 } 00444 } 00445 lset data($key) $fields(changed) 1 00446 } 00447 00448 } 00449 00450 ###################################################################### 00451 # Writes the current theme data to the given file. 00452 proc write_tketheme {tbl theme_file} { 00453 00454 variable data 00455 variable fields 00456 variable extra_content 00457 00458 # Extract the directory that the theme will be written to and create it, if necessary 00459 if {[set new_dir [file dirname $theme_file]] eq [file join $::tke_dir data themes]} { 00460 set new_dir [file join $::tke_dir lib images] 00461 set user_dir 0 00462 } else { 00463 file mkdir $new_dir 00464 set user_dir 1 00465 } 00466 00467 # Check to see if there are any photos that need to copied to the 00468 # output directory 00469 foreach key [array names data images,*] { 00470 array set value_array [lindex $data($key) $fields(value)] 00471 if {[info exists value_array(dir)] && ($value_array(dir) ne "install")} { 00472 if {$value_array(dir) eq "user"} { 00473 set imgdir [file join $::tke_home themes $data(name)] 00474 } else { 00475 set imgdir $value_array(dir) 00476 } 00477 if {$imgdir ne $new_dir} { 00478 if {[catch { file copy -force [file join $imgdir $value_array(file)] $new_dir } rc]} { 00479 return -code error $rc 00480 } 00481 } 00482 set value_array(dir) [expr {$user_dir ? "user" : "install"}] 00483 lset data($key) $fields(value) [array get value_array] 00484 $tbl cellconfigure [get_themer_category_table_row $tbl {*}[split $key ,]],value -text [array get value_array] 00485 } 00486 array unset value_array 00487 } 00488 00489 # Update the name and fname attributes 00490 set data(name) [file rootname [file tail $theme_file]] 00491 set data(fname) $theme_file 00492 set data(date) [clock seconds] 00493 00494 # Open the file for writing 00495 if {[catch { open $theme_file w } rc]} { 00496 return -code error "Cannot open theme file for writing" 00497 } 00498 00499 # Output the extra content 00500 foreach item $extra_content { 00501 if {[info exists data($item)]} { 00502 puts $rc "$item {$data($item)}" 00503 } 00504 } 00505 00506 # Output the theme content 00507 foreach key [lsort [array names data *,*]] { 00508 if {[llength [split $key ,]] == 2} { 00509 puts $rc "$key {[lindex $data($key) $fields(value)]}" 00510 } else { 00511 puts $rc "$key {$data($key)}" 00512 } 00513 } 00514 00515 # Close the file for writing 00516 close $rc 00517 00518 } 00519 00520 ###################################################################### 00521 # Reads the given TextMate theme file and extracts the relevant information 00522 # for tke's needs. 00523 proc read_tmtheme {theme_file} { 00524 00525 variable data 00526 variable orig_data 00527 variable fields 00528 variable tm_scope_map 00529 00530 # Open the file 00531 if {[catch { open $theme_file r } rc]} { 00532 return -code error [format "%s %s" [msgcat::mc "ERROR: Unable to read"] $theme] 00533 } 00534 00535 # Read the contents of the file into 'content' and close the file 00536 set content [string map {\n { }} [read $rc]] 00537 close $rc 00538 00539 array set depth { 00540 plist 0 00541 array 0 00542 dict 0 00543 key 0 00544 string 0 00545 } 00546 00547 array set labels [get_category_options syntax 1] 00548 00549 set scope 0 00550 set foreground 0 00551 set background 0 00552 set caret 0 00553 set author 0 00554 set scope_types "" 00555 set creator "" 00556 00557 while {[regexp {\s*([^<]*)\s*<(/?\w+)[^>]*>(.*)$} $content -> val element content]} { 00558 if {[string index $element 0] eq "/"} { 00559 set element [string range $element 1 end] 00560 switch $element { 00561 key { 00562 switch $val { 00563 scope { set scope 1 } 00564 foreground { set foreground 1 } 00565 background { set background 1 } 00566 caret { set caret 1 } 00567 author { set author 1 } 00568 } 00569 } 00570 string { 00571 if {$scope} { 00572 set scope 0 00573 set scope_types $val 00574 } elseif {$foreground} { 00575 set foreground 0 00576 set color [normalize_color $val] 00577 if {$scope_types eq ""} { 00578 set labels(foreground) $color 00579 } else { 00580 foreach scope_type [string map {, { }} $scope_types] { 00581 if {[info exists tm_scope_map($scope_type)]} { 00582 set labels($tm_scope_map($scope_type)) $color 00583 } 00584 } 00585 } 00586 } elseif {$background} { 00587 set background 0 00588 set color [normalize_color $val] 00589 if {$scope_types eq ""} { 00590 set labels(background) $color 00591 set labels(warning_width) [utils::auto_adjust_color $color 40] 00592 set labels(meta) [utils::auto_adjust_color $color 40] 00593 set labels(embedded) [utils::auto_adjust_color $color 10] 00594 } 00595 } elseif {$caret} { 00596 set caret 0 00597 set color [normalize_color $val] 00598 if {$scope_types eq ""} { 00599 set labels(cursor) $color 00600 } 00601 } elseif {$author} { 00602 set author 0 00603 set creator $val 00604 } 00605 } 00606 } 00607 incr depth($element) -1 00608 } else { 00609 incr depth($element) 00610 } 00611 } 00612 00613 array unset data 00614 array set data [array get orig_data] 00615 00616 # Load the swatch and extra data 00617 set data(name) [file rootname [file tail $theme_file]] 00618 set data(fname) $theme_file 00619 set data(creator) $creator 00620 set data(date) [clock seconds] 00621 00622 # Setup a default swatch and clear the meta data 00623 set data(swatch) [list $labels(background) $labels(warning_width) $labels(foreground)] 00624 00625 # Set values to defaults to begin with 00626 foreach key [array names orig_data] { 00627 set default_value [lindex $data($key) $fields(default)] 00628 switch [lindex $data($key) $fields(type)] { 00629 color { 00630 lset data($key) $fields(value) [expr {[string is integer $default_value] ? [lindex $data(swatch) $default_value] : $default_value}] 00631 } 00632 image { 00633 array set value $default_value 00634 unset -nocomplain value(basecolor) 00635 lset data($key) $fields(value) [array get value] 00636 array unset value 00637 } 00638 default { 00639 lset data($key) $fields(value) $default_value 00640 } 00641 } 00642 lset data($key) $fields(changed) 1 00643 } 00644 00645 # Copy the label values to the data structure 00646 foreach {name color} [array get labels] { 00647 lset data(syntax,$name) $fields(value) $labels($name) 00648 } 00649 00650 } 00651 00652 ###################################################################### 00653 # Exports the current theme into the specified output directory. 00654 # Returns 1 if the exporting of information is successful; otherwise, 00655 # returns 0. 00656 proc export {name odir creator website license} { 00657 00658 variable data 00659 variable fields 00660 00661 # Get a copy of the data to write 00662 array set export_data [array get data] 00663 00664 # Check to see if there are any photos that need to copied to the 00665 # output directory 00666 foreach key [array names data images,*] { 00667 array set value_array [lindex $data($key) $fields(value)] 00668 if {[info exists value_array(dir)] && ($value_array(dir) ne "install")} { 00669 if {$value_array(dir) eq "user"} { 00670 set dir [file join $::tke_home themes $data(name)] 00671 } else { 00672 set dir $value_array(dir) 00673 set value_array(dir) "user" 00674 lset export_data($key) $fields(value) [array get value_array] 00675 } 00676 if {[catch { file copy -force [file join $dir $value_array(file)] $odir }]} { 00677 return 0 00678 } 00679 } 00680 array unset value_array 00681 } 00682 00683 # If a license file was specified, copy it to the output directory 00684 if {($license ne "") && [file exists $license]} { 00685 if {[catch { file copy -force $license [file join $odir LICENSE] }]} { 00686 return 0 00687 } 00688 } 00689 00690 # Open the theme file for writing 00691 if {[catch { open [file join $odir $name.tketheme] w } rc]} { 00692 return 0 00693 } 00694 00695 # Write the contents 00696 if {$creator ne ""} { 00697 puts $rc "creator {$creator}" 00698 } 00699 if {$website ne ""} { 00700 puts $rc "website {$website}" 00701 } 00702 puts $rc "date {$export_data(date)}" 00703 puts $rc "swatch {$export_data(swatch)}" 00704 foreach key [lsort [array names export_data *,*]] { 00705 puts $rc "$key {[lindex $export_data($key) $fields(value)]}" 00706 } 00707 00708 # Close the file 00709 close $rc 00710 00711 return 1 00712 00713 } 00714 00715 ###################################################################### 00716 # Generates a valid RGB color. 00717 proc normalize_color {color} { 00718 00719 if {[string index $color 0] eq "#"} { 00720 return [string range $color 0 6] 00721 } else { 00722 return $color 00723 } 00724 00725 } 00726 00727 ###################################################################### 00728 # Converts the given image. 00729 proc convert_image {value name} { 00730 00731 variable data 00732 00733 array set value_array $value 00734 00735 # Get the type of image to create from the value 00736 set value_type [expr {[info exists value_array(dat)] ? "bitmap" : "photo"}] 00737 00738 # If the image exists but is the wrong type, delete it 00739 if {[lsearch [image names] $name] != -1} { 00740 if {$value_type ne [image type $name]} { 00741 image delete $name 00742 image create $value_type $name 00743 } 00744 } else { 00745 image create $value_type $name 00746 } 00747 00748 # Configure the image 00749 if {$value_type eq "bitmap"} { 00750 if {[info exists value_array(bg)]} { 00751 lappend opts -background [get_image_color $value_array(bg)] 00752 } 00753 if {[info exists value_array(fg)]} { 00754 lappend opts -foreground [get_image_color $value_array(fg)] 00755 } 00756 foreach {field opt} [list dat -data msk -maskdata] { 00757 if {[info exists value_array($field)] && ($value_array($field) ne "")} { 00758 lappend opts $opt $value_array($field) 00759 } 00760 } 00761 $name configure {*}$opts 00762 } else { 00763 switch $value_array(dir) { 00764 install { $name configure -file [file join $::tke_dir lib images $value_array(file)] } 00765 user { $name configure -file [file join $::tke_home themes $data(name) $value_array(file)] } 00766 default { $name configure -file [file join $value_array(dir) $value_array(file)] } 00767 } 00768 } 00769 00770 return $name 00771 00772 } 00773 00774 ###################################################################### 00775 # Populates the themer category table with the stored theme information. 00776 proc populate_themer_category_table {tbl} { 00777 00778 variable data 00779 variable fields 00780 variable category_titles 00781 variable basecolor_map 00782 00783 # Make sure the basecolor_map is empty 00784 catch { array unset basecolor_map } 00785 00786 # Clear the table 00787 $tbl delete 0 end 00788 00789 # Insert the needed rows in the table 00790 foreach {category title} $category_titles { 00791 set parent [$tbl insertchild root end [list $title {} {} {}]] 00792 foreach name [lsort [array names data $category,*]] { 00793 set opt [lindex [split $name ,] 1] 00794 set row [$tbl insertchild $parent end [list $opt [lindex $data($name) $fields(value)] $category [eval [lindex $data($name) $fields(desc)]]]] 00795 switch [lindex $data($name) $fields(type)] { 00796 image { 00797 array set default_value [lindex $data($name) $fields(default)] 00798 $tbl cellconfigure $row,value \ 00799 -image [convert_image [lindex $data($name) $fields(value)] $opt] \ 00800 -background [lindex $data($default_value(basecolor)) $fields(value)] 00801 lappend basecolor_map($default_value(basecolor)) $row 00802 } 00803 color { 00804 set color [lindex $data($name) $fields(value)] 00805 $tbl cellconfigure $row,value \ 00806 -background $color \ 00807 -foreground [utils::get_complementary_mono_color $color] 00808 } 00809 } 00810 } 00811 } 00812 00813 } 00814 00815 ###################################################################### 00816 # Returns the row associated with the category and option. Returns an 00817 # error if the category/option could not be found. 00818 proc get_themer_category_table_row {tbl category opt} { 00819 00820 for {set i 0} {$i < [$tbl size]} {incr i} { 00821 if {([$tbl cellcget $i,category -text] eq $category) && ([$tbl cellcget $i,opt -text] eq $opt)} { 00822 return $i 00823 } 00824 } 00825 00826 return -code error "Unable to find category table row for (category: $category, opt: $opt)" 00827 00828 } 00829 00830 ###################################################################### 00831 # Updates the themer category table row. 00832 proc set_themer_category_table_row {tbl row value} { 00833 00834 variable data 00835 variable fields 00836 variable basecolor_map 00837 00838 # Get the category and option values 00839 set cat [$tbl cellcget $row,category -text] 00840 set opt [$tbl cellcget $row,opt -text] 00841 00842 # Update the tablelist 00843 $tbl cellconfigure $row,value -text $value 00844 00845 # Further modify the tablelist cell based on the type 00846 switch [lindex $data($cat,$opt) $fields(type)] { 00847 image { 00848 array set default_value [lindex $data($cat,$opt) $fields(default)] 00849 $tbl cellconfigure $row,value \ 00850 -image [convert_image $value $opt] \ 00851 -background [lindex $data($default_value(basecolor)) $fields(value)] 00852 } 00853 color { 00854 $tbl cellconfigure $row,value -background $value -foreground [utils::get_complementary_mono_color $value] 00855 if {[info exists basecolor_map($cat,$opt)]} { 00856 foreach img_row $basecolor_map($cat,$opt) { 00857 $tbl cellconfigure $img_row,value -background $value 00858 } 00859 } 00860 } 00861 } 00862 00863 # Update the theme data 00864 lset data($cat,$opt) $fields(value) $value 00865 lset data($cat,$opt) $fields(changed) 1 00866 00867 } 00868 00869 ###################################################################### 00870 # Returns a two-element list of all of the unique colors such that the 00871 # first list contains all swatch colors and the second list contains 00872 # all other colors not including the swatch colors. 00873 proc get_all_colors {} { 00874 00875 variable data 00876 variable fields 00877 00878 array set colors [list] 00879 00880 # Get all of the colors 00881 foreach key [array names data *,*] { 00882 if {[lindex $data($key) $fields(type)] eq "color"} { 00883 set colors([lindex $data($key) $fields(value)]) 1 00884 } 00885 } 00886 00887 # Remove the swatch colors 00888 foreach color $data(swatch) { 00889 unset -nocomplain colors($color) 00890 } 00891 00892 return [list $data(swatch) [array names colors]] 00893 00894 } 00895 00896 ###################################################################### 00897 # Returns a key/pair list containing the syntax colors to use for all 00898 # text widgets. Called by the syntax namespace when setting the 00899 # language. 00900 proc get_syntax_colors {} { 00901 00902 variable syntax 00903 00904 return [array get syntax] 00905 00906 } 00907 00908 ###################################################################### 00909 # Returns the name of the current theme. 00910 proc get_current_theme {} { 00911 00912 variable data 00913 00914 return $data(name) 00915 00916 } 00917 00918 ###################################################################### 00919 # Returns an array containing the available attribution information. 00920 # The valid attribution keys are: 00921 # - creator 00922 # - website 00923 # - date 00924 proc get_attributions {} { 00925 00926 variable data 00927 00928 set attr [list] 00929 00930 foreach item [list creator website date] { 00931 if {[info exists data($item)]} { 00932 lappend attr $item $data($item) 00933 } 00934 } 00935 00936 return $attr 00937 00938 } 00939 00940 ###################################################################### 00941 # Returns an array containing the file attributions. 00942 proc get_file_attributions {fname} { 00943 00944 if {[catch { open $fname r } rc]} { 00945 return -code error [format "%s %s" [msgcat::mc "ERROR: Unable to read"] $fname] 00946 } 00947 00948 # Read the contents of the file into 'contents' and close the file 00949 array set contents [read $rc] 00950 close $rc 00951 00952 # Gather the file attributions that are found 00953 array set attrs [list] 00954 foreach attr [list creator website date] { 00955 if {[info exists contents($attr)]} { 00956 set attrs($attr) $contents($attr) 00957 } 00958 } 00959 00960 return [array get attrs] 00961 00962 } 00963 00964 ###################################################################### 00965 # Returns all of the category titles. 00966 proc get_category_titles {} { 00967 00968 variable category_titles 00969 00970 set titles [list] 00971 00972 foreach {category title} $category_titles { 00973 lappend titles $title 00974 } 00975 00976 return $titles 00977 00978 } 00979 00980 ###################################################################### 00981 # Updates the current theme. 00982 proc update_theme {} { 00983 00984 variable widgets 00985 variable syntax 00986 variable colorizers 00987 00988 # Get the given syntax information 00989 array set syntax [get_category_options syntax 1] 00990 00991 # Remove theme values that aren't in the Appearance/Colorize array 00992 foreach name [::struct::set difference $colorizers [preferences::get Appearance/Colorize]] { 00993 set syntax($name) "" 00994 } 00995 00996 # Update the widgets 00997 foreach category [array names widgets] { 00998 update_$category 00999 } 01000 01001 } 01002 01003 ###################################################################### 01004 # Updates the syntax data for all text widgets. 01005 proc update_syntax {} { 01006 01007 variable widgets 01008 01009 # Update all of the syntax and scrollers 01010 foreach txt $widgets(syntax) { 01011 gui::update_theme $txt 01012 syntax::set_language $txt [syntax::get_language $txt] -highlight 0 01013 scroller::update_markers [winfo parent $txt].vb 01014 folding::update_closed $txt 01015 } 01016 01017 } 01018 01019 ###################################################################### 01020 # Update the theme for all split views. 01021 proc update_syntax_split {} { 01022 01023 variable widgets 01024 01025 # Update the split views 01026 foreach txt $widgets(syntax_split) { 01027 gui::update_theme $txt 01028 scroller::update_markers [winfo parent $txt].vb 01029 folding::update_closed $txt 01030 } 01031 01032 } 01033 01034 ###################################################################### 01035 # Updates the syntax data for all preference text widgets. 01036 proc update_syntax_prefs {} { 01037 01038 variable widgets 01039 01040 foreach txt $widgets(syntax_prefs) { 01041 pref_ui::update_theme $txt 01042 } 01043 01044 } 01045 01046 ###################################################################### 01047 # Updates the given tab bar. 01048 proc update_tabs {} { 01049 01050 update_widget tabs 01051 01052 } 01053 01054 ###################################################################### 01055 # Update 01056 proc update_text_scrollbar {} { 01057 01058 update_widget text_scrollbar 01059 01060 } 01061 01062 ###################################################################### 01063 # Updates the menus. 01064 proc update_menus {} { 01065 01066 variable widgets 01067 01068 # macOS will not allow menus to be fully themed, so just skip it 01069 if {[tk windowingsystem] eq "aqua"} { 01070 return 01071 } 01072 01073 set opts [get_category_options menus] 01074 01075 foreach mnu $widgets(menus) { 01076 update_menu_helper $mnu $opts 01077 } 01078 01079 } 01080 01081 ###################################################################### 01082 # Updates the sidebar with the given theme settings. 01083 proc update_sidebar {} { 01084 01085 variable widgets 01086 01087 # Get the options 01088 array set opts [get_category_options sidebar 1] 01089 01090 foreach w $widgets(sidebar) { 01091 $w tag configure sel -background $opts(-selectbackground) -foreground $opts(-selectforeground) 01092 $w tag configure moveto -background $opts(-movebackground) -foreground $opts(-moveforeground) 01093 [winfo parent [winfo parent $w]] configure \ 01094 -relief $opts(-relief) -highlightthickness $opts(-highlightthickness) \ 01095 -highlightbackground $opts(-highlightbackground) -highlightcolor $opts(-highlightcolor) 01096 $w.ins configure -background $opts(-movebackground) 01097 } 01098 01099 } 01100 01101 ###################################################################### 01102 # Updates the given sidebar scrollbar widget. 01103 proc update_sidebar_scrollbar {} { 01104 01105 update_widget sidebar_scrollbar 01106 01107 } 01108 01109 ###################################################################### 01110 # Updates the file information panel with the given theme settings. 01111 proc update_sidebar_info {} { 01112 01113 array set opts [get_category_options sidebar_info 1] 01114 01115 ipanel::update_theme $opts(-title_foreground) $opts(-value_foreground) $opts(-background) $opts(-active_background) 01116 01117 } 01118 01119 ###################################################################### 01120 # Updates the command launcher. 01121 proc update_launcher {} { 01122 01123 # Do nothing 01124 01125 } 01126 01127 ###################################################################### 01128 # Updates the images with the given settings. 01129 proc update_images {} { 01130 01131 variable data 01132 variable fields 01133 01134 # Convert all of the images 01135 foreach name [array names data images,*] { 01136 if {[lindex $data($name) $fields(changed)]} { 01137 convert_image [lindex $data($name) $fields(value)] [lindex [split $name ,] 1] 01138 lset data($name) $fields(changed) 0 01139 } 01140 } 01141 01142 } 01143 01144 ###################################################################### 01145 # Recursively sets the given menu's submenus to match the specified options. 01146 proc update_menu_helper {mnu opts} { 01147 01148 $mnu configure {*}$opts 01149 01150 if {[set last [$mnu index end]] ne "none"} { 01151 for {set i 0} {$i <= $last} {incr i} { 01152 if {[$mnu type $i] eq "cascade"} { 01153 update_menu_helper [$mnu entrycget $i -menu] $opts 01154 } 01155 } 01156 } 01157 01158 } 01159 01160 01161 ###################################################################### 01162 # Configures the given ttk name with the updated colors. 01163 proc update_ttk_style {} { 01164 01165 variable data 01166 01167 # Get the name of the ttk style currently in use 01168 set name [ttk::style theme use] 01169 01170 # Get the ttk style option/value pairs 01171 array set opts [get_category_options ttk_style 1] 01172 01173 # Get the sidebar option/value pairs 01174 array set sb_opts [get_category_options sidebar 1] 01175 01176 # Configure the theme 01177 ttk::style theme settings $name { 01178 01179 # Configure the application 01180 ttk::style configure "." \ 01181 -background $opts(background) \ 01182 -foreground $opts(foreground) \ 01183 -bordercolor $opts(border_color) \ 01184 -darkcolor $opts(dark_color) \ 01185 -troughcolor $opts(pressed_color) \ 01186 -arrowcolor $opts(foreground) \ 01187 -selectbackground $opts(select_background) \ 01188 -selectforeground $opts(select_foreground) \ 01189 -selectborderwidth 0 \ 01190 -font TkDefaultFont 01191 ttk::style map "." \ 01192 -background [list disabled $opts(disabled_background) \ 01193 active $opts(active_color)] \ 01194 -foreground [list disabled $opts(disabled_foreground)] \ 01195 -selectbackground [list !focus $opts(border_color)] \ 01196 -selectforeground [list !focus white] 01197 01198 # Configure TButton widgets 01199 ttk::style configure TButton \ 01200 -anchor center -width -11 -padding 5 -relief raised -background $opts(background) -foreground $opts(foreground) 01201 ttk::style map TButton \ 01202 -background [list disabled $opts(disabled_background) \ 01203 pressed $opts(pressed_color) \ 01204 active $opts(active_color)] \ 01205 -lightcolor [list pressed $opts(pressed_color)] \ 01206 -darkcolor [list pressed $opts(pressed_color)] \ 01207 -bordercolor [list alternate "#000000"] 01208 01209 # Configure BButton widgets 01210 ttk::style configure BButton \ 01211 -anchor center -padding 2 -relief $opts(relief) -background $opts(background) -foreground $opts(foreground) 01212 ttk::style map BButton \ 01213 -background [list disabled $opts(disabled_background) \ 01214 pressed $opts(pressed_color) \ 01215 active $opts(active_color)] \ 01216 -lightcolor [list pressed $opts(pressed_color)] \ 01217 -darkcolor [list pressed $opts(pressed_color)] \ 01218 -bordercolor [list alternate "#000000"] 01219 01220 # Configure HLabel widgets 01221 ttk::style configure HLabel \ 01222 -foreground $opts(disabled_foreground) 01223 01224 # Configure ttk::menubutton widgets 01225 ttk::style configure TMenubutton \ 01226 -width 0 -padding 0 -relief $opts(relief) -background $opts(background) -foreground $opts(foreground) 01227 ttk::style map TMenubutton \ 01228 -background [list disabled $opts(disabled_background) \ 01229 pressed $opts(pressed_color) \ 01230 active $opts(active_color)] \ 01231 -lightcolor [list pressed $opts(pressed_color)] \ 01232 -darkcolor [list pressed $opts(pressed_color)] \ 01233 -bordercolor [list alternate "#000000"] 01234 01235 # Configure ttk::radiobutton widgets 01236 ttk::style configure TRadiobutton \ 01237 -width 0 -padding 0 -relief $opts(relief) -background $opts(background) -foreground $opts(foreground) 01238 ttk::style map TRadiobutton \ 01239 -background [list disabled $opts(disabled_background) \ 01240 active $opts(active_color)] 01241 01242 # Configure ttk::entry widgets 01243 ttk::style configure TEntry -padding 1 -insertwidth 1 -foreground black 01244 ttk::style map TEntry \ 01245 -bordercolor [list focus $opts(entry_border) \ 01246 alternate green] \ 01247 -lightcolor [list focus "#6f9dc6"] \ 01248 -darkcolor [list focus "#6f9dc6"] 01249 01250 # Configure ttk::scrollbar widgets 01251 ttk::style configure TScrollbar \ 01252 -relief $opts(relief) -troughcolor $opts(active_color) 01253 ttk::style map TScrollbar \ 01254 -background [list disabled $opts(disabled_background) \ 01255 active $opts(background)] 01256 01257 # Configure ttk::labelframe widgets 01258 ttk::style configure TLabelframe \ 01259 -labeloutside true -labelmargins {0 0 0 4} -borderwidth 2 -relief raised 01260 01261 # Configure ttk::spinbox widgets 01262 ttk::style configure TSpinbox \ 01263 -relief $opts(relief) -padding {2 0} -background $opts(active_color) -foreground $opts(foreground) \ 01264 -fieldbackground $opts(active_color) -darkcolor $opts(active_color) -lightcolor $opts(active_color) \ 01265 -bordercolor $opts(active_color) 01266 ttk::style layout TSpinbox { 01267 Entry.field -side top -sticky we -children { 01268 Entry.background -sticky nswe -children { 01269 Horizontal.Scrollbar.leftarrow -side left -sticky ns 01270 Horizontal.Scrollbar.rightarrow -side right -sticky ns 01271 Spinbox.padding -sticky nswe -children { 01272 Spinbox.textarea -sticky nswe 01273 } 01274 } 01275 } 01276 } 01277 01278 # Configure ttk::checkbutton widgets 01279 ttk::style configure TCheckbutton \ 01280 -relief $opts(relief) -padding 2 -background $opts(background) -foreground $opts(foreground) 01281 ttk::style map TCheckbutton \ 01282 -background [list disabled $opts(disabled_background) \ 01283 pressed $opts(pressed_color) \ 01284 active $opts(active_color)] \ 01285 -lightcolor [list pressed $opts(pressed_color)] \ 01286 -darkcolor [list pressed $opts(pressed_color)] \ 01287 -bordercolor [list alternate "#000000"] 01288 01289 # Configure ttk::combobox widgets 01290 ttk::style configure TCombobox \ 01291 -relief $opts(relief) -fieldbackground white -foreground black 01292 ttk::style map TCombobox \ 01293 -background [list disabled $opts(disabled_background) \ 01294 pressed $opts(pressed_color) \ 01295 active $opts(active_color)] 01296 01297 # Configure panedwindow sash widgets 01298 ttk::style configure Sash -sashthickness $opts(grip_thickness) -gripcount $opts(grip_count) 01299 01300 # Configure separator 01301 ttk::style configure TSeparator -relief raised 01302 01303 # Configure TNotebook widgets 01304 ttk::style configure TNotebook.Tab -padding {10 3} -relief flat 01305 01306 # Configure Treeview widgets 01307 ttk::style configure Treeview -fieldbackground $opts(background) 01308 ttk::style layout Treeview { 01309 Treeview.treearea -sticky news 01310 } 01311 01312 # Configure Sidebar tree widget 01313 ttk::style configure SBTreeview -fieldbackground $sb_opts(-background) \ 01314 -background $sb_opts(-background) -foreground $sb_opts(-foreground) 01315 ttk::style configure SBFrame -background $sb_opts(-background) 01316 ttk::style layout SBTreeview { 01317 Treeview.treearea -sticky news 01318 } 01319 catch { 01320 ttk::style element create SBTreeitem.indicator image { 01321 sidebar_collapsed 01322 {!user1 !user2 !selected} sidebar_collapsed 01323 { user1 !user2 !selected} sidebar_expanded 01324 {!user1 !user2 selected} sidebar_collapsed_sel 01325 { user1 !user2 selected} sidebar_expanded_sel 01326 {!user1 user2 selected} sidebar_collapsed_sel 01327 { user1 user2} sidebar_file 01328 } -width 15 -sticky w 01329 } 01330 ttk::style layout SBTreeview.Item { 01331 Treeitem.padding -sticky nswe -children { 01332 SBTreeitem.indicator -side left -sticky {} 01333 Treeitem.image -side left -sticky {} 01334 Treeitem.text -side left -sticky {} 01335 } 01336 } 01337 01338 } 01339 01340 } 01341 01342 ###################################################################### 01343 # Updates the miscellaneous scrollbar widgets. 01344 proc update_misc_scrollbar {} { 01345 01346 update_widget misc_scrollbar 01347 01348 } 01349 01350 ###################################################################### 01351 # Shared procedure used to configure all widgets of the given type. 01352 proc update_widget {type} { 01353 01354 variable widgets 01355 01356 # Get the options 01357 set opts [get_category_options $type 1] 01358 01359 # Configure all widgets of the given type 01360 foreach w $widgets($type) { 01361 $w configure {*}$opts 01362 } 01363 01364 } 01365 01366 ###################################################################### 01367 # Returns the category widget options for the given category. 01368 proc get_category_options {category {all 0}} { 01369 01370 variable data 01371 variable fields 01372 01373 set opts [list] 01374 01375 # Get the list of options to pass to sidebar tablelist 01376 foreach name [array names data $category,*] { 01377 if {$all || [lindex $data($name) $fields(changed)]} { 01378 lappend opts [lindex [split $name ,] 1] [lindex $data($name) $fields(value)] 01379 lset data($name) $fields(changed) 0 01380 } 01381 } 01382 01383 return $opts 01384 01385 } 01386 01387 ###################################################################### 01388 # Returns the list of swatches for this theme. 01389 proc swatch_do {action args} { 01390 01391 variable data 01392 01393 switch $action { 01394 get { return $data(swatch) } 01395 set { lset data(swatch) [lindex $args 0] [lindex $args 1] } 01396 append { lappend data(swatch) {*}$args } 01397 delete { set data(swatch) [lreplace $data(swatch) [lindex $args 0] [lindex $args 0]] } 01398 clear { set data(swatch) [list] } 01399 length { return [llength $data(swatch)] } 01400 index { return [lindex $data(swatch) [lindex $args 0]] } 01401 default { return -code error "Unknown swatch action" } 01402 } 01403 01404 } 01405 01406 ###################################################################### 01407 # Returns the meta information for the theme. 01408 proc meta_do {action category opt args} { 01409 01410 variable data 01411 01412 # Create the lookup key 01413 set key meta,$category,$opt 01414 01415 switch $action { 01416 exists { return [info exists data($key)] } 01417 get { return $data($key) } 01418 set { set data($key) [lindex $args 0] } 01419 delete { unset -nocomplain data($key) } 01420 } 01421 01422 } 01423 01424 ###################################################################### 01425 # Returns the value for the given category option. 01426 proc get_value {category opt} { 01427 01428 variable data 01429 variable fields 01430 01431 if {![info exists data($category,$opt)]} { 01432 return -code error "Unknown category/option specified ($category $opt)" 01433 } 01434 01435 return [lindex $data($category,$opt) $fields(value)] 01436 01437 } 01438 01439 ###################################################################### 01440 # Returns the type for the given category option. 01441 proc get_type {category opt} { 01442 01443 variable data 01444 variable fields 01445 01446 if {![info exists data($category,$opt)]} { 01447 return -code error "Unknown category/option specified ($category $opt)" 01448 } 01449 01450 return [lindex $data($category,$opt) $fields(type)] 01451 01452 } 01453 01454 ###################################################################### 01455 # Initializes the themes list. 01456 proc create_ttk_theme {name} { 01457 01458 # Create the theme 01459 ttk::style theme create $name -parent clam 01460 01461 } 01462 01463 }