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 }
