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: pref_ui.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 5/14/2016 00022 # Brief: Contains namespace that displays preference UI. 00023 ###################################################################### 00024 00025 namespace eval pref_ui { 00026 00027 variable current_panel "" 00028 variable selected_session "" 00029 variable selected_language "" 00030 variable mod_dict 00031 variable sym_dict 00032 variable enable_share 00033 variable share_changed 00034 variable initialize_callbacks {} 00035 00036 array set widgets {} 00037 array set match_chars {} 00038 array set snip_compl {} 00039 array set snip_data {} 00040 array set prefs {} 00041 array set colorizers { 00042 keywords 0 00043 functions 0 00044 variables 0 00045 comments 0 00046 strings 0 00047 numbers 0 00048 punctuation 0 00049 precompile 0 00050 miscellaneous1 0 00051 miscellaneous2 0 00052 miscellaneous3 0 00053 } 00054 array set attributes { 00055 preview 0 00056 syntax 0 00057 filesize 0 00058 imagesize 0 00059 modified 0 00060 permissions 0 00061 owner 0 00062 group 0 00063 linecount 0 00064 wordcount 0 00065 charcount 0 00066 readtime 0 00067 md5 0 00068 sha1 0 00069 sha224 0 00070 sha256 0 00071 favorite 0 00072 version 0 00073 } 00074 00075 if {[catch { ttk::spinbox .__tmp }]} { 00076 set bg [utils::get_default_background] 00077 set fg [utils::get_default_foreground] 00078 set widgets(sb) "spinbox" 00079 set widgets(sb_opts) "-relief flat -buttondownrelief flat -buttonuprelief flat -background $bg -foreground $fg" 00080 } else { 00081 set widgets(sb) "ttk::spinbox" 00082 set widgets(sb_opts) "-justify center" 00083 destroy .__tmp 00084 } 00085 00086 ###################################################################### 00087 # Register the given initialization callback. 00088 proc register_initialization {cmd} { 00089 00090 variable initialize_callbacks 00091 00092 lappend initialize_callbacks $cmd 00093 00094 } 00095 00096 ###################################################################### 00097 # Initializes all of the widgets. 00098 proc initialize_widgets {} { 00099 00100 variable initialize_callbacks 00101 00102 foreach callback $initialize_callbacks { 00103 uplevel #0 $callback 00104 } 00105 00106 } 00107 00108 ###################################################################### 00109 # Returns the grid row to insert the given widget into. Also has the 00110 # side-effect of configuring the grid layout if we are the first child 00111 # to be placed. 00112 proc get_grid_row {w} { 00113 00114 lassign [grid size [winfo parent $w]] col row 00115 00116 # If we are the first row, configure the grid 00117 if {$row == 0} { 00118 grid columnconfigure [winfo parent $w] 3 -weight 1 00119 } 00120 00121 return $row 00122 00123 } 00124 00125 ###################################################################### 00126 # Make a horizontal spacer. 00127 proc make_spacer {w {grid 0}} { 00128 00129 set win [ttk::label $w.spacer[llength [lsearch -all [winfo children $w] $w.spacer*]]] 00130 00131 if {$grid} { 00132 grid $win -row [get_grid_row $win] -column 0 -sticky ew -columnspan 4 00133 } else { 00134 pack $win -fill x 00135 } 00136 00137 return $win 00138 00139 } 00140 00141 ###################################################################### 00142 # Make a checkbutton. 00143 proc make_cb {w msg varname {grid 0}} { 00144 00145 # Create the widget 00146 ttk::checkbutton $w -text [format " %s" $msg] -variable pref_ui::prefs($varname) 00147 00148 # Pack the widget 00149 if {$grid} { 00150 grid $w -row [get_grid_row $w] -column 0 -sticky ew -columnspan 4 -padx 2 -pady 2 00151 } else { 00152 pack $w -fill x -padx 2 -pady 2 00153 } 00154 00155 # Register the widget for search 00156 register $w $msg $varname 00157 00158 return $w 00159 00160 } 00161 00162 ###################################################################### 00163 # Make a radiobutton. 00164 proc make_rb {w msg varname value {grid 0}} { 00165 00166 # Create the widget 00167 ttk::radiobutton $w -text [format " %s" $msg] -variable pref_ui::prefs($varname) -value $value 00168 00169 # Pack the widget 00170 if {$grid} { 00171 grid $w -row [get_grid_row $w] -column 0 -sticky ew -columnspan 4 -padx 2 -pady 2 00172 } else { 00173 pack $w -fill x -padx 2 -pady 2 00174 } 00175 00176 # Register the widget for search 00177 register $w $msg $varname 00178 00179 return $w 00180 00181 } 00182 00183 ###################################################################### 00184 # Make a menubutton. 00185 proc make_mb {w msg varname values {grid 0}} { 00186 00187 # Create and pack the widget 00188 if {$grid} { 00189 ttk::label ${w}l -text $msg 00190 set win [ttk::menubutton ${w}mb -textvariable pref_ui::prefs($varname) \ 00191 -menu [set mnu [menu ${w}mbMenu -tearoff 0]]] 00192 set row [get_grid_row ${w}l] 00193 grid ${w}l -row $row -column 0 -sticky news -padx 2 -pady 2 00194 grid ${w}mb -row $row -column 1 -sticky news -columnspan 2 -padx 2 -pady 2 00195 } else { 00196 pack [ttk::frame $w] -fill x 00197 pack [ttk::label $w.l -text $msg] -side left -padx 2 -pady 2 00198 pack [set win [ttk::menubutton $w.mb -textvariable pref_ui::prefs($varname) \ 00199 -menu [set mnu [menu $w.mbMenu -tearoff 0]]]] -side left -padx 2 -pady 2 00200 } 00201 00202 # Populate the menu 00203 init_mb $win $varname $values 00204 00205 # Register the widget 00206 register $win $msg $varname 00207 00208 return $win 00209 00210 } 00211 00212 ###################################################################### 00213 # Initializes the menubutton's menu with the given set of values. 00214 proc init_mb {w varname values} { 00215 00216 # Get the menu from the menubutton 00217 set mnu [$w cget -menu] 00218 00219 # Clear the menu 00220 $mnu delete 0 end 00221 00222 foreach value $values { 00223 $mnu add radiobutton -label $value -variable pref_ui::prefs($varname) -value $value 00224 } 00225 00226 } 00227 00228 ###################################################################### 00229 # Make an entry. 00230 proc make_entry {w msg varname {grid 0} {help ""}} { 00231 00232 # Create the widget 00233 ttk::labelframe $w -text $msg 00234 pack [ttk::entry $w.e -textvariable pref_ui::prefs($varname)] -fill x 00235 if {$help ne ""} { 00236 make_help $w $help 00237 } 00238 00239 # Pack the widget 00240 if {$grid} { 00241 grid $w -row [get_grid_row $w] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00242 } else { 00243 pack $w -fill x -padx 2 -pady 2 00244 } 00245 00246 # Register the widget for search 00247 register $w.e $msg $varname 00248 00249 return $w.e 00250 00251 } 00252 00253 ###################################################################### 00254 # Make a tokenentry field. 00255 proc make_token {w msg varname watermark {grid 0} {help ""}} { 00256 00257 # Create the widget 00258 ttk::labelframe $w -text $msg 00259 pack [tokenentry::tokenentry $w.te -tokenvar pref_ui::prefs($varname) \ 00260 -watermark $watermark -tokenshape square] -fill x 00261 00262 if {$help ne ""} { 00263 make_help $w $help 00264 } 00265 00266 # Pack the widget 00267 if {$grid} { 00268 grid $w -row [get_grid_row $w] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00269 } else { 00270 pack $w -fill x -padx 2 -pady 2 00271 } 00272 00273 # Initialize the widget 00274 register_initialization [list pref_ui::init_token $w.te $varname] 00275 00276 # Register the widget for search 00277 register $w.te $msg $varname 00278 00279 return $w.te 00280 00281 } 00282 00283 ###################################################################### 00284 # Initializes the given tokenentry widget. 00285 proc init_token {w varname} { 00286 00287 $w tokendelete 0 end 00288 $w tokeninsert end $pref_ui::prefs($varname) 00289 00290 } 00291 00292 ###################################################################### 00293 # Make a text field. 00294 proc make_text {w msg varname height {grid 0} {help ""}} { 00295 00296 ttk::labelframe $w -text $msg 00297 text $w.t -height $height -borderwidth 0 -highlightthickness 0 \ 00298 -xscrollcommand [list utils::set_xscrollbar $w.hb] -yscrollcommand [list utils::set_yscrollbar $w.vb] 00299 scroller::scroller $w.vb -orient vertical -command [list $w.t yview] 00300 scroller::scroller $w.hb -orient horizontal -command [list $w.t xview] 00301 ttk::frame $w.bf 00302 pack [ttk::button $w.bf.save -style BButton -text [msgcat::mc "Save"] -command [list pref_ui::text_save $w.t $varname] -state disabled] -side left -padx 2 -pady 2 00303 00304 bind $w.t <<Modified>> [list pref_ui::text_modified $w] 00305 00306 grid rowconfigure $w 0 -weight 1 00307 grid columnconfigure $w 0 -weight 1 00308 grid $w.t -row 0 -column 0 -sticky news 00309 grid $w.vb -row 0 -column 1 -sticky ns 00310 grid $w.hb -row 1 -column 0 -sticky ew 00311 grid $w.bf -row 2 -column 0 -sticky ew 00312 00313 if {$help ne ""} { 00314 make_help $w $help 1 00315 } 00316 00317 # Register the widget for initialization 00318 register_initialization [list pref_ui::init_text $w.t $varname] 00319 00320 if {$grid} { 00321 grid $w -row [get_grid_row $w] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00322 } else { 00323 pack $w -fill both -expand yes -padx 2 -pady 2 00324 } 00325 00326 # Register the widget for search 00327 register $w.t $msg $varname 00328 00329 return $w.t 00330 00331 } 00332 00333 ###################################################################### 00334 # Initializes the given text widget. 00335 proc init_text {w varname} { 00336 00337 # Inser the text 00338 $w delete 1.0 end 00339 $w insert end $pref_ui::prefs($varname) 00340 00341 # Set the edit status to false 00342 $w edit modified 0 00343 00344 # Redisable the Save button 00345 [winfo parent $w].bf.save configure -state disabled 00346 00347 } 00348 00349 ###################################################################### 00350 # Make the Save button visible. 00351 proc text_modified {w} { 00352 00353 if {[$w.t edit modified]} { 00354 $w.bf.save configure -state normal 00355 } 00356 00357 } 00358 00359 ###################################################################### 00360 # Causes the text to be saved. 00361 proc text_save {w varname} { 00362 00363 # Clear the modified state 00364 $w edit modified 0 00365 00366 # Disable the save button 00367 [winfo parent $w].bf.save configure -state disabled 00368 00369 # Set the preferences 00370 set pref_ui::prefs($varname) [$w get 1.0 end-1c] 00371 00372 } 00373 00374 ###################################################################### 00375 # Make a spinbox. 00376 proc make_sb {w msg varname from to inc {grid 0} {endmsg ""}} { 00377 00378 variable widgets 00379 00380 if {$grid} { 00381 ttk::label ${w}l -text [format "%s: " $msg] 00382 set win [$widgets(sb) ${w}sb {*}$widgets(sb_opts) -from $from -to $to -increment $inc \ 00383 -width [string length $to] -state readonly -command [list pref_ui::handle_sb_change ${w}sb $varname]] 00384 set row [get_grid_row ${w}l] 00385 grid ${w}l -row $row -column 0 -sticky news -padx 2 -pady 2 00386 grid ${w}sb -row $row -column 1 -sticky news -padx 2 -pady 2 00387 if {$endmsg ne ""} { 00388 grid [ttk::label ${w}l2 -text $endmsg] -row $row -column 2 -sticky news -padx 2 -pady 2 00389 } 00390 } else { 00391 pack [ttk::frame $w] -fill x 00392 pack [ttk::label $w.l -text [format "%s: " $msg]] -side left -padx 2 -pady 2 00393 pack [set win [$widgets(sb) $w.sb {*}$widgets(sb_opts) -from $from -to $to -increment $inc \ 00394 -width [string length $to] -state readonly -command [list pref_ui::handle_sb_change $w.sb $varname]]] -side left -padx 2 -pady 2 00395 if {$endmsg ne ""} { 00396 pack [ttk::label $w.l2 -text $endmsg] -side left -padx 2 -pady 2 00397 } 00398 } 00399 00400 # Add the widget to the initialize_callbacks array 00401 register_initialization [list pref_ui::init_sb $win $varname] 00402 00403 # Register the widget 00404 register $win $msg $varname 00405 00406 return $win 00407 00408 } 00409 00410 ###################################################################### 00411 # Initializes the given spinbox widget. 00412 proc init_sb {w varname} { 00413 00414 $w set $pref_ui::prefs($varname) 00415 00416 } 00417 00418 ###################################################################### 00419 # Sets the current spinbox value. 00420 proc handle_sb_change {w varname} { 00421 00422 set pref_ui::prefs($varname) [$w get] 00423 00424 } 00425 00426 ###################################################################### 00427 # Create a color-picker widget. 00428 proc make_cp {w msg varname start_color {grid 0}} { 00429 00430 # Create the bitmap containing the color 00431 set img [image create bitmap -file [file join $::tke_dir lib images color_box.bmp] -background $start_color -foreground black] 00432 00433 # Create the widget 00434 if {$grid} { 00435 ttk::label ${w}l -text [format "%s: " $msg] 00436 set win [ttk::button ${w}b -style BButton -image $img -command [list pref_ui::change_cp ${w}b $varname]] 00437 set row [get_grid_row ${w}l] 00438 grid ${w}l -row $row -column 0 -sticky news -padx 2 -pady 2 00439 grid ${w}b -row $row -column 1 -sticky news -padx 2 -pady 2 00440 } else { 00441 pack [ttk::label $w] -fill x 00442 pack [ttk::label $w.l -text [format "%s: " $msg]] -side left -padx 2 -pady 2 00443 pack [set win [ttk::button $w.b -style BButton -image $img -command [list pref_ui::change_cp $w.b $varname]]] -side left -padx 2 -pady 2 00444 } 00445 00446 # Add the widget to the initialize_callbacks array 00447 register_initialization [list pref_ui::init_cp $win $varname] 00448 00449 # Register the widget 00450 register $win $msg $varname 00451 00452 return $win 00453 00454 } 00455 00456 ###################################################################### 00457 # Initializes the given color picker widget. 00458 proc init_cp {w varname} { 00459 00460 [$w cget -image] configure -background $pref_ui::prefs($varname) 00461 00462 } 00463 00464 ###################################################################### 00465 # Allows the user to change the color for the color picket widget. 00466 proc change_cp {w varname} { 00467 00468 # Get the default color 00469 set color [tk_chooseColor -initialcolor [[$w cget -image] cget -background] -parent .prefwin -title [msgcat::mc "Choose Color"]] 00470 00471 if {$color ne ""} { 00472 set pref_ui::prefs($varname) $color 00473 init_cp $w $varname 00474 } 00475 00476 } 00477 00478 ###################################################################### 00479 # Make a file picker widget. 00480 proc make_fp {w msg varname type {type_args {}} {grid 0} {help ""}} { 00481 00482 # Create the widget 00483 set frame [ttk::labelframe $w -text $msg] 00484 pack [set win [ttk::label $w.l]] -side left -fill x -padx 2 -pady 2 00485 pack [ttk::button $w.c -style BButton -text [msgcat::mc "Clear"] -command [list pref_ui::fp_clear $w $varname]] -side right -padx 2 -pady 2 00486 pack [ttk::button $w.b -style BButton -text [format "%s..." [msgcat::mc "Browse"]] -command [list pref_ui::fp_browse $w $varname $type $type_args]] -side right -padx 2 -pady 2 00487 00488 if {$help ne ""} { 00489 make_help $w $help 00490 } 00491 00492 if {$grid} { 00493 grid $w -row [get_grid_row $w] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00494 } else { 00495 pack $w -fill x -padx 2 -pady 2 00496 } 00497 00498 # Add the widget to the initialize_callbacks array 00499 register_initialization [list pref_ui::init_fp $w $varname] 00500 00501 # Register the widget 00502 register $win $msg $varname 00503 00504 return $win 00505 00506 } 00507 00508 ###################################################################### 00509 # Initializes the given file picker widget. 00510 proc init_fp {w varname} { 00511 00512 $w.l configure -text $pref_ui::prefs($varname) 00513 00514 if {$pref_ui::prefs($varname) eq ""} { 00515 $w.c configure -state disabled 00516 } else { 00517 $w.c configure -state normal 00518 } 00519 00520 } 00521 00522 ###################################################################### 00523 # Opens the open/save/directory dialog window and updates the given 00524 # window if it is selected by the user. 00525 proc fp_browse {win varname type type_args} { 00526 00527 array set type_args_array $type_args 00528 00529 set type_args_array(-parent) .prefwin 00530 00531 # Override the -initialdir value if the value was previously set 00532 if {[set value [$win.l cget -text]] ne ""} { 00533 set type_args_array(-initialdir) [file dirname $value] 00534 } 00535 00536 switch $type { 00537 open { 00538 set type_args_array(-multiple) 0 00539 set ans [tk_getOpenFile {*}[array get type_args_array]] 00540 } 00541 save { 00542 set type_args_array(-initialfile) $value 00543 set ans [tk_getOpenFile {*}[array get type_args_array]] 00544 } 00545 default { 00546 set ans [tk_chooseDirectory {*}[array get type_args_array]] 00547 } 00548 } 00549 00550 # Configure the label and set the preference value 00551 if {$ans ne ""} { 00552 set pref_ui::prefs($varname) $ans 00553 init_fp $win $varname 00554 } 00555 00556 } 00557 00558 ###################################################################### 00559 # Clears the contents of the widget. 00560 proc fp_clear {win varname} { 00561 00562 # Clear the preference value 00563 set pref_ui::prefs($varname) "" 00564 00565 # Set the filepicker state 00566 init_fp $win $varname 00567 00568 } 00569 00570 ###################################################################### 00571 # Creates a simple table widget that allows the user to add, delete 00572 # and edit table cells that contain text. 00573 proc make_table {w msg varname columns height {grid 0} {help ""}} { 00574 00575 set tl_cols [list] 00576 set cols [list] 00577 00578 # Sort out the column information 00579 foreach column $columns { 00580 set args [lassign $column title] 00581 array set opts { 00582 -width 0 00583 -type "text" 00584 -editable 1 00585 -value "" 00586 -values {} 00587 } 00588 array set opts $args 00589 lappend cols [array get opts] 00590 lappend tl_cols $opts(-width) $title 00591 array unset opts 00592 } 00593 00594 ttk::labelframe $w -text $msg 00595 set win [tablelist::tablelist $w.tl -columns $tl_cols \ 00596 -stretch all -editselectedonly 1 -exportselection 0 -showseparators 1 \ 00597 -height $height -borderwidth 0 -highlightthickness 0 \ 00598 -editstartcommand [list pref_ui::table_edit_start_command $varname $cols] \ 00599 -editendcommand [list pref_ui::table_edit_end_command $varname $cols] \ 00600 -xscrollcommand [list utils::set_xscrollbar $w.hb] \ 00601 -yscrollcommand [list utils::set_yscrollbar $w.vb]] 00602 scroller::scroller $w.vb -orient vertical -command [list $w.tl yview] 00603 scroller::scroller $w.hb -orient horizontal -command [list $w.tl xview] 00604 ttk::frame $w.bf 00605 pack [ttk::button $w.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::table_add $win $cols $varname]] -side left -padx 2 -pady 2 00606 pack [ttk::button $w.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::table_delete $win $varname] -state disabled] -side left -padx 2 -pady 2 00607 00608 utils::tablelist_configure $win 00609 00610 for {set i 0} {$i < [$win columncount]} {incr i} { 00611 array set opts [lindex $cols $i] 00612 switch $opts(-type) { 00613 text { $win columnconfigure $i -editable $opts(-editable) -resizable 1 -stretchable 1 } 00614 checkbutton { $win columnconfigure $i -editable 0 -resizable 0 -stretchable 0 -formatcommand [list pref_ui::empty_string] } 00615 menubutton { $win columnconfigure $i -editable 1 -resizable 0 -stretchable 1 -editwindow menubutton } 00616 } 00617 } 00618 00619 bind $win <<TablelistSelect>> [list pref_ui::table_selected $win] 00620 bind [$win bodytag] <Button-1> [list pref_ui::table_left_click %W $cols %x %y $varname] 00621 00622 grid rowconfigure $w 1 -weight 1 00623 grid columnconfigure $w 0 -weight 1 00624 grid $w.tl -row 0 -column 0 -sticky news -rowspan 2 00625 grid [$w.tl cornerpath] -row 0 -column 1 -sticky news 00626 grid $w.vb -row 1 -column 1 -sticky ns 00627 grid $w.hb -row 2 -column 0 -sticky ew 00628 grid $w.bf -row 3 -column 0 -sticky ew -columnspan 2 00629 00630 if {$help ne ""} { 00631 make_help $w $help 1 00632 } 00633 00634 if {$grid} { 00635 grid $w -row [get_grid_row $w] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00636 } else { 00637 pack $w -fill both -expand yes -padx 2 -pady 2 00638 } 00639 00640 # Add the widget to the initialize_callbacks array 00641 register_initialization [list pref_ui::init_table $win $varname $cols] 00642 00643 # Register the widget 00644 register $win $msg $varname 00645 00646 return $win 00647 00648 } 00649 00650 ###################################################################### 00651 # Initialize the table 00652 proc init_table {w varname cols} { 00653 00654 # Clear the table 00655 $w delete 0 end 00656 00657 # Insert the contents into the table 00658 foreach row $pref_ui::prefs($varname) { 00659 $w insert end $row 00660 } 00661 00662 # Set checkbutton images, if necessary 00663 set column 0 00664 foreach col $cols { 00665 array set opts $col 00666 if {$opts(-type) eq "checkbutton"} { 00667 for {set i 0} {$i < [$w size]} {incr i} { 00668 $w cellconfigure $i,$column -image [expr {[$w cellcget $i,$column -text] ? "pref_checked" : "pref_unchecked"}] 00669 } 00670 } 00671 incr column 00672 } 00673 00674 } 00675 00676 ###################################################################### 00677 # Adds a new entry to the table and makes the first cell editable. 00678 proc table_add {w cols varname} { 00679 00680 set index 0 00681 set ccols [list] 00682 00683 # Get the list of values to insert 00684 foreach col $cols { 00685 array set opts $col 00686 lappend values $opts(-value) 00687 if {$opts(-type) eq "checkbutton"} { 00688 lappend ccols $index 00689 } 00690 incr index 00691 } 00692 00693 # Add the entry to the table at the end 00694 set row [$w insert end $values] 00695 00696 # Make all of the checkboxes look right 00697 foreach ccol $ccols { 00698 $w cellconfigure $row,$ccol -image [expr {[$w cellcget $row,$ccol -text] ? "pref_checked" : "pref_unchecked"}] 00699 } 00700 00701 # Make the first cell editable and in view 00702 $w see $row 00703 $w editcell $row,0 00704 00705 # Save the contents to a file in case nothing is edited 00706 set pref_ui::prefs($varname) [$w get 0 end] 00707 00708 } 00709 00710 ###################################################################### 00711 # Deletes the currently selected table row. 00712 proc table_delete {w varname} { 00713 00714 # Delete the currently selected row 00715 $w delete [$w curselection] 00716 00717 # Disable the delete button 00718 [winfo parent $w].bf.del configure -state disabled 00719 00720 # Save the preferences 00721 set pref_ui::prefs($varname) [$w get 0 end] 00722 00723 } 00724 00725 ###################################################################### 00726 # Called when the table is selected. 00727 proc table_selected {w} { 00728 00729 [winfo parent $w].bf.del configure -state normal 00730 00731 } 00732 00733 ###################################################################### 00734 # Handles a left click on the table. 00735 proc table_left_clicked {w cols x y varname} { 00736 00737 lassign [tablelist::convEventFields $w $x $y] tbl x y 00738 lassign [split [$tbl containingcell $x $y] ,] row col 00739 00740 if {$row >= 0} { 00741 array set opts [lindex $cols $col] 00742 if {$opts(-type) eq "checkbutton"} { 00743 if {[$tbl cellcget $row,$col -text]} { 00744 $tbl cellconfigure $row,$col -text 0 -image pref_unchecked 00745 } else { 00746 $tbl cellconfigure $row,$col -text 1 -image pref_checked 00747 } 00748 set pref_ui::prefs($varname) [$tbl get 0 end] 00749 } 00750 } 00751 00752 } 00753 00754 ###################################################################### 00755 # Called when a table cell is going to start being edited. 00756 proc table_edit_start_command {varname cols w row col value} { 00757 00758 array set opts [lindex $cols $col] 00759 00760 switch $opts(-type) { 00761 menubutton { 00762 set mnu [[$w editwinpath] cget -menu] 00763 foreach value $opts(-values) { 00764 $mnu add radiobutton -label $value 00765 } 00766 } 00767 } 00768 00769 return $value 00770 00771 } 00772 00773 ###################################################################### 00774 # Called when a table cell has been edited. 00775 proc table_edit_end_command {varname cols w row col value} { 00776 00777 # Get the table contents 00778 set contents [$w get 0 end] 00779 lset contents $row $col $value 00780 00781 # Save the changes to the preferences 00782 set pref_ui::prefs($varname) $contents 00783 00784 return $value 00785 00786 } 00787 00788 ###################################################################### 00789 # Creates a documentation widget. This displays textual help information 00790 # to describe a particular option or otherwise provide helpful information 00791 # to the user. 00792 proc make_help {w msg {grid 0}} { 00793 00794 set win [ttk::frame $w.help[llength [lsearch -all [winfo children $w] $w.help*]]] 00795 pack [ttk::label $win.t -text " "] -side left -padx 2 -pady 2 00796 pack [ttk::label $win.l -style HLabel -wraplength 500 -text $msg] -side left -padx 2 -pady 2 00797 00798 if {$grid} { 00799 grid $win -row [get_grid_row $win] -column 0 -sticky news -columnspan 4 -padx 2 -pady 2 00800 } else { 00801 pack $win -fill x 00802 } 00803 00804 return $win 00805 00806 } 00807 00808 ###################################################################### 00809 # Sets up the session submenu for the given 00810 proc populate_session_menu {language} { 00811 00812 variable widgets 00813 variable selected_session 00814 00815 # Delete the current menu 00816 $widgets(selsmenu) delete 0 end 00817 00818 # Populate the selection menu 00819 $widgets(selsmenu) add radiobutton -label [msgcat::mc "None"] -variable pref_ui::selected_session -value [msgcat::mc "None"] -command [list pref_ui::select $selected_session $language [msgcat::mc "None"] $language] 00820 $widgets(selsmenu) add separator 00821 foreach name [sessions::get_names] { 00822 $widgets(selsmenu) add radiobutton -label $name -variable pref_ui::selected_session -value $name -command [list pref_ui::select $selected_session $language $name $language] 00823 } 00824 00825 } 00826 00827 ###################################################################### 00828 # Sets up a select submenu for the given menu information. 00829 proc populate_lang_menu {session} { 00830 00831 variable widgets 00832 variable selected_language 00833 00834 syntax::populate_syntax_menu $widgets(sellmenu) [list pref_ui::select $session $selected_language $session] pref_ui::selected_language [msgcat::mc "All"] [syntax::get_all_languages] 00835 00836 } 00837 00838 ###################################################################### 00839 # Selects the given session language. 00840 proc select {prev_session prev_language session language {init 0}} { 00841 00842 variable widgets 00843 variable prefs 00844 variable current_panel 00845 00846 # Check for any changes that we might want to save to another set of preferences 00847 if {!$init && ![check_on_close $prev_session $prev_language]} { 00848 return 00849 } 00850 00851 # Disable traces 00852 catch { trace remove variable pref_ui::prefs {*}[lindex [trace info variable pref_ui::prefs] 0] } rc 00853 00854 # Update the menubuttons text 00855 $widgets(select_s) configure -text [format "%s: %s" [msgcat::mc "Session"] $session] 00856 $widgets(select_l) configure -text [format "%s: %s" [msgcat::mc "Language"] $language] 00857 00858 # Update the language menu in case the user changed the session 00859 populate_session_menu $language 00860 populate_lang_menu $session 00861 00862 # Update the snippets table 00863 if {!$init} { 00864 snippets_set_language $language 00865 } 00866 00867 # Translate the session and language values 00868 if {$session eq [msgcat::mc "None"]} { 00869 set session "" 00870 } 00871 if {$language eq [msgcat::mc "All"]} { 00872 set language "" 00873 } 00874 00875 # Setup the prefs 00876 array unset prefs 00877 array set prefs [preferences::get_loaded $session $language] 00878 00879 # Initialize the widgets 00880 if {!$init} { 00881 initialize_widgets 00882 } 00883 00884 # Remove all listed panels 00885 foreach panel [pack slaves $widgets(panes)] { 00886 pack forget $panel 00887 } 00888 00889 # If we are only changing language information, remove the sidebar and just display the editor pane 00890 if {$language ne ""} { 00891 00892 # Display the editor and snippets panes 00893 if {!$init} { 00894 if {$session eq ""} { 00895 foreach panel [list editor snippets documentation] { 00896 pack $widgets(panes).$panel -fill both -padx 2 -pady 2 00897 } 00898 if {($current_panel ne "editor") && ($current_panel ne "snippets") && ($current_panel ne "documentation")} { 00899 pane_clicked editor 00900 } 00901 } else { 00902 pack $widgets(panes).editor -fill both -padx 2 -pady 2 00903 pane_clicked editor 00904 } 00905 pack forget $widgets(snippets_lang_frame) 00906 } 00907 00908 # Otherwise, make sure the entire UI is displayed. 00909 } else { 00910 00911 if {!$init} { 00912 if {$session eq ""} { 00913 foreach panel [list general appearance editor find sidebar view snippets emmet shortcuts plugins advanced] { 00914 pack $widgets(panes).$panel -fill both -padx 2 -pady 2 00915 } 00916 $widgets(frame).emmet.nb add $widgets(node_aliases) 00917 $widgets(frame).emmet.nb add $widgets(abbr_aliases) 00918 pane_clicked $current_panel 00919 } else { 00920 foreach panel [list appearance editor find sidebar view emmet] { 00921 pack $widgets(panes).$panel -fill both -padx 2 -pady 2 00922 } 00923 $widgets(frame).emmet.nb hide $widgets(node_aliases) 00924 $widgets(frame).emmet.nb hide $widgets(abbr_aliases) 00925 if {($current_panel eq "general") || \ 00926 ($current_panel eq "snippets") || \ 00927 ($current_panel eq "shortcuts") || \ 00928 ($current_panel eq "plugins") || \ 00929 ($current_panel eq "advanced")} { 00930 pane_clicked appearance 00931 } else { 00932 pane_clicked $current_panel 00933 } 00934 } 00935 pack $widgets(snippets_lang_frame) -side right -padx 2 -pady 2 00936 } 00937 00938 } 00939 00940 # Trace on any changes to the preferences variable 00941 trace add variable pref_ui::prefs write [list pref_ui::handle_prefs_change $session $language] 00942 00943 } 00944 00945 ###################################################################### 00946 # Create the preferences window. 00947 proc create {session language {panel ""} {tab ""}} { 00948 00949 variable widgets 00950 variable prefs 00951 variable selected_session 00952 variable selected_language 00953 00954 if {![winfo exists .prefwin]} { 00955 00956 toplevel .prefwin 00957 wm title .prefwin [msgcat::mc "Preferences"] 00958 wm transient .prefwin . 00959 wm protocol .prefwin WM_DELETE_WINDOW [list pref_ui::destroy_window] 00960 wm withdraw .prefwin 00961 00962 ttk::frame .prefwin.sf 00963 set widgets(select_s) [ttk::menubutton .prefwin.sf.sels -menu [set widgets(selsmenu) [menu .prefwin.sf.selectSessionMenu -tearoff 0]]] 00964 set widgets(select_l) [ttk::menubutton .prefwin.sf.sell -menu [set widgets(sellmenu) [menu .prefwin.sf.selectLangMenu -tearoff 0]]] 00965 set widgets(match_e) [wmarkentry::wmarkentry .prefwin.sf.e -width 30 -watermark [msgcat::mc "Search"] -validate key -validatecommand [list pref_ui::perform_search %P]] 00966 00967 # Initialize the syntax menu 00968 set selected_session [expr {($session eq "") ? [msgcat::mc "None"] : $session}] 00969 set selected_language [expr {($language eq "") ? [msgcat::mc "All"] : $language}] 00970 populate_session_menu $selected_language 00971 populate_lang_menu $selected_session 00972 00973 place $widgets(select_s) -relx 0 -rely 0 -relwidth 0.25 00974 place $widgets(select_l) -relx 0.25 -rely 0 -relwidth 0.25 00975 pack $widgets(match_e) -side right -padx 2 -pady 2 00976 00977 ttk::frame .prefwin.f 00978 ttk::separator .prefwin.f.hsep -orient horizontal 00979 set widgets(panes) [ttk::frame .prefwin.f.bf] 00980 ttk::separator .prefwin.f.vsep -orient vertical 00981 set widgets(frame) [ttk::frame .prefwin.f.pf] 00982 00983 set widgets(match_f) [ttk::frame .prefwin.f.mf] 00984 set widgets(match_lb) [listbox .prefwin.f.mf.lb -relief flat -height 10 \ 00985 -borderwidth 0 -highlightthickness 0 \ 00986 -yscrollcommand [list utils::set_yscrollbar .prefwin.f.mf.vb]] 00987 scroller::scroller .prefwin.f.mf.vb -orient vertical -command [list .prefwin.f.mf.lb yview] 00988 00989 bind [.prefwin.sf.e entrytag] <Return> [list pref_ui::search_select] 00990 bind [.prefwin.sf.e entrytag] <Escape> [list pref_ui::search_clear] 00991 bind [.prefwin.sf.e entrytag] <Up> "::tk::ListboxUpDown $widgets(match_lb) -1; break" 00992 bind [.prefwin.sf.e entrytag] <Down> "::tk::ListboxUpDown $widgets(match_lb) 1; break" 00993 00994 grid rowconfigure .prefwin.f.mf 0 -weight 1 00995 grid columnconfigure .prefwin.f.mf 0 -weight 1 00996 grid .prefwin.f.mf.lb -row 0 -column 0 -sticky news 00997 grid .prefwin.f.mf.vb -row 0 -column 1 -sticky ns 00998 00999 grid rowconfigure .prefwin.f 1 -weight 1 01000 grid columnconfigure .prefwin.f 2 -weight 1 01001 grid .prefwin.f.hsep -row 0 -column 0 -sticky ew -columnspan 3 01002 grid .prefwin.f.bf -row 1 -column 0 -sticky news 01003 grid .prefwin.f.vsep -row 1 -column 1 -sticky ns -padx 15 01004 grid .prefwin.f.pf -row 1 -column 2 -sticky news 01005 01006 pack .prefwin.sf -fill x 01007 pack .prefwin.f -fill both -expand yes 01008 01009 # Select the given session/language information 01010 select "" "" $selected_session $selected_language 1 01011 01012 # Create the list of panes 01013 set panes [list general [msgcat::mc "General"] appearance [msgcat::mc "Appearance"] \ 01014 editor [msgcat::mc "Editor"] find [msgcat::mc "Find"] \ 01015 sidebar [msgcat::mc "Sidebar"] view [msgcat::mc "View"] \ 01016 snippets [msgcat::mc "Snippets"] emmet "Emmet" \ 01017 shortcuts [msgcat::mc "Shortcuts"] plugins [msgcat::mc "Plugins"] \ 01018 documentation [msgcat::mc "Documentation"] advanced [msgcat::mc "Advanced"]] 01019 01020 # Create and pack each of the panes 01021 foreach {pane lbl} $panes { 01022 ttk::label $widgets(panes).$pane -compound left -image pref_$pane -text $lbl -font {-size 14} 01023 bind $widgets(panes).$pane <Button-1> [list pref_ui::pane_clicked $pane] 01024 create_$pane [set widgets($pane) [ttk::frame $widgets(frame).$pane]] 01025 } 01026 01027 # Initialize widget values 01028 initialize_widgets 01029 01030 # Allow the panel dimensions to be calculatable 01031 update 01032 01033 # Get the requested panel dimensions 01034 foreach {pane lbl} $panes { 01035 lappend pheights [winfo reqheight $widgets($pane)] 01036 lappend pwidths [winfo reqwidth $widgets($pane)] 01037 lappend lwidths [winfo reqwidth $widgets(panes).$pane] 01038 } 01039 01040 # Calculate the geometry 01041 set win_width [expr [lindex [lsort -integer $pwidths] end] + [winfo reqwidth .prefwin.f.vsep] + [lindex [lsort -integer $lwidths] end]] 01042 set win_height [expr [lindex [lsort -integer $pheights] end] + [winfo reqheight .prefwin.f.hsep] + [winfo reqheight .prefwin.sf]] 01043 set win_x [expr [winfo rootx .] + (([winfo width .] - $win_width) / 2)] 01044 set win_y [expr [winfo rooty .] + (([winfo height .] - $win_height) / 2)] 01045 01046 # Set the minimum size of the window and center it on the main window 01047 wm geometry .prefwin ${win_width}x${win_height}+${win_x}+${win_y} 01048 wm resizable .prefwin 0 0 01049 01050 # Emulate a click on the General panel 01051 if {$language ne ""} { 01052 if {$session eq ""} { 01053 foreach item [list editor snippets] { 01054 pack $widgets(panes).$item -fill both -padx 2 -pady 2 01055 } 01056 } else { 01057 pack $widgets(panes).editor -fill both -padx 2 -pady 2 01058 } 01059 if {$panel ne ""} { 01060 pane_clicked $panel $tab 01061 } else { 01062 pane_clicked editor 01063 } 01064 } elseif {$session ne ""} { 01065 foreach item [list appearance editor find sidebar view emmet] { 01066 pack $widgets(panes).$item -fill both -padx 2 -pady 2 01067 } 01068 $widgets(frame).emmet.nb hide $widgets(node_aliases) 01069 $widgets(frame).emmet.nb hide $widgets(abbr_aliases) 01070 pane_clicked appearance 01071 } else { 01072 foreach item [list general appearance editor find sidebar view snippets emmet shortcuts plugins advanced] { 01073 pack $widgets(panes).$item -fill both -padx 2 -pady 2 01074 } 01075 if {$panel ne ""} { 01076 pane_clicked $panel $tab 01077 } else { 01078 pane_clicked general 01079 } 01080 } 01081 01082 # Give the search panel the focus 01083 focus .prefwin.sf.e 01084 01085 # Show the window 01086 wm deiconify .prefwin 01087 01088 } 01089 01090 } 01091 01092 01093 ###################################################################### 01094 # Called whenever the user clicks on a panel label. 01095 proc pane_clicked {panel {tab ""}} { 01096 01097 variable widgets 01098 01099 # Delete the search text 01100 $widgets(match_e) delete 0 end 01101 01102 # Remove the results frame 01103 catch { place forget $widgets(match_f) } 01104 01105 # Clear all of the panel selection labels, if necessary 01106 foreach p [winfo children $widgets(panes)] { 01107 $p state !active 01108 } 01109 01110 # Set the color of the label to the given color 01111 $widgets(panes).$panel state active 01112 01113 # Show the panel 01114 show_panel $panel $tab 01115 01116 } 01117 01118 ###################################################################### 01119 # Displays the selected panel in the listbox. 01120 proc show_selected_panel {} { 01121 01122 variable widgets 01123 01124 set selected [$widgets(bar) selection] 01125 set panel [string tolower [$widgets(bar) item $selected -text]] 01126 01127 show_panel $panel 01128 01129 } 01130 01131 ###################################################################### 01132 # Shows the given panel in the window. 01133 proc show_panel {panel {tab ""}} { 01134 01135 variable widgets 01136 variable current_panel 01137 01138 # Remove the current panel 01139 if {$current_panel ne ""} { 01140 pack forget $widgets($current_panel) 01141 } 01142 01143 # Display the given panel 01144 pack $widgets($panel) -fill both -expand yes 01145 01146 # Save the current panel 01147 set current_panel $panel 01148 01149 # If a tab is presented, find the tab and display it 01150 if {($tab ne "") && [winfo exists $widgets($panel).nb]} { 01151 foreach tab_id [$widgets($panel).nb tabs] { 01152 if {[string tolower [$widgets($panel).nb tab $tab_id -text]] eq [string tolower $tab]} { 01153 $widgets($panel).nb select $tab_id 01154 break 01155 } 01156 } 01157 } 01158 01159 } 01160 01161 ###################################################################### 01162 # Called when the preference window is destroyed. 01163 proc destroy_window {} { 01164 01165 variable selected_session 01166 variable selected_language 01167 01168 # Save any sharing changes (if necessary) 01169 save_share_changes 01170 01171 # Check the state of the preferences and, if necessary, ask the user to 01172 # apply the changes to other preferences 01173 if {![check_on_close $selected_session $selected_language]} { 01174 return 01175 } 01176 01177 # Kill the window 01178 destroy .prefwin 01179 01180 } 01181 01182 ###################################################################### 01183 # Checks to see if any of the changes could be saved to other preference 01184 # types. If so, prompts the user to cross save those values that changed. 01185 proc check_on_close {session language} { 01186 01187 variable changes 01188 01189 # If we are changing language preferences, there are no changes or we are specified 01190 # to not prompt the user, do nothing 01191 if {($language ne [msgcat::mc "All"]) || ([array size changes] == 0) || !$pref_ui::prefs(General/PromptCrossSessionSave)} { 01192 return 1 01193 } 01194 01195 if {$session eq [msgcat::mc "None"]} { 01196 01197 if {[sessions::current] ne ""} { 01198 01199 set detail [msgcat::mc "You have changed global preferences which will not be visible because you are currently within a named session."] 01200 set answer [tk_messageBox -parent .prefwin -icon question -type yesnocancel -message [msgcat::mc "Save changes to current session?"] -detail $detail] 01201 01202 switch $answer { 01203 "cancel" { return 0 } 01204 "yes" { preferences::save_prefs "" "" [array get changes] } 01205 } 01206 01207 } 01208 01209 } else { 01210 01211 set detail [msgcat::mc "You have changed the current session's preferences which will not be applied globally."] 01212 set answer [tk_messageBox -parent .prefwin -icon question -type yesnocancel -message [msgcat::mc "Save changes to global preferences?"] -detail $detail] 01213 01214 switch $answer { 01215 "cancel" { return 0 } 01216 "yes" { preferences::save_prefs [sessions::current] "" [array get changes] } 01217 } 01218 01219 } 01220 01221 # Clear the changes 01222 array unset changes 01223 01224 return 1 01225 01226 } 01227 01228 ###################################################################### 01229 # Handles any changes to the preference array. 01230 proc handle_prefs_change {session language name1 name2 op} { 01231 01232 variable widgets 01233 variable prefs 01234 variable changes 01235 01236 if {[winfo exists .prefwin]} { 01237 01238 # Track the preferences change 01239 set changes($name2) $prefs($name2) 01240 array unset changes General/* 01241 array unset changes Help/* 01242 array unset changes Debug/* 01243 array unset changes Tools/Profile* 01244 01245 # Save the preferences 01246 preferences::save_prefs $session $language [array get prefs] 01247 01248 # Refresh any UI state after the preferences update 01249 init_mb $widgets(appear_theme) Appearance/Theme [themes::get_visible_themes] 01250 01251 } 01252 01253 } 01254 01255 ###################################################################### 01256 # Display the list of all matches in the dropdown listbox. 01257 proc show_matches {value} { 01258 01259 variable widgets 01260 variable search 01261 variable selected_language 01262 01263 if {$selected_language eq [msgcat::mc "All"]} { 01264 set matches [array names search -regexp (?i).*$request.*::.] 01265 } else { 01266 set matches [array names search -regexp (?i).*$request.*::1] 01267 } 01268 01269 foreach match $matches { 01270 lassign $search($match) win lbl plugin tab1 tab2 01271 set tabs1($tab1) [list $win $lbl] 01272 if {$tab2 ne ""} { 01273 set tabs2($tab2) [list $win $lbl] 01274 } 01275 } 01276 01277 } 01278 01279 ###################################################################### 01280 # Searches the preference window for the given item. 01281 proc perform_search {value} { 01282 01283 variable widgets 01284 variable search 01285 variable selected_session 01286 variable selected_language 01287 01288 set matches [list] 01289 01290 array set tabs1 [list] 01291 01292 # Get the list of matches 01293 if {$value ne ""} { 01294 if {$selected_language eq [msgcat::mc "All"]} { 01295 if {$selected_session eq [msgcat::mc "None"]} { 01296 set matches [array names search -regexp (?i).*$value.*::a.*] 01297 } else { 01298 set matches [array names search -regexp (?i).*$value.*::.*b.*] 01299 } 01300 } else { 01301 set matches [array names search -regexp (?i).*$value.*::.*c] 01302 } 01303 foreach match $matches { 01304 lassign $search($match) win lbl plugin tab1 tab2 01305 set tabs1($tab1) [list $win $lbl] 01306 } 01307 } 01308 01309 # Display the matches 01310 if {[set match_len [llength $matches]] > 0} { 01311 $widgets(match_lb) delete 0 end 01312 foreach match $matches { 01313 $widgets(match_lb) insert end [lindex [split $match ::] 0] 01314 } 01315 $widgets(match_lb) configure -height [expr (($match_len) > 10) ? 10 : $match_len] 01316 place $widgets(match_f) -relx 0.5 -relwidth 0.5 -rely 0.0 01317 } else { 01318 catch { place forget $widgets(match_f) } 01319 } 01320 01321 foreach p [winfo children $widgets(panes)] { 01322 $p state !active 01323 } 01324 01325 # Display the tab if there is only one match 01326 foreach tab [array names tabs1] { 01327 $tab state active 01328 } 01329 01330 # Select the first item in the list 01331 $widgets(match_lb) see 0 01332 $widgets(match_lb) selection clear 0 end 01333 $widgets(match_lb) selection set 0 01334 $widgets(match_lb) selection anchor 0 01335 $widgets(match_lb) activate 0 01336 01337 return 1 01338 01339 } 01340 01341 ###################################################################### 01342 # Selects the text in the entry. 01343 proc search_select {} { 01344 01345 variable widgets 01346 variable search 01347 01348 # Get the selected item 01349 set selected_value [$widgets(match_lb) get active] 01350 01351 # Get the information from the matching element 01352 set key [lindex [array names search ${selected_value}::*] 0] 01353 lassign $search($key) win lbl plugin tab1 tab2 01354 01355 # Select the pane containing the item 01356 pane_clicked [lindex [split $tab1 .] end] 01357 01358 # If the matched item is within a plugin preference pane, put the pane into view 01359 if {$plugin ne ""} { 01360 handle_plugins_change $plugin 01361 } 01362 01363 # If the element exists within a notebook tab, display it 01364 if {$tab2 ne ""} { 01365 [winfo parent $tab2] select $tab2 01366 } 01367 01368 # Select the match text 01369 $widgets(match_e) selection range 0 end 01370 01371 # Remove the results frame 01372 catch { place forget $widgets(match_f) } 01373 01374 # Give the focus to the matching element 01375 focus $win 01376 01377 } 01378 01379 ###################################################################### 01380 # Clear the search text. 01381 proc search_clear {} { 01382 01383 variable widgets 01384 variable current_panel 01385 01386 # Delete the search text 01387 $widgets(match_e) delete 0 end 01388 01389 # Remove the results frame 01390 catch { place forget $widgets(match_f) } 01391 01392 # Make sure that the current tab is selected 01393 pane_clicked $current_panel 01394 01395 } 01396 01397 ###################################################################### 01398 # Registers a search item 01399 proc register {w str var} { 01400 01401 variable search 01402 01403 # Figure out which notebooks 01404 set insts [split $w .] 01405 set tabs [list] 01406 set plugin [expr {([lindex $insts 4] eq "plugins") ? [lindex $insts 6] : ""}] 01407 lappend tabs .prefwin.f.bf.[lindex $insts 4] 01408 for {set i 3} {$i < [llength $insts]} {incr i} { 01409 set hier [join [lrange $insts 0 $i] .] 01410 if {[winfo class $hier] eq "TNotebook"} { 01411 lappend tabs [join [lrange $insts 0 [expr $i + 1]] .] 01412 } 01413 } 01414 01415 lassign [split $var /] category var 01416 01417 switch $category { 01418 General { set tag a } 01419 Appearance { set tag ab } 01420 Editor { set tag abc } 01421 Emmet { set tag ab } 01422 Find { set tag ab } 01423 Sidebar { set tag ab } 01424 View { set tag ab } 01425 Shortcuts { set tag a } 01426 Plugins { set tag a } 01427 Documentation { set tag c } 01428 Advanced { set tag a } 01429 default { set tag "" } 01430 } 01431 01432 set lang_only [expr {($category eq "Editor") ? 1 : 0}] 01433 set search(${var}::$tag) [list $w $str $plugin {*}$tabs] 01434 01435 if {$str ne ""} { 01436 set search(${str}::$tag) [list $w $str $plugin {*}$tabs] 01437 } 01438 01439 } 01440 01441 ########### 01442 # GENERAL # 01443 ########### 01444 01445 ###################################################################### 01446 # Creates the general panel. 01447 proc create_general {w} { 01448 01449 variable widgets 01450 variable prefs 01451 variable enable_share 01452 variable share_changed 01453 01454 pack [ttk::notebook $w.nb] -fill both -expand yes 01455 01456 ############### 01457 # GENERAL TAB # 01458 ############### 01459 01460 $w.nb add [set a [ttk::frame $w.nb.a]] -text [msgcat::mc "General"] 01461 01462 make_cb $a.lls [msgcat::mc "Automatically load last session on start"] General/LoadLastSession 01463 make_cb $a.eolc [msgcat::mc "Exit the application after the last tab is closed"] General/ExitOnLastClose 01464 make_cb $a.acwd [msgcat::mc "Automatically set the current working directory to the current tabs directory"] General/AutoChangeWorkingDirectory 01465 set umtt [make_cb $a.umtt [msgcat::mc "Show 'Move To Trash' for local files/directories instead of 'Delete'"] General/UseMoveToTrash] 01466 pack [ttk::frame $a.mttf] -fill x -padx 2 -pady 2 01467 pack [ttk::label $a.mttf.l -text " "] -side left -padx 2 -pady 2 01468 set cmtt [make_cb $a.mttf.cb [msgcat::mc "Confirm 'Move To Trash' operation prior to operation"] General/ConfirmMoveToTrash] 01469 make_cb $a.pcs [msgcat::mc "Prompt user to save preference changes in global or named session"] General/PromptCrossSessionSave 01470 01471 $umtt configure -command [list pref_ui::move_to_trash_changed $cmtt] 01472 move_to_trash_changed $cmtt 01473 01474 make_spacer $a 01475 01476 ttk::frame $a.f 01477 ttk::label $a.f.dl -text [format "%s: " [set wstr [msgcat::mc "Set default open/save browsing directory to"]]] 01478 set widgets(browse_mb) [ttk::menubutton $a.f.dmb -menu [menu $a.browMnu -tearoff 0]] 01479 set widgets(browse_l) [ttk::label $a.f.dir] 01480 01481 $a.browMnu add command -label [msgcat::mc "Last accessed"] -command [list pref_ui::set_browse_dir "last"] 01482 $a.browMnu add command -label [msgcat::mc "Current editing buffer directory"] -command [list pref_ui::set_browse_dir "buffer"] 01483 $a.browMnu add command -label [msgcat::mc "Current working directory"] -command [list pref_ui::set_browse_dir "current"] 01484 $a.browMnu add command -label [msgcat::mc "Use directory"] -command [list pref_ui::set_browse_dir "dir"] 01485 01486 # Register the widget for search 01487 register $widgets(browse_mb) $wstr General/DefaultFileBrowserDirectory 01488 01489 switch $prefs(General/DefaultFileBrowserDirectory) { 01490 "last" { $widgets(browse_mb) configure -text [msgcat::mc "Last"] } 01491 "buffer" { $widgets(browse_mb) configure -text [msgcat::mc "Buffer"] } 01492 "current" { $widgets(browse_mb) configure -text [msgcat::mc "Current"] } 01493 default { 01494 $widgets(browse_mb) configure -text [msgcat::mc "Directory"] 01495 $widgets(browse_l) configure -text " $prefs(General/DefaultFileBrowserDirectory)" 01496 } 01497 } 01498 01499 grid $a.f.dl -row 1 -column 0 -sticky news -padx 2 -pady 2 01500 grid $a.f.dmb -row 1 -column 1 -sticky news -padx 2 -pady 2 01501 grid $a.f.dir -row 2 -column 0 -sticky news -columnspan 2 01502 01503 pack $a.f -fill x -padx 2 -pady 2 01504 01505 ################# 01506 # VARIABLES TAB # 01507 ################# 01508 01509 $w.nb add [set b [ttk::frame $w.nb.b]] -text [set wstr [msgcat::mc "Variables"]] 01510 01511 ttk::frame $b.f 01512 set widgets(var_table) [tablelist::tablelist $b.f.tl \ 01513 -columns [list 0 [msgcat::mc "Variable"] 0 [msgcat::mc "Value"]] \ 01514 -stretch all -editselectedonly 1 -exportselection 0 -showseparators 1 \ 01515 -borderwidth 0 -highlightthickness 0 \ 01516 -height 25 \ 01517 -editendcommand [list pref_ui::var_edit_end_command] \ 01518 -xscrollcommand [list utils::set_xscrollbar $b.f.hb] \ 01519 -yscrollcommand [list utils::set_yscrollbar $b.f.vb]] 01520 scroller::scroller $b.f.vb -orient vertical -command [list $b.f.tl yview] 01521 scroller::scroller $b.f.hb -orient horizontal -command [list $b.f.tl xview] 01522 01523 utils::tablelist_configure $widgets(var_table) 01524 01525 $widgets(var_table) columnconfigure 0 -name var -editable 1 -stretchable 1 01526 $widgets(var_table) columnconfigure 1 -name val -editable 1 -stretchable 1 01527 01528 bind $widgets(var_table) <<TablelistSelect>> [list pref_ui::handle_var_select] 01529 01530 grid rowconfigure $b.f 1 -weight 1 01531 grid columnconfigure $b.f 0 -weight 1 01532 grid $b.f.tl -row 0 -column 0 -sticky news -rowspan 2 01533 grid [$b.f.tl cornerpath] -row 0 -column 1 -sticky news 01534 grid $b.f.vb -row 1 -column 1 -sticky ns 01535 grid $b.f.hb -row 2 -column 0 -sticky ew 01536 01537 register $widgets(var_table) $wstr General/Variables 01538 01539 ttk::frame $b.bf 01540 set widgets(var_add) [ttk::button $b.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::add_variable]] 01541 set widgets(var_del) [ttk::button $b.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::del_variable] -state disabled] 01542 01543 pack $b.bf.add -side left -padx 2 -pady 2 01544 pack $b.bf.del -side left -padx 2 -pady 2 01545 01546 pack $b.f -fill both -expand yes 01547 pack $b.bf -fill x 01548 01549 # Populate the variable table 01550 foreach row $prefs(General/Variables) { 01551 $widgets(var_table) insert end $row 01552 } 01553 01554 ################# 01555 # LANGUAGES TAB # 01556 ################# 01557 01558 $w.nb add [set c [ttk::frame $w.nb.c]] -text [set wstr [msgcat::mc "Languages"]] 01559 01560 set widgets(lang_table) [tablelist::tablelist $c.tl \ 01561 -columns [list 0 [msgcat::mc "Enabled"] 0 [msgcat::mc "Language"] 0 [msgcat::mc "Extensions"]] \ 01562 -stretch all -exportselection 1 -showseparators 1 \ 01563 -height 25 -borderwidth 0 -highlightthickness 0 \ 01564 -editendcommand [list pref_ui::lang_edit_end_command] \ 01565 -xscrollcommand [list utils::set_xscrollbar $c.hb] \ 01566 -yscrollcommand [list utils::set_yscrollbar $c.vb]] 01567 scroller::scroller $c.vb -orient vertical -command [list $c.tl yview] 01568 scroller::scroller $c.hb -orient horizontal -command [list $c.tl xview] 01569 01570 utils::tablelist_configure $widgets(lang_table) 01571 01572 $widgets(lang_table) columnconfigure 0 -name enabled -editable 0 -resizable 0 -stretchable 0 -formatcommand [list pref_ui::empty_string] 01573 $widgets(lang_table) columnconfigure 1 -name lang -editable 0 -resizable 0 -stretchable 0 01574 $widgets(lang_table) columnconfigure 2 -name exts -editable 1 -resizable 1 -stretchable 1 01575 01576 bind [$widgets(lang_table) bodytag] <Button-1> [list pref_ui::handle_lang_left_click %W %x %y] 01577 01578 # Register the widget for search 01579 register $widgets(lang_table) $wstr General/DisabledLanguages 01580 register $widgets(lang_table) $wstr General/LanguagePatternOverrides 01581 01582 grid rowconfigure $c 1 -weight 1 01583 grid columnconfigure $c 0 -weight 1 01584 grid $c.tl -row 0 -column 0 -sticky news -rowspan 2 01585 grid [$c.tl cornerpath] -row 0 -column 1 -sticky news 01586 grid $c.vb -row 1 -column 1 -sticky ns 01587 grid $c.hb -row 2 -column 0 -sticky ew 01588 01589 # Populate the language table 01590 populate_lang_table 01591 01592 ############### 01593 # SHARING TAB # 01594 ############### 01595 01596 $w.nb add [set e [ttk::frame $w.nb.e]] -text [msgcat::mc "Sharing"] 01597 01598 ttk::frame $e.sf 01599 set widgets(share_enable) [ttk::checkbutton $e.sf.cb -text [format " %s: " [set wstr [msgcat::mc "Directory"]]] -variable pref_ui::enable_share -command [list pref_ui::handle_share_directory]] 01600 set widgets(share_entry) [ttk::entry $e.sf.e] 01601 01602 register $widgets(share_enable) $wstr General/ShareDirectory 01603 01604 pack $e.sf.cb -side left -padx 2 -pady 2 01605 pack $e.sf.e -side left -padx 2 -pady 2 -fill x -expand yes 01606 01607 set widgets(share_items) [ttk::labelframe $e.if -text [set wstr [msgcat::mc "Sharing Items"]]] 01608 foreach {type nspace name} [share::get_share_items] { 01609 pack [ttk::checkbutton $e.if.$type -text [format " %s" $name] -variable pref_ui::share_$type -command [list pref_ui::handle_share_change]] -fill x -padx 2 -pady 2 01610 } 01611 01612 register $widgets(share_items) $wstr General/ShareItems 01613 01614 ttk::button $e.export -text [msgcat::mc "Export Settings"] -command [list share::create_export .prefwin] 01615 01616 pack $e.sf -padx 2 -pady 4 -fill x 01617 make_spacer $e 01618 pack $e.if -padx 2 -pady 4 -fill both 01619 make_spacer $e 01620 pack $e.export 01621 01622 # Initialize the sharing UI 01623 lassign [share::get_share_info] share_dir share_items 01624 set enable_share [expr {$share_dir ne ""}] 01625 set share_changed 0 01626 foreach {type value} $share_items { 01627 set pref_ui::share_$type $value 01628 } 01629 $widgets(share_entry) insert end $share_dir 01630 $widgets(share_entry) configure -state readonly 01631 01632 # The updates tab is not valid for Windows 01633 if {![string match *Win* $::tcl_platform(os)]} { 01634 01635 ############### 01636 # UPDATES TAB # 01637 ############### 01638 01639 $w.nb add [set d [ttk::frame $w.nb.d]] -text [set wstr [msgcat::mc "Updates"]] 01640 01641 make_cb $d.ucos [msgcat::mc "Automatically check for updates on start"] General/UpdateCheckOnStart 01642 01643 ttk::frame $d.f 01644 ttk::label $d.f.ul -text [format "%s: " [set wstr [msgcat::mc "Update using release type"]]] 01645 set widgets(upd_mb) [ttk::menubutton $d.f.umb -menu [menu $d.updMnu -tearoff 0]] 01646 01647 $d.updMnu add radiobutton -label [msgcat::mc "Stable"] -value "stable" -variable pref_ui::prefs(General/UpdateReleaseType) -command [list pref_ui::set_release_type] 01648 $d.updMnu add radiobutton -label [msgcat::mc "Development"] -value "devel" -variable pref_ui::prefs(General/UpdateReleaseType) -command [list pref_ui::set_release_type] 01649 01650 ttk::button $d.upd -style BButton -text [msgcat::mc "Check for Update"] -command [list menus::check_for_update] 01651 01652 pack $d.f.ul -side left -padx 2 -pady 2 01653 pack $d.f.umb -side left -padx 2 -pady 2 01654 pack $d.f -fill x 01655 pack $d.upd -padx 2 -pady 2 01656 01657 # Register the widget for search 01658 register $widgets(upd_mb) $wstr General/UpdateReleaseType 01659 01660 # Initialize the release type menubutton text 01661 set_release_type 01662 01663 } 01664 01665 } 01666 01667 ###################################################################### 01668 # Format command. 01669 proc empty_string {value} { 01670 01671 return "" 01672 01673 } 01674 01675 ###################################################################### 01676 # Called whenever the UseMoveToTrash variable is changed. Used to control 01677 # the UI display of the ConfirmMoveToTrash checkbutton. 01678 proc move_to_trash_changed {w} { 01679 01680 variable prefs 01681 01682 $w configure -state [expr {$prefs(General/UseMoveToTrash) ? "normal" : "disabled"}] 01683 01684 } 01685 01686 ###################################################################### 01687 # Sets the update release type to the specified value. 01688 proc set_release_type {} { 01689 01690 variable widgets 01691 variable prefs 01692 01693 if {$prefs(General/UpdateReleaseType) eq "stable"} { 01694 $widgets(upd_mb) configure -text [msgcat::mc "Stable"] 01695 } else { 01696 $widgets(upd_mb) configure -text [msgcat::mc "Development"] 01697 } 01698 01699 } 01700 01701 ###################################################################### 01702 # Set the browse directory 01703 proc set_browse_dir {value} { 01704 01705 variable widgets 01706 variable prefs 01707 01708 # Clear the browser label text 01709 $widgets(browse_l) configure -text "" 01710 01711 switch $value { 01712 "last" { 01713 $widgets(browse_mb) configure -text [msgcat::mc "Last"] 01714 } 01715 "buffer" { 01716 $widgets(browse_mb) configure -text [msgcat::mc "Buffer"] 01717 } 01718 "current" { 01719 $widgets(browse_mb) configure -text [msgcat::mc "Current"] 01720 } 01721 default { 01722 if {[set dir [tk_chooseDirectory -parent .prefwin -title [msgcat::mc "Select default browsing directory"]]] ne ""} { 01723 $widgets(browse_mb) configure -text [msgcat::mc "Directory"] 01724 $widgets(browse_l) configure -text " $dir" 01725 set value $dir 01726 } 01727 } 01728 } 01729 01730 # Update the preference value 01731 set prefs(General/DefaultFileBrowserDirectory) $value 01732 01733 } 01734 01735 ###################################################################### 01736 # When a row is selected, set the delete button state to normal. 01737 proc handle_var_select {} { 01738 01739 variable widgets 01740 01741 # Enable the delete button 01742 if {[$widgets(var_table) curselection] eq ""} { 01743 $widgets(var_del) configure -state disabled 01744 } else { 01745 $widgets(var_del) configure -state normal 01746 } 01747 01748 } 01749 01750 ###################################################################### 01751 # Adds a variable to the end of the variable table. 01752 proc add_variable {} { 01753 01754 variable widgets 01755 01756 # Clear the selection and disable the delete button 01757 $widgets(var_table) selection clear 0 end 01758 $widgets(var_del) configure -state disabled 01759 01760 # Add the new variable line 01761 set row [$widgets(var_table) insert end [list "" ""]] 01762 01763 # Make the first entry to be editable 01764 $widgets(var_table) editcell $row,var 01765 01766 } 01767 01768 ###################################################################### 01769 # Deletes the currently selected variable from the variable table. 01770 proc del_variable {} { 01771 01772 variable widgets 01773 01774 set selected [$widgets(var_table) curselection] 01775 01776 # Delete the row 01777 $widgets(var_table) delete $selected 01778 01779 # Disable the delete button 01780 $widgets(var_del) configure -state disabled 01781 01782 # Update the General/Variable array value 01783 gather_var_table 01784 01785 } 01786 01787 ###################################################################### 01788 # Called after the user has edited the variable table cell. 01789 proc var_edit_end_command {tbl row col value} { 01790 01791 after 1 [list pref_ui::gather_var_table] 01792 01793 return $value 01794 01795 } 01796 01797 ###################################################################### 01798 # Gather the variable table values from the table and update the 01799 # preferences array. 01800 proc gather_var_table {} { 01801 01802 variable widgets 01803 variable prefs 01804 01805 set values [list] 01806 01807 for {set i 0} {$i < [$widgets(var_table) size]} {incr i} { 01808 if {([set var [$widgets(var_table) cellcget $i,var -text]] ne "") && \ 01809 ([set val [$widgets(var_table) cellcget $i,val -text]] ne "")} { 01810 lappend values [list $var $val] 01811 } else { 01812 return 01813 } 01814 } 01815 01816 set prefs(General/Variables) $values 01817 01818 } 01819 01820 ###################################################################### 01821 # Populates the language table with information from syntax and the 01822 # preferences file. 01823 proc populate_lang_table {} { 01824 01825 variable widgets 01826 variable prefs 01827 01828 # Get the list of languages to disable 01829 set dis_langs $prefs(General/DisabledLanguages) 01830 01831 # Get the extension overrides 01832 array set orides $prefs(General/LanguagePatternOverrides) 01833 01834 # Add all of the languages 01835 foreach lang [lsort [syntax::get_all_languages]] { 01836 set enabled [expr [lsearch $dis_langs $lang] == -1] 01837 set patterns [syntax::get_file_patterns $lang] 01838 if {[info exists orides($lang)]} { 01839 foreach pattern $orides($lang) { 01840 if {[string index $pattern 0] eq "+"} { 01841 lappend patterns [string range $pattern 1 end] 01842 } elseif {[set index [lsearch -exact $patterns [string range $pattern 1 end]]] != -1} { 01843 set patterns [lreplace $patterns $index $index] 01844 } 01845 } 01846 } 01847 set row [$widgets(lang_table) insert end [list $enabled $lang $patterns]] 01848 if {$enabled} { 01849 $widgets(lang_table) cellconfigure $row,enabled -image pref_checked 01850 } else { 01851 $widgets(lang_table) cellconfigure $row,enabled -image pref_unchecked 01852 } 01853 } 01854 01855 } 01856 01857 ###################################################################### 01858 # Handles any left-clicks on the language table. 01859 proc handle_lang_left_click {w x y} { 01860 01861 variable prefs 01862 01863 lassign [tablelist::convEventFields $w $x $y] tbl x y 01864 lassign [split [$tbl containingcell $x $y] ,] row col 01865 01866 if {$row >= 0} { 01867 if {$col == 0} { 01868 set lang [$tbl cellcget $row,lang -text] 01869 if {[$tbl cellcget $row,$col -text]} { 01870 $tbl cellconfigure $row,$col -text 0 -image pref_unchecked 01871 lappend prefs(General/DisabledLanguages) $lang 01872 } else { 01873 $tbl cellconfigure $row,$col -text 1 -image pref_checked 01874 set index [lsearch $prefs(General/DisabledLanguages) $lang] 01875 set prefs(General/DisabledLanguages) [lreplace $prefs(General/DisabledLanguages) $index $index] 01876 } 01877 } 01878 } 01879 01880 } 01881 01882 ###################################################################### 01883 # Save the contents to the preference file. 01884 proc lang_edit_end_command {tbl row col value} { 01885 01886 variable prefs 01887 01888 set lang [$tbl cellcget $row,lang -text] 01889 set patterns [syntax::get_file_patterns $lang] 01890 01891 set lang_oride [list] 01892 foreach pattern $patterns { 01893 if {[lsearch -exact $value $pattern] == -1} { 01894 lappend lang_oride "-$pattern" 01895 } 01896 } 01897 foreach val $value { 01898 if {[lsearch -exact $patterns $val] == -1} { 01899 lappend lang_oride "+$val" 01900 } 01901 } 01902 array set pref_orides $prefs(General/LanguagePatternOverrides) 01903 if {[llength $lang_oride] == 0} { 01904 unset pref_orides($lang) 01905 } else { 01906 set pref_orides($lang) $lang_oride 01907 } 01908 set prefs(General/LanguagePatternOverrides) [array get pref_orides] 01909 01910 return $value 01911 01912 } 01913 01914 ###################################################################### 01915 # Handles any changes to the share directory checkbutton. 01916 proc handle_share_directory {} { 01917 01918 variable widgets 01919 variable enable_share 01920 01921 if {$enable_share} { 01922 if {[set share_dir [tk_chooseDirectory -parent .prefwin -title [msgcat::mc "Select Settings Sharing Directory"]]] eq ""} { 01923 set enable_share 0 01924 } else { 01925 $widgets(share_entry) configure -state normal 01926 $widgets(share_entry) delete 0 end 01927 $widgets(share_entry) insert end $share_dir 01928 $widgets(share_entry) configure -state readonly 01929 handle_share_change 01930 } 01931 } else { 01932 $widgets(share_entry) configure -state normal 01933 $widgets(share_entry) delete 0 end 01934 $widgets(share_entry) configure -state readonly 01935 handle_share_change 01936 } 01937 01938 } 01939 01940 ###################################################################### 01941 # Called whenever a share value changes. 01942 proc handle_share_change {} { 01943 01944 variable share_changed 01945 01946 set share_changed 1 01947 01948 } 01949 01950 ###################################################################### 01951 # Handles any changes to the sharing item checkbuttons. 01952 proc save_share_changes {} { 01953 01954 variable widgets 01955 variable share_changed 01956 01957 if {$share_changed} { 01958 01959 # Gather the items 01960 set items [list] 01961 foreach {type nspace name} [share::get_share_items] { 01962 if {[set pref_ui::share_$type]} { 01963 lappend items $type 01964 } 01965 } 01966 01967 # Save the changes 01968 share::save_changes [$widgets(share_entry) get] $items 01969 01970 } 01971 01972 } 01973 01974 ############## 01975 # APPEARANCE # 01976 ############## 01977 01978 ###################################################################### 01979 # Creates the appearance panel. 01980 proc create_appearance {w} { 01981 01982 variable widgets 01983 variable colorizers 01984 variable prefs 01985 01986 pack [ttk::notebook $w.nb] -fill both -expand yes 01987 01988 ########### 01989 # GENERAL # 01990 ########### 01991 01992 $w.nb add [set a [ttk::frame $w.nb.a]] -text [msgcat::mc "General"] 01993 01994 ttk::frame $a.f 01995 set widgets(appear_theme) [make_mb $a.f.th [msgcat::mc "Default theme"] Appearance/Theme [themes::get_visible_themes] 1] 01996 make_sb $a.f.icw [msgcat::mc "Insertion cursor width"] Appearance/CursorWidth 1 5 1 1 01997 make_sb $a.f.els [msgcat::mc "Additional space between lines"] Appearance/ExtraLineSpacing 0 10 1 1 01998 01999 ttk::labelframe $a.cf -text [set wstr [msgcat::mc "Syntax Coloring"]] 02000 02001 # Pack the colorizer frame 02002 set i 0 02003 set colorize $prefs(Appearance/Colorize) 02004 foreach type [lsort [array names colorizers]] { 02005 set colorizers($type) [expr {[lsearch $colorize $type] != -1}] 02006 grid [ttk::checkbutton $a.cf.$type -text " $type" -variable pref_ui::colorizers($type) -command [list pref_ui::set_colorizers]] -row [expr $i % 3] -column [expr $i / 3] -sticky news -padx 2 -pady 2 02007 incr i 02008 } 02009 02010 # Register the widget 02011 register $a.cf.$type $wstr Appearance/Colorize 02012 02013 # Create fonts frame 02014 ttk::labelframe $a.ff -text [msgcat::mc "Fonts"] 02015 ttk::label $a.ff.l0 -text [format "%s: " [msgcat::mc "Editor"]] 02016 ttk::label $a.ff.f0 -text "AaBbCc0123" -font $prefs(Appearance/EditorFont) 02017 ttk::button $a.ff.b0 -style BButton -text [msgcat::mc "Choose"] -command [list pref_ui::set_font $a.ff.f0 [msgcat::mc "Select Editor Font"] Appearance/EditorFont 1] 02018 ttk::label $a.ff.l1 -text [format "%s: " [msgcat::mc "Command launcher entry"]] 02019 ttk::label $a.ff.f1 -text "AaBbCc0123" -font $prefs(Appearance/CommandLauncherEntryFont) 02020 ttk::button $a.ff.b1 -style BButton -text [msgcat::mc "Choose"] -command [list pref_ui::set_font $a.ff.f1 [msgcat::mc "Select Command Launcher Entry Font"] Appearance/CommandLauncherEntryFont 0] 02021 ttk::label $a.ff.l2 -text [format "%s: " [msgcat::mc "Command launcher preview"]] 02022 ttk::label $a.ff.f2 -text "AaBbCc0123" -font $prefs(Appearance/CommandLauncherPreviewFont) 02023 ttk::button $a.ff.b2 -style BButton -text [msgcat::mc "Choose"] -command [list pref_ui::set_font $a.ff.f2 [msgcat::mc "Select Command Launcher Preview Font"] Appearance/CommandLauncherPreviewFont 0] 02024 02025 # Register the widgets for search 02026 register $a.ff.b0 "" Appearance/EditorFont 02027 register $a.ff.b1 "" Appearance/CommandLauncherEntryFont 02028 register $a.ff.b2 "" Appearance/CommandLauncherPreviewFont 02029 02030 grid columnconfigure $a.ff 1 -weight 1 02031 grid $a.ff.l0 -row 0 -column 0 -sticky news -padx 2 -pady 2 02032 grid $a.ff.f0 -row 0 -column 1 -sticky news -padx 2 -pady 2 02033 grid $a.ff.b0 -row 0 -column 2 -sticky news -padx 2 -pady 2 02034 grid $a.ff.l1 -row 1 -column 0 -sticky news -padx 2 -pady 2 02035 grid $a.ff.f1 -row 1 -column 1 -sticky news -padx 2 -pady 2 02036 grid $a.ff.b1 -row 1 -column 2 -sticky news -padx 2 -pady 2 02037 grid $a.ff.l2 -row 2 -column 0 -sticky news -padx 2 -pady 2 02038 grid $a.ff.f2 -row 2 -column 1 -sticky news -padx 2 -pady 2 02039 grid $a.ff.b2 -row 2 -column 2 -sticky news -padx 2 -pady 2 02040 02041 pack $a.f -fill x -padx 2 -pady 2 02042 make_spacer $a 02043 pack $a.cf -fill x -padx 2 -pady 4 02044 make_spacer $a 02045 pack $a.ff -fill x -padx 2 -pady 4 02046 02047 make_spacer $a 02048 make_cb $a.cl_pos [msgcat::mc "Remember last position of command launcher"] Appearance/CommandLauncherRememberLastPosition 02049 02050 ########## 02051 # THEMES # 02052 ########## 02053 02054 $w.nb add [set b [ttk::frame $w.nb.b]] -text [msgcat::mc "Manage Themes"] 02055 02056 ttk::frame $b.tf 02057 set widgets(themes_tl) [tablelist::tablelist $b.tf.tl \ 02058 -columns [list 0 [msgcat::mc "Name"] 0 [msgcat::mc "Visible"] center 0 [msgcat::mc "Imported"] center 0 [msgcat::mc "Creator"] 0 [msgcat::mc "Date"]] \ 02059 -exportselection 0 -stretch all -borderwidth 0 -highlightthickness 0 \ 02060 -labelcommand tablelist::sortByColumn \ 02061 -xscrollcommand [list utils::set_xscrollbar $b.tf.hb] \ 02062 -yscrollcommand [list utils::set_yscrollbar $b.tf.vb]] 02063 scroller::scroller $b.tf.vb -orient vertical -command [list $b.tf.tl yview] 02064 scroller::scroller $b.tf.hb -orient horizontal -command [list $b.tf.tl xview] 02065 02066 utils::tablelist_configure $b.tf.tl 02067 02068 $widgets(themes_tl) columnconfigure 0 -name name -editable 0 02069 $widgets(themes_tl) columnconfigure 1 -name visible -editable 0 -stretchable 0 -resizable 0 -formatcommand [list pref_ui::themes_format_visible] 02070 $widgets(themes_tl) columnconfigure 2 -name imported -editable 0 -stretchable 0 -resizable 0 -formatcommand [list pref_ui::themes_format_imported] 02071 $widgets(themes_tl) columnconfigure 3 -name creator -editable 0 02072 $widgets(themes_tl) columnconfigure 4 -name date -editable 0 -formatcommand [list pref_ui::themes_format_date] 02073 02074 bind $widgets(themes_tl) <<TablelistSelect>> [list pref_ui::themes_selected] 02075 bind [$widgets(themes_tl) bodytag] <Button-1> [list pref_ui::themes_left_click %W %x %y] 02076 02077 grid rowconfigure $b.tf 1 -weight 1 02078 grid columnconfigure $b.tf 0 -weight 1 02079 grid $b.tf.tl -row 0 -column 0 -sticky news -rowspan 2 02080 grid [$b.tf.tl cornerpath] -row 0 -column 1 -sticky news 02081 grid $b.tf.vb -row 1 -column 1 -sticky ns 02082 grid $b.tf.hb -row 2 -column 0 -sticky ew 02083 02084 ttk::frame $b.bf 02085 ttk::button $b.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::themes_add] 02086 set widgets(themes_del) [ttk::button $b.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::themes_delete] -state disabled] 02087 set widgets(themes_edit) [ttk::button $b.bf.edit -style BButton -text [msgcat::mc "Edit"] -command [list pref_ui::themes_edit] -state disabled] 02088 ttk::button $b.bf.more -style BButton -text [format "%s..." [msgcat::mc "Get More Themes"]] -command [list pref_ui::themes_get_more] 02089 02090 pack $b.bf.add -side left -padx 2 -pady 2 02091 pack $b.bf.del -side left -padx 2 -pady 2 02092 pack $b.bf.edit -side left -padx 2 -pady 2 02093 pack $b.bf.more -side right -padx 2 -pady 2 02094 02095 pack $b.tf -fill both -expand yes 02096 pack $b.bf -fill x 02097 02098 # Register the Appearance/HiddenThemes preference 02099 register $widgets(themes_tl) [msgcat::mc "Manage theme visibility"] Appearance/HiddenThemes 02100 02101 # Populate the themes table 02102 themes_populate_table 02103 02104 } 02105 02106 ###################################################################### 02107 # Update the Appearance/Colorize preference value to the selected 02108 # colorizer array. 02109 proc set_colorizers {} { 02110 02111 variable colorizers 02112 variable prefs 02113 02114 # Get the list of selected colorizers 02115 set colorize [list] 02116 foreach {name value} [array get colorizers] { 02117 if {$value} { 02118 lappend colorize $name 02119 } 02120 } 02121 02122 # Set the preference array 02123 set prefs(Appearance/Colorize) [lsort $colorize] 02124 02125 } 02126 02127 ###################################################################### 02128 # Sets the given font preference. 02129 proc set_font {lbl title varname mono} { 02130 02131 variable prefs 02132 02133 set opts [list] 02134 if {$mono} { 02135 lappend opts -mono 1 -styles Regular 02136 } 02137 02138 # Select the new font 02139 if {[set new_font [fontchooser -parent .prefwin -title $title -initialfont [$lbl cget -font] -effects 0 {*}$opts]] ne ""} { 02140 $lbl configure -font $new_font 02141 set prefs($varname) $new_font 02142 } 02143 02144 } 02145 02146 ###################################################################### 02147 # Displays the visibility value. 02148 proc themes_format_visible {value} { 02149 02150 return "" 02151 02152 } 02153 02154 ###################################################################### 02155 # Displays the imported value. 02156 proc themes_format_imported {value} { 02157 02158 return "" 02159 02160 } 02161 02162 ###################################################################### 02163 # Displays the version value. 02164 proc themes_format_date {value} { 02165 02166 if {$value ne ""} { 02167 return [clock format $value -format "%D"] 02168 } 02169 02170 return "" 02171 02172 } 02173 02174 ###################################################################### 02175 # Populates the themes table with the list of existing themes. 02176 proc themes_populate_table {} { 02177 02178 variable widgets 02179 02180 # If the preference window is not currently being shown, return immediately 02181 if {![info exists widgets(themes_tl)] || ![winfo exists $widgets(themes_tl)]} { 02182 return 02183 } 02184 02185 # Clear the table 02186 $widgets(themes_tl) delete 0 end 02187 02188 # Add the current themes to the table 02189 foreach name [themes::get_all_themes] { 02190 set visible [expr [lsearch [themes::get_visible_themes] $name] != -1] 02191 set imported [themes::get_imported $name] 02192 array set attrs [themes::get_attributions $name] 02193 set row [$widgets(themes_tl) insert end [list $name $visible $imported $attrs(creator) $attrs(date)]] 02194 if {$visible} { 02195 $widgets(themes_tl) cellconfigure $row,visible -image pref_checked 02196 } else { 02197 $widgets(themes_tl) cellconfigure $row,visible -image pref_unchecked 02198 } 02199 if {$imported} { 02200 $widgets(themes_tl) cellconfigure $row,imported -image pref_check 02201 } 02202 } 02203 02204 # Make sure that the state of the disable button is disabled since nothing will be selected 02205 $widgets(themes_del) configure -state disabled 02206 02207 } 02208 02209 ###################################################################### 02210 # Called whenever the selection state of the themes table changes. 02211 proc themes_selected {} { 02212 02213 variable widgets 02214 02215 # Update the state of the deletion button 02216 if {([set selected [$widgets(themes_tl) curselection]] eq "") || \ 02217 ([$widgets(themes_tl) cellcget $selected,imported -text] == 0) || \ 02218 ([$widgets(themes_tl) cellcget $selected,name -text] eq [theme::get_current_theme])} { 02219 $widgets(themes_del) configure -state disabled 02220 } else { 02221 $widgets(themes_del) configure -state normal 02222 } 02223 02224 # Update the state of the edit button 02225 if {$selected eq ""} { 02226 $widgets(themes_edit) configure -state disabled 02227 } else { 02228 $widgets(themes_edit) configure -state normal 02229 } 02230 02231 } 02232 02233 ###################################################################### 02234 # Handles a left-click on the themes table. If the user clicked on the 02235 # visibility cell, toggle the image value and update the HiddenThemes 02236 # preference. 02237 proc themes_left_click {W x y} { 02238 02239 variable prefs 02240 02241 lassign [tablelist::convEventFields $W $x $y] tbl x y 02242 lassign [split [$tbl containingcell $x $y] ,] row col 02243 02244 if {$row != -1} { 02245 if {[$tbl columncget $col -name] eq "visible"} { 02246 set name [$tbl cellcget $row,name -text] 02247 set value [$tbl cellcget $row,visible -text] 02248 if {$value} { 02249 $tbl cellconfigure $row,visible -text 0 -image pref_unchecked 02250 lappend prefs(Appearance/HiddenThemes) $name 02251 } else { 02252 $tbl cellconfigure $row,visible -text 1 -image pref_checked 02253 if {[set index [lsearch -exact $prefs(Appearance/HiddenThemes) $name]] != -1} { 02254 set prefs(Appearance/HiddenThemes) [lreplace $prefs(Appearance/HiddenThemes) $index $index] 02255 } 02256 } 02257 } 02258 } 02259 02260 } 02261 02262 ###################################################################### 02263 # Adds a new theme from the file system, importing it if necessary. 02264 proc themes_add {} { 02265 02266 # Allow the user to select a theme to import 02267 if {[themer::import .prefwin]} { 02268 02269 # Update the themes table 02270 themes_populate_table 02271 02272 } 02273 02274 } 02275 02276 ###################################################################### 02277 # Removes a theme from the file system. 02278 proc themes_delete {} { 02279 02280 variable widgets 02281 variable prefs 02282 02283 # Get the currently selected theme 02284 set selected [$widgets(themes_tl) curselection] 02285 set name [$widgets(themes_tl) cellcget $selected,name -text] 02286 02287 # Confirm with the user 02288 if {[tk_messageBox -parent .prefwin -type yesno -default no -message [format "%s %s %s?" [msgcat::mc "Delete"] $name [msgcat::mc "theme"]]] eq "no"} { 02289 return 02290 } 02291 02292 # Delete the theme 02293 themes::delete_theme $name 02294 02295 # Remove the theme from the hidden list so that we don't confuse the user if they reload the 02296 # theme. 02297 if {[set index [lsearch -exact $prefs(Appearance/HiddenThemes) $name]] != -1} { 02298 set prefs(Appearance/HiddentThemes) [lreplace $prefs(Appearance/HiddenThemes) $index $index] 02299 } 02300 02301 # Update the themes table 02302 themes_populate_table 02303 02304 } 02305 02306 ###################################################################### 02307 # Edits the selected theme. 02308 proc themes_edit {} { 02309 02310 variable widgets 02311 02312 # Get the selected theme 02313 set selected [$widgets(themes_tl) curselection] 02314 02315 # Make sure that the theme editor is opened 02316 themer::preview_theme [$widgets(themes_tl) cellcget $selected,name -text] 02317 02318 } 02319 02320 ###################################################################### 02321 # Sends the user to the themes webpage to find/download more themes. 02322 proc themes_get_more {} { 02323 02324 utils::open_file_externally "http://tke.sourceforge.net/themes.html" 02325 02326 } 02327 02328 ########## 02329 # EDITOR # 02330 ########## 02331 02332 ###################################################################### 02333 # Creates the editor panel. 02334 proc create_editor {w} { 02335 02336 variable widgets 02337 variable match_chars 02338 variable snip_compl 02339 variable prefs 02340 02341 ttk::frame $w.sf 02342 make_sb $w.sf.ww [msgcat::mc "Ruler column"] Editor/WarningWidth 20 150 5 1 02343 make_sb $w.sf.spt [msgcat::mc "Spaces per tab"] Editor/SpacesPerTab 1 20 1 1 02344 make_sb $w.sf.is [msgcat::mc "Indentation spaces"] Editor/IndentSpaces 1 20 1 1 02345 make_sb $w.sf.mu [msgcat::mc "Maximum undo history (set to 0 for unlimited)"] Editor/MaxUndo 0 200 10 1 02346 make_sb $w.sf.chd [msgcat::mc "Clipboard history depth"] Editor/ClipboardHistoryDepth 1 30 1 1 02347 make_sb $w.sf.vml [msgcat::mc "Line count to find Vim modeline information"] Editor/VimModelines 0 20 1 1 02348 02349 ttk::label $w.sf.eoll -text [format "%s: " [set wstr [msgcat::mc "End-of-line character when saving"]]] 02350 set widgets(editor_eolmb) [ttk::menubutton $w.sf.eolmb -menu [menu $w.sf.eol -tearoff 0]] 02351 02352 make_mb $w.sf.lna [msgcat::mc "Line number alignment"] Editor/LineNumberAlignment [list left right] 1 02353 02354 foreach {value desc} [list \ 02355 auto [msgcat::mc "Use original EOL character from file"] \ 02356 sys [msgcat::mc "Use appropriate EOL character on system"] \ 02357 cr [msgcat::mc "Use single carriage return character"] \ 02358 crlf [msgcat::mc "Use carriate return linefeed sequence"] \ 02359 lf [msgcat::mc "Use linefeed character"]] { 02360 $w.sf.eol add radiobutton -label $desc -value $value -variable pref_ui::prefs(Editor/EndOfLineTranslation) -command [list pref_ui::set_eol_translation] 02361 } 02362 02363 register $widgets(editor_eolmb) $wstr Editor/EndOfLineTranslation 02364 02365 grid $w.sf.eoll -row 7 -column 0 -sticky news -padx 2 -pady 2 02366 grid $w.sf.eolmb -row 7 -column 1 -sticky news -padx 2 -pady 2 02367 02368 ttk::labelframe $w.mcf -text [set wstr [msgcat::mc "Auto-match Characters"]] 02369 ttk::checkbutton $w.mcf.sr -text [format " %s" [msgcat::mc "Square bracket"]] -variable pref_ui::match_chars(square) -command [list pref_ui::set_match_chars] 02370 ttk::checkbutton $w.mcf.cu -text [format " %s" [msgcat::mc "Curly bracket"]] -variable pref_ui::match_chars(curly) -command [list pref_ui::set_match_chars] 02371 ttk::checkbutton $w.mcf.an -text [format " %s" [msgcat::mc "Angled bracket"]] -variable pref_ui::match_chars(angled) -command [list pref_ui::set_match_chars] 02372 ttk::checkbutton $w.mcf.pa -text [format " %s" [msgcat::mc "Parenthesis"]] -variable pref_ui::match_chars(paren) -command [list pref_ui::set_match_chars] 02373 ttk::checkbutton $w.mcf.dq -text [format " %s" [msgcat::mc "Double-quote"]] -variable pref_ui::match_chars(double) -command [list pref_ui::set_match_chars] 02374 ttk::checkbutton $w.mcf.sq -text [format " %s" [msgcat::mc "Single-quote"]] -variable pref_ui::match_chars(single) -command [list pref_ui::set_match_chars] 02375 ttk::checkbutton $w.mcf.bt -text [format " %s" [msgcat::mc "Backtick"]] -variable pref_ui::match_chars(btick) -command [list pref_ui::set_match_chars] 02376 02377 register $w.mcf.sr $wstr Editor/AutoMatchChars 02378 02379 grid columnconfigure $w.mcf 1 -weight 1 02380 grid columnconfigure $w.mcf 3 -weight 1 02381 grid columnconfigure $w.mcf 5 -weight 1 02382 grid $w.mcf.sr -row 0 -column 0 -sticky news -padx 2 -pady 2 02383 grid $w.mcf.cu -row 0 -column 2 -sticky news -padx 2 -pady 2 02384 grid $w.mcf.an -row 0 -column 4 -sticky news -padx 2 -pady 2 02385 grid $w.mcf.pa -row 0 -column 6 -sticky news -padx 2 -pady 2 02386 grid $w.mcf.dq -row 1 -column 0 -sticky news -padx 2 -pady 2 02387 grid $w.mcf.sq -row 1 -column 2 -sticky news -padx 2 -pady 2 02388 grid $w.mcf.bt -row 1 -column 4 -sticky news -padx 2 -pady 2 02389 02390 ttk::frame $w.cf 02391 make_cb $w.cf.vm [msgcat::mc "Enable Vim Mode"] Editor/VimMode 02392 make_cb $w.cf.eai [msgcat::mc "Enable auto-indentation"] Editor/EnableAutoIndent 02393 make_cb $w.cf.hmc [msgcat::mc "Automatically highlight matching bracket"] Editor/HighlightMatchingChar 02394 make_cb $w.cf.hmmb [msgcat::mc "Automatically highlight mismatching brackets"] Editor/HighlightMismatchingChar 02395 make_cb $w.cf.rtw [msgcat::mc "Remove trailing whitespace on save"] Editor/RemoveTrailingWhitespace 02396 make_cb $w.cf.rln [msgcat::mc "Enable relative line numbering"] Editor/RelativeLineNumbers 02397 02398 pack $w.sf -fill x -padx 2 -pady 2 02399 make_spacer $w 02400 pack $w.mcf -fill x -padx 2 -pady 2 02401 make_spacer $w 02402 pack $w.cf -fill x -padx 2 -pady 2 02403 02404 # Set the UI state to match preference 02405 foreach char [list square curly angled paren double single btick] { 02406 set match_chars($char) [expr {[lsearch $prefs(Editor/AutoMatchChars) $char] != -1}] 02407 } 02408 02409 foreach char [list space tab return] { 02410 set snip_compl($char) [expr {[lsearch $prefs(Editor/SnippetCompleters) $char] != -1}] 02411 } 02412 02413 set_eol_translation 02414 02415 } 02416 02417 ###################################################################### 02418 # Set the matching chars to the Editor/AutoMatchChars preference value. 02419 proc set_match_chars {} { 02420 02421 variable match_chars 02422 variable prefs 02423 02424 set mchars [list] 02425 foreach char [list square curly angled paren double single btick] { 02426 if {$match_chars($char)} { 02427 lappend mchars $char 02428 } 02429 } 02430 02431 set prefs(Editor/AutoMatchChars) $mchars 02432 02433 } 02434 02435 ###################################################################### 02436 # Set the snippet completers to the Editor/SnippetCompleters preference 02437 # value. 02438 proc set_snip_compl {} { 02439 02440 variable snip_compl 02441 variable prefs 02442 02443 set schars [list] 02444 foreach char [list space tab return] { 02445 if {$snip_compl($char)} { 02446 lappend schars $char 02447 } 02448 } 02449 02450 set prefs(Editor/SnippetCompleters) $schars 02451 02452 } 02453 02454 ###################################################################### 02455 # Sets the EOL translation menubutton text to the given value 02456 proc set_eol_translation {} { 02457 02458 variable widgets 02459 variable prefs 02460 02461 $widgets(editor_eolmb) configure -text $prefs(Editor/EndOfLineTranslation) 02462 02463 } 02464 02465 ######### 02466 # EMMET # 02467 ######### 02468 02469 ###################################################################### 02470 # Creates the Emmet panel. 02471 proc create_emmet {w} { 02472 02473 variable widgets 02474 variable prefs 02475 02476 ttk::notebook $w.nb 02477 02478 ########### 02479 # GENERAL # 02480 ########### 02481 02482 $w.nb add [set a [ttk::frame $w.nb.gf]] -text [msgcat::mc "General"] 02483 02484 make_cb $a.aivp [msgcat::mc "Automatically insert vendor prefixes"] Emmet/CSSAutoInsertVendorPrefixes 02485 make_cb $a.cs [msgcat::mc "Use shortened colors"] Emmet/CSSColorShort 02486 make_cb $a.fs [msgcat::mc "Enable fuzzy search"] Emmet/CSSFuzzySearch 02487 02488 make_spacer $a 02489 02490 ttk::frame $a.of 02491 ttk::label $a.of.ccl -text [format "%s: " [set wstr [msgcat::mc "Color value case"]]] 02492 set widgets(emmet_ccmb) [ttk::menubutton $a.of.ccmb -menu [menu $a.of.ccmb_mnu -tearoff 0]] 02493 02494 foreach {value lbl} [list upper [msgcat::mc "Convert to uppercase"] \ 02495 lower [msgcat::mc "Convert to lowercase"] \ 02496 keep [msgcat::mc "Retain case"]] { 02497 $a.of.ccmb_mnu add radiobutton -label $lbl -value $value -variable pref_ui::prefs(Emmet/CSSColorCase) -command [list pref_ui::set_css_color_case] 02498 } 02499 02500 register $widgets(emmet_ccmb) $wstr Emmet/CSSColorCase 02501 02502 pack $a.of.ccl -side left -padx 2 -pady 2 02503 pack $a.of.ccmb -side left -padx 2 -pady 2 02504 pack $a.of -fill x 02505 02506 make_spacer $a 02507 make_entry $a.iu [msgcat::mc "Default unit for integer values"] Emmet/CSSIntUnit 02508 make_entry $a.fu [msgcat::mc "Default unit for floating point values"] Emmet/CSSFloatUnit 02509 make_entry $a.vs [msgcat::mc "Symbol between CSS property and value"] Emmet/CSSValueSeparator 02510 make_entry $a.pe [msgcat::mc "Symbol placed at end of CSS property"] Emmet/CSSPropertyEnd 02511 02512 ########## 02513 # ADDONS # 02514 ########## 02515 02516 $w.nb add [set b [ttk::frame $w.nb.af]] -text [msgcat::mc "Addons"] 02517 02518 foreach {type var} { 02519 Mozilla Emmet/CSSMozPropertiesAddon \ 02520 MS Emmet/CSSMSPropertiesAddon \ 02521 Opera Emmet/CSSOPropertiesAddon \ 02522 Webkit Emmet/CSSWebkitPropertiesAddon} { 02523 make_token $b.[string tolower $type] [format "$type %s" [msgcat::mc "Properties"]] $var "" 02524 } 02525 02526 ################ 02527 # NODE ALIASES # 02528 ################ 02529 02530 $w.nb add [set widgets(node_aliases) [set c [ttk::frame $w.nb.nf]]] -text [set wstr [msgcat::mc "Node Aliases"]] 02531 02532 ttk::frame $c.tf 02533 set widgets(emmet_na_tl) [tablelist::tablelist $c.tf.tl \ 02534 -columns [list 0 [msgcat::mc "Alias"] 0 [msgcat::mc "Node"] 0 [msgcat::mc "Closing"] 0 [msgcat::mc "Attributes"]] \ 02535 -exportselection 0 -editselectedonly 1 -stretch all \ 02536 -borderwidth 0 -highlightthickness 0 \ 02537 -editstartcommand [list pref_ui::emmet_na_edit_start_command] \ 02538 -editendcommand [list pref_ui::emmet_na_edit_end_command] \ 02539 -xscrollcommand [list utils::set_xscrollbar $c.tf.hb] \ 02540 -yscrollcommand [list utils::set_yscrollbar $c.tf.vb]] 02541 scroller::scroller $c.tf.vb -orient vertical -command [list $widgets(emmet_na_tl) yview] 02542 scroller::scroller $c.tf.hb -orient horizontal -command [list $widgets(emmet_na_tl) xview] 02543 02544 $widgets(emmet_na_tl) columnconfigure 0 -name alias -editable 1 -stretchable 1 -resizable 1 02545 $widgets(emmet_na_tl) columnconfigure 1 -name name -editable 1 -stretchable 1 -resizable 1 02546 $widgets(emmet_na_tl) columnconfigure 2 -name ending -editable 1 -stretchable 0 -resizable 1 \ 02547 -editwindow ttk::menubutton 02548 $widgets(emmet_na_tl) columnconfigure 3 -name attrs -editable 1 -stretchable 1 -resizable 1 02549 02550 bind $widgets(emmet_na_tl) <<TablelistSelect>> [list pref_ui::handle_emmet_na_select] 02551 02552 grid rowconfigure $c.tf 1 -weight 1 02553 grid columnconfigure $c.tf 0 -weight 1 02554 grid $c.tf.tl -row 0 -column 0 -sticky news -rowspan 2 02555 grid [$c.tf.tl cornerpath] -row 0 -column 1 -sticky news 02556 grid $c.tf.vb -row 1 -column 1 -sticky ns 02557 grid $c.tf.hb -row 2 -column 0 -sticky ew 02558 02559 ttk::frame $c.bf 02560 ttk::button $c.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::emmet_na_add] 02561 set widgets(emmet_na_del) [ttk::button $c.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::emmet_na_del] -state disabled] 02562 02563 pack $c.bf.add -side left -padx 2 -pady 2 02564 pack $c.bf.del -side left -padx 2 -pady 2 02565 02566 array set sb_opts [theme::get_category_options text_scrollbar 1] 02567 02568 ttk::labelframe $c.lf -text [msgcat::mc "Preview"] 02569 frame $c.lf.f 02570 set widgets(emmet_na_preview) [ctext $c.lf.f.t -height 10 -state disabled \ 02571 -xscrollcommand [list $c.lf.f.hb set] -yscrollcommand [list $c.lf.f.vb set]] 02572 scroller::scroller $c.lf.f.vb {*}[array get sb_opts] -orient vertical -autohide 1 -command [list $c.lf.f.t yview] 02573 scroller::scroller $c.lf.f.hb {*}[array get sb_opts] -orient horizontal -autohide 0 -command [list $c.lf.f.t xview] 02574 02575 update_theme $widgets(emmet_na_preview) 02576 02577 theme::register_widget $widgets(emmet_na_preview) syntax_prefs 02578 theme::register_widget $c.lf.f.vb text_scrollbar 02579 theme::register_widget $c.lf.f.hb text_scrollbar 02580 02581 indent::add_bindings $widgets(emmet_na_preview) 02582 syntax::set_language $widgets(emmet_na_preview) "HTML" 02583 02584 # This is needed to keep the modified event from being handled by the editing buffers 02585 bind $widgets(emmet_na_preview) <<Modified>> "break" 02586 02587 grid rowconfigure $c.lf.f 0 -weight 1 02588 grid columnconfigure $c.lf.f 0 -weight 1 02589 grid $c.lf.f.t -row 0 -column 0 -sticky news 02590 grid $c.lf.f.vb -row 0 -column 1 -sticky ns 02591 grid $c.lf.f.hb -row 1 -column 0 -sticky ew 02592 02593 pack $c.lf.f -fill both -expand yes 02594 02595 pack $c.tf -padx 2 -pady 2 -fill both -expand yes 02596 pack $c.bf -padx 2 -pady 2 -fill x 02597 pack [ttk::separator $c.sep -orient horizontal] -padx 2 -pady 2 -fill x -expand yes 02598 pack $c.lf -padx 2 -pady 2 -fill x 02599 02600 register $c.tf.tl $wstr Emmet/NodeAliases 02601 02602 ######################## 02603 # ABBREVIATION ALIASES # 02604 ######################## 02605 02606 $w.nb add [set widgets(abbr_aliases) [set d [ttk::frame $w.nb.vf]]] -text [set wstr [msgcat::mc "Abbreviation Aliases"]] 02607 02608 ttk::frame $d.tf 02609 set widgets(emmet_aa_tl) [tablelist::tablelist $d.tf.tl \ 02610 -columns [list 0 [msgcat::mc "Alias"] 0 [msgcat::mc "Value"]] \ 02611 -exportselection 0 -stretch all -editselectedonly 1 \ 02612 -borderwidth 0 -highlightthickness 0 \ 02613 -editendcommand [list pref_ui::emmet_aa_edit_end_command] \ 02614 -xscrollcommand [list utils::set_xscrollbar $d.tf.hb] \ 02615 -yscrollcommand [list utils::set_yscrollbar $d.tf.vb]] 02616 scroller::scroller $d.tf.vb -orient vertical -command [list $d.tf.tl yview] 02617 scroller::scroller $d.tf.hb -orient horizontal -command [list $d.tf.tl xview] 02618 02619 $widgets(emmet_aa_tl) columnconfigure 0 -name alias -editable 1 -resizable 1 -stretchable 0 02620 $widgets(emmet_aa_tl) columnconfigure 1 -name value -editable 1 -resizable 1 -stretchable 1 02621 02622 bind $widgets(emmet_aa_tl) <<TablelistSelect>> [list pref_ui::handle_emmet_aa_select] 02623 02624 grid rowconfigure $d.tf 1 -weight 1 02625 grid columnconfigure $d.tf 0 -weight 1 02626 grid $d.tf.tl -row 0 -column 0 -sticky news -rowspan 2 02627 grid [$d.tf.tl cornerpath] -row 0 -column 1 -sticky news 02628 grid $d.tf.vb -row 1 -column 1 -sticky ns 02629 grid $d.tf.hb -row 2 -column 0 -sticky ew 02630 02631 ttk::frame $d.bf 02632 ttk::button $d.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::emmet_aa_add] 02633 set widgets(emmet_aa_del) [ttk::button $d.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::emmet_aa_del] -state disabled] 02634 02635 pack $d.bf.add -side left -padx 2 -pady 2 02636 pack $d.bf.del -side left -padx 2 -pady 2 02637 02638 array set sb_opts [theme::get_category_options text_scrollbar 1] 02639 02640 ttk::labelframe $d.lf -text [msgcat::mc "Preview"] 02641 frame $d.lf.f 02642 set widgets(emmet_aa_preview) [ctext $d.lf.f.t -height 10 -state disabled \ 02643 -xscrollcommand [list $d.lf.f.hb set] -yscrollcommand [list $d.lf.f.vb set]] 02644 scroller::scroller $d.lf.f.vb {*}[array get sb_opts] -orient vertical -autohide 1 -command [list $d.lf.f.t yview] 02645 scroller::scroller $d.lf.f.hb {*}[array get sb_opts] -orient horizontal -autohide 0 -command [list $d.lf.f.t xview] 02646 02647 update_theme $widgets(emmet_aa_preview) 02648 02649 theme::register_widget $widgets(emmet_aa_preview) syntax_prefs 02650 theme::register_widget $d.lf.f.vb text_scrollbar 02651 theme::register_widget $d.lf.f.hb text_scrollbar 02652 02653 indent::add_bindings $widgets(emmet_aa_preview) 02654 syntax::set_language $widgets(emmet_aa_preview) "HTML" 02655 02656 # This is needed to keep the modified event from being handled by the editing buffers 02657 bind $widgets(emmet_aa_preview) <<Modified>> "break" 02658 02659 grid rowconfigure $d.lf.f 0 -weight 1 02660 grid columnconfigure $d.lf.f 0 -weight 1 02661 grid $d.lf.f.t -row 0 -column 0 -sticky news 02662 grid $d.lf.f.vb -row 0 -column 1 -sticky ns 02663 grid $d.lf.f.hb -row 1 -column 0 -sticky ew 02664 02665 pack $d.lf.f -fill both -expand yes 02666 02667 pack $d.tf -padx 2 -pady 2 -fill both -expand yes 02668 pack $d.bf -padx 2 -pady 2 -fill x 02669 pack [ttk::separator $d.sep -orient horizontal] -padx 2 -pady 2 -fill x -expand yes 02670 pack $d.lf -padx 2 -pady 2 -fill x 02671 02672 register $d.tf.tl $wstr Emmet/AbbreviationAliases 02673 02674 pack $w.nb -fill both -expand yes 02675 02676 # Initialize the UI state 02677 set_css_color_case 02678 set_aliases 02679 02680 } 02681 02682 ###################################################################### 02683 # Update the UI state to match the value of Emmet/CSSColorCase. 02684 proc set_css_color_case {} { 02685 02686 variable widgets 02687 variable prefs 02688 02689 $widgets(emmet_ccmb) configure -text $prefs(Emmet/CSSColorCase) 02690 02691 } 02692 02693 ###################################################################### 02694 # Adds the Emmet aliases information to the UI. 02695 proc set_aliases {} { 02696 02697 variable widgets 02698 02699 # Retrieve the aliases from the Emmet namespace 02700 array set aliases [emmet::get_aliases] 02701 02702 array set endings { 02703 0 <x/> 02704 1 <x></x> 02705 2 None 02706 } 02707 02708 # Add the node aliases 02709 array set node_aliases $aliases(node_aliases) 02710 foreach alias [lsort [array names node_aliases]] { 02711 lassign $node_aliases($alias) name ending attrs 02712 set attr_value [list] 02713 foreach {attr value} $attrs { 02714 lappend attr_value "$attr=\"$value\"" 02715 } 02716 $widgets(emmet_na_tl) insert end [list $alias $name $endings($ending) [join $attr_value]] 02717 } 02718 02719 # Add the abbreviation aliases 02720 array set abbr_aliases $aliases(abbreviation_aliases) 02721 foreach alias [lsort [array names abbr_aliases]] { 02722 $widgets(emmet_aa_tl) insert end [list $alias $abbr_aliases($alias)] 02723 } 02724 02725 02726 } 02727 ###################################################################### 02728 # Called when a cell is started to be edited. 02729 proc emmet_na_edit_start_command {tbl row col value} { 02730 02731 if {[$tbl columncget $col -name] eq "ending"} { 02732 set w [$tbl editwinpath] 02733 set mnu [$w cget -menu] 02734 $mnu delete 0 end 02735 foreach type [list <x/> <x></x> None] { 02736 $mnu add radiobutton -label $type 02737 } 02738 } 02739 02740 return $value 02741 02742 } 02743 02744 ###################################################################### 02745 # Called when a cell has completed being edited. 02746 proc emmet_na_edit_end_command {tbl row col value} { 02747 02748 # Get the row contents 02749 lassign [$tbl rowcget $row -text] alias name ending attrs 02750 02751 set curr_alias $alias 02752 02753 # Replace the equality sign in the attrs list with a space 02754 set attrs [string map {= { }} $attrs] 02755 02756 array set endings { 02757 <x/> 0 02758 <x></x> 1 02759 None 2 02760 } 02761 02762 switch [$tbl columncget $col -name] { 02763 alias { set alias $value } 02764 name { set name $value } 02765 ending { set ending $value } 02766 attrs { set attrs [string map {= { }} $value] } 02767 } 02768 02769 # Save the alias if it's worth saving 02770 if {$name ne ""} { 02771 emmet::update_alias node_aliases $curr_alias $alias [list $name $endings($ending) $attrs] 02772 } 02773 02774 # Display the generated code 02775 emmet_na_show_preview $alias 02776 02777 return $value 02778 02779 } 02780 02781 ###################################################################### 02782 # Show the given string value in the preview text. 02783 proc emmet_na_show_preview {alias} { 02784 02785 variable widgets 02786 02787 $widgets(emmet_na_preview) configure -state normal 02788 $widgets(emmet_na_preview) delete 1.0 end 02789 02790 # Get the alias data 02791 lassign [emmet::lookup_node_alias $alias] name ending attrs 02792 02793 if {$name ne ""} { 02794 02795 # Construct the node 02796 set str "<$name" 02797 foreach {attr value} $attrs { 02798 append str " $attr=\"$value\"" 02799 } 02800 switch $ending { 02801 0 { append str " />" } 02802 1 { append str "></$name>" } 02803 2 { append str ">" } 02804 } 02805 02806 set index 1 02807 while {[regexp {(.*?)\{\|(.*?)\}(.*)$} $str -> before value after]} { 02808 if {$value eq ""} { 02809 set str "$before\$$index$after" 02810 } else { 02811 set str "$before\${$index:$value}$after" 02812 } 02813 incr index 02814 } 02815 02816 # Insert the resulting string as a snippet 02817 snippets::insert_snippet $widgets(emmet_na_preview).t $str -traverse 0 02818 02819 } 02820 02821 $widgets(emmet_na_preview) configure -state disabled 02822 02823 } 02824 02825 ###################################################################### 02826 # Handles a change to the abbreviation table selection. 02827 proc handle_emmet_na_select {} { 02828 02829 variable widgets 02830 02831 # Get the current selection 02832 set selected [$widgets(emmet_na_tl) curselection] 02833 02834 if {$selected ne ""} { 02835 $widgets(emmet_na_del) configure -state normal 02836 } else { 02837 $widgets(emmet_na_del) configure -state disabled 02838 } 02839 02840 # Update the preview 02841 emmet_na_show_preview [$widgets(emmet_na_tl) cellcget $selected,alias -text] 02842 02843 } 02844 02845 ###################################################################### 02846 # Adds a new row to the abbreviation alias table. 02847 proc emmet_na_add {} { 02848 02849 variable widgets 02850 02851 # Add a new row to the table 02852 set row [$widgets(emmet_na_tl) insert end [list "" "" <x></x> ""]] 02853 02854 # Make the first entry to be editable 02855 $widgets(emmet_na_tl) editcell $row,alias 02856 02857 } 02858 02859 ###################################################################### 02860 # Deletes the currently selected row 02861 proc emmet_na_del {} { 02862 02863 variable widgets 02864 02865 # Get the currently selected row 02866 set selected [$widgets(emmet_na_tl) curselection] 02867 02868 # Get the aliased name 02869 set alias_name [$widgets(emmet_na_tl) cellcget $selected,alias -text] 02870 02871 # Delete the item 02872 $widgets(emmet_na_tl) delete $selected 02873 02874 # Set the state of the delete button to disabled 02875 $widgets(emmet_na_del) configure -state disabled 02876 02877 # Save the deletion 02878 emmet::update_alias node_aliases $alias_name "" "" 02879 02880 } 02881 02882 ###################################################################### 02883 # Show the given string value in the preview text. 02884 proc emmet_aa_show_preview {str} { 02885 02886 variable widgets 02887 02888 set retval 0 02889 02890 $widgets(emmet_aa_preview) configure -state normal 02891 $widgets(emmet_aa_preview) delete 1.0 end 02892 02893 if {![catch { ::parse_emmet $str "" } str]} { 02894 snippets::insert_snippet $widgets(emmet_aa_preview).t $str -traverse 0 02895 set retval 1 02896 } 02897 02898 $widgets(emmet_aa_preview) configure -state disabled 02899 02900 return $retval 02901 02902 } 02903 02904 ###################################################################### 02905 # Handles any changes to column editing in the Emmet abbreviation table. 02906 proc emmet_aa_edit_end_command {tbl row col value} { 02907 02908 variable widgets 02909 02910 switch [$tbl columncget $col -name] { 02911 alias { 02912 set alias_value [$tbl cellcget $row,value -text] 02913 if {![catch { ::parse_emmet $alias_value "" }]} { 02914 emmet::update_alias abbreviation_aliases [$tbl cellcget $row,$col -text] $value $alias_value 02915 } 02916 } 02917 value { 02918 set alias_name [$tbl cellcget $row,alias -text] 02919 if {[emmet_aa_show_preview $value] && ($alias_name ne "")} { 02920 emmet::update_alias abbreviation_aliases $alias_name $alias_name $value 02921 } 02922 } 02923 } 02924 02925 return $value 02926 02927 } 02928 02929 ###################################################################### 02930 # Handles a change to the abbreviation table selection. 02931 proc handle_emmet_aa_select {} { 02932 02933 variable widgets 02934 02935 # Get the current selection 02936 set selected [$widgets(emmet_aa_tl) curselection] 02937 02938 if {$selected ne ""} { 02939 $widgets(emmet_aa_del) configure -state normal 02940 } else { 02941 $widgets(emmet_aa_del) configure -state disabled 02942 } 02943 02944 # Update the preview 02945 emmet_aa_show_preview [$widgets(emmet_aa_tl) cellcget $selected,value -text] 02946 02947 } 02948 02949 ###################################################################### 02950 # Adds a new row to the abbreviation alias table. 02951 proc emmet_aa_add {} { 02952 02953 variable widgets 02954 02955 # Add a new row to the table 02956 set row [$widgets(emmet_aa_tl) insert end [list "" ""]] 02957 02958 # Make the first entry to be editable 02959 $widgets(emmet_aa_tl) editcell $row,alias 02960 02961 } 02962 02963 ###################################################################### 02964 # Deletes the currently selected row 02965 proc emmet_aa_del {} { 02966 02967 variable widgets 02968 02969 # Get the currently selected row 02970 set selected [$widgets(emmet_aa_tl) curselection] 02971 02972 # Get the aliased name 02973 set alias_name [$widgets(emmet_aa_tl) cellcget $selected,alias -text] 02974 02975 # Delete the item 02976 $widgets(emmet_aa_tl) delete $selected 02977 02978 # Set the state of the delete button to disabled 02979 $widgets(emmet_aa_del) configure -state disabled 02980 02981 # Save the deletion 02982 emmet::update_alias abbreviation_aliases $alias_name "" "" 02983 02984 } 02985 02986 ######## 02987 # FIND # 02988 ######## 02989 02990 ###################################################################### 02991 # Creates the find panel. 02992 proc create_find {w} { 02993 02994 variable widgets 02995 variable prefs 02996 02997 make_sb $w.mh [msgcat::mc "Set find history depth"] Find/MaxHistory 0 100 10 1 02998 make_sb $w.cn [msgcat::mc "Set Find in Files line context"] Find/ContextNum 0 10 1 1 02999 make_sb $w.jd [msgcat::mc "Set jump distance"] Find/JumpDistance 1 20 1 1 03000 make_spacer $w 1 03001 make_mb $w.dsm [msgcat::mc "Default Find search method"] Find/DefaultMethod {regexp glob exact} 1 03002 make_mb $w.dfm [msgcat::mc "Default Find in Files search method"] Find/DefaultFIFMethod {regexp glob exact} 1 03003 make_spacer $w 1 03004 make_cb $w.cp [msgcat::mc "Close find panels when editing buffer gets focus"] Find/ClosePanelsOnTextFocus 1 03005 03006 } 03007 03008 ########### 03009 # SIDEBAR # 03010 ########### 03011 03012 ###################################################################### 03013 # Creates the sidebar panel. 03014 proc create_sidebar {w} { 03015 03016 variable widgets 03017 variable prefs 03018 variable attributes 03019 03020 ttk::notebook $w.nb 03021 03022 ################# 03023 # BEHAVIORS TAB # 03024 ################# 03025 03026 $w.nb add [set a [ttk::frame $w.nb.a]] -text [msgcat::mc "Behaviors"] 03027 03028 make_cb $a.rralc [msgcat::mc "Remove root directory after last sub-file is closed"] Sidebar/RemoveRootAfterLastClose 03029 make_cb $a.fat [msgcat::mc "Show folders at top"] Sidebar/FoldersAtTop 03030 make_cb $a.nat [msgcat::mc "Insert unsorted files at the top of a manually sorted directory"] Sidebar/ManualInsertNewAtTop 03031 make_spacer $a 03032 make_sb $a.kst [msgcat::mc "Append characters to search string if entered within"] Sidebar/KeySearchTimeout 100 3000 100 0 [msgcat::mc "milliseconds"] 03033 make_spacer $a 03034 make_sb $a.dw [msgcat::mc "Default sidebar width on startup"] Sidebar/DefaultWidth 100 600 10 0 [msgcat::mc "pixels"] 03035 03036 pack [ttk::button $a.dw.b -style BButton -text [msgcat::mc "Use current width"] -command [list pref_ui::sidebar_set_current_width $a.dw.sb]] -side left -padx 20 -pady 2 03037 03038 ############## 03039 # HIDING TAB # 03040 ############## 03041 03042 $w.nb add [set b [ttk::frame $w.nb.b]] -text [msgcat::mc "Hiding"] 03043 03044 make_cb $b.shf [msgcat::mc "Show hidden files"] Sidebar/ShowHiddenFiles 03045 make_cb $b.ib [msgcat::mc "Hide binary files"] Sidebar/IgnoreBinaries 03046 make_spacer $b 03047 set win [make_token $b.hp [msgcat::mc "Hide Patterns"] Sidebar/IgnoreFilePatterns ""] 03048 $win configure -height 6 03049 03050 ################## 03051 # INFO PANEL TAB # 03052 ################## 03053 03054 $w.nb add [set c [ttk::frame $w.nb.c]] -text [set wstr [msgcat::mc "Info Panel"]] 03055 03056 make_cb $c.kfiv [msgcat::mc "Keep information panel visible when sidebar doesn't have focus"] Sidebar/KeepInfoPanelVisible 03057 make_cb $c. [msgcat::mc "Update information panel whenever the sidebar selection changes"] Sidebar/InfoPanelFollowsSelection 03058 make_spacer $c 03059 make_sb $c.rtwpm [msgcat::mc "Reading time words per minute"] Sidebar/InfoPanelReadingTimeWordsPerMinute 100 400 5 03060 make_spacer $c 03061 03062 ttk::labelframe $c.if -text [set wstr [msgcat::mc "Displayed Information"]] 03063 03064 grid columnconfigure $c.if 1 -weight 1 03065 grid columnconfigure $c.if 3 -weight 1 03066 grid columnconfigure $c.if 5 -weight 1 03067 03068 # Pack the colorizer frame 03069 set attrs $prefs(Sidebar/InfoPanelAttributes) 03070 set i 0 03071 foreach attr [lsort [array names attributes]] { 03072 set attributes($attr) [expr {[lsearch $attrs $attr] != -1}] 03073 set row [expr $i % 4] 03074 set col [expr ($i / 4) * 2] 03075 grid [ttk::checkbutton $c.if.$attr -text " $attr" -variable pref_ui::attributes($attr) -command [list pref_ui::set_attributes]] -row $row -column $col -sticky news -padx 2 -pady 2 03076 incr i 03077 } 03078 03079 # Register the widget 03080 register $c.if.$attr $wstr Sidebar/InfoPanelAttributes 03081 03082 pack $w.nb.c.if -fill x -padx 2 -pady 2 03083 03084 pack $w.nb -fill both -expand yes 03085 03086 } 03087 03088 ###################################################################### 03089 # Sets the default sidebar width preference item to the current width 03090 # of the sidebar. 03091 proc sidebar_set_current_width {sb} { 03092 03093 # We will round the width to the nearest 10 pixel increment 03094 set width [expr round( [sidebar::get_width] / 10.0 ) * 10] 03095 03096 # Set the spinbox value to the width of the 03097 $sb set $width 03098 03099 # Update the variable 03100 handle_sb_change $sb Sidebar/DefaultWidth 03101 03102 } 03103 03104 ###################################################################### 03105 # Sets the displayed file information attributes preference item. 03106 proc set_attributes {} { 03107 03108 variable attributes 03109 variable prefs 03110 03111 set attrs [list] 03112 foreach {attr value} [array get attributes] { 03113 if {$value} { 03114 lappend attrs $attr 03115 } 03116 } 03117 03118 set prefs(Sidebar/InfoPanelAttributes) [lsort $attrs] 03119 03120 } 03121 03122 ######## 03123 # VIEW # 03124 ######## 03125 03126 ###################################################################### 03127 # Creates the view panel. 03128 proc create_view {w} { 03129 03130 make_cb $w.sm [msgcat::mc "Show menubar"] View/ShowMenubar 03131 make_cb $w.ss [msgcat::mc "Show sidebar"] View/ShowSidebar 03132 make_cb $w.ssb [msgcat::mc "Show status bar"] View/ShowStatusBar 03133 make_cb $w.stb [msgcat::mc "Show tab bar"] View/ShowTabBar 03134 make_cb $w.sln [msgcat::mc "Show line numbers"] View/ShowLineNumbers 03135 make_cb $w.smm [msgcat::mc "Show marker map"] View/ShowMarkerMap 03136 make_cb $w.sbe [msgcat::mc "Show bird's eye view"] View/ShowBirdsEyeView 03137 make_cb $w.sdio [msgcat::mc "Show difference file in other pane than original"] View/ShowDifferenceInOtherPane 03138 make_cb $w.sdvi [msgcat::mc "Show difference file version information"] View/ShowDifferenceVersionInfo 03139 make_cb $w.sfif [msgcat::mc "Show 'Find in Files' result in other pane"] View/ShowFindInFileResultsInOtherPane 03140 make_cb $w.ats [msgcat::mc "Allow scrolling in tab bar"] View/AllowTabScrolling 03141 make_cb $w.ota [msgcat::mc "Sort tabs alphabetically on open"] View/OpenTabsAlphabetically 03142 make_cb $w.ecf [msgcat::mc "Enable code folding"] View/EnableCodeFolding 03143 make_cb $w.sls [msgcat::mc "Show language submenu"] View/ShowLanguagesSubmenu 03144 03145 make_spacer $w 03146 03147 ttk::frame $w.sf 03148 make_sb $w.sf.sro [msgcat::mc "Recently opened history depth"] View/ShowRecentlyOpened 0 20 1 1 03149 make_sb $w.sf.befs [msgcat::mc "Bird's Eye View Font Size"] View/BirdsEyeViewFontSize 1 2 1 1 03150 make_sb $w.sf.bew [msgcat::mc "Bird's Eye View Width"] View/BirdsEyeViewWidth 30 80 5 1 03151 make_mb $w.sf.elw [msgcat::mc "Line Wrapping Default"] View/EnableLineWrapping [list syntax enable disable] 1 03152 pack $w.sf -fill x -pady 8 03153 03154 } 03155 03156 ############ 03157 # SNIPPETS # 03158 ############ 03159 03160 ###################################################################### 03161 # Create the snippets panel. 03162 proc create_snippets {w} { 03163 03164 variable widgets 03165 variable selected_language 03166 03167 ttk::notebook $w.nb 03168 03169 ############### 03170 # TABLE FRAME # 03171 ############### 03172 03173 $w.nb add [ttk::frame $w.sf] -text [msgcat::mc "Snippets"] 03174 03175 set widgets(snippets_tf) [ttk::frame $w.sf.tf] 03176 03177 ttk::frame $w.sf.tf.sf 03178 wmarkentry::wmarkentry $w.sf.tf.sf.e -width 20 -watermark [msgcat::mc "Search Snippets"] \ 03179 -validate key -validatecommand [list pref_ui::snippets_search %P] 03180 03181 set widgets(snippets_lang_frame) [ttk::frame $w.sf.tf.sf.lf] 03182 ttk::label $w.sf.tf.sf.lf.l -text [msgcat::mc "Language"] 03183 set widgets(snippets_lang) [ttk::menubutton $w.sf.tf.sf.lf.mb -text [msgcat::mc "Language"] \ 03184 -menu [pref_ui::snippets_create_menu $w]] 03185 03186 pack $w.sf.tf.sf.lf.l -side left -padx 2 -pady 2 03187 pack $w.sf.tf.sf.lf.mb -side left -padx 2 -pady 2 03188 03189 pack $w.sf.tf.sf.e -side left -padx 2 -pady 2 03190 pack $w.sf.tf.sf.lf -side right -padx 2 -pady 2 03191 03192 ttk::frame $w.sf.tf.tf 03193 set widgets(snippets_tl) [tablelist::tablelist $w.sf.tf.tf.tl \ 03194 -columns [list 0 [msgcat::mc "Keyword"] 0 [msgcat::mc "Snippet"]] \ 03195 -exportselection 0 -stretch all -borderwidth 0 -highlightthickness 0 \ 03196 -xscrollcommand [list utils::set_xscrollbar $w.sf.tf.tf.hb] \ 03197 -yscrollcommand [list utils::set_yscrollbar $w.sf.tf.tf.vb]] 03198 scroller::scroller $w.sf.tf.tf.vb -orient vertical -command [list $w.sf.tf.tf.tl yview] 03199 scroller::scroller $w.sf.tf.tf.hb -orient horizontal -command [list $w.sf.tf.tf.tl xview] 03200 03201 utils::tablelist_configure $widgets(snippets_tl) 03202 03203 $widgets(snippets_tl) columnconfigure 0 -name keyword -editable 0 -resizable 0 -stretchable 0 03204 $widgets(snippets_tl) columnconfigure 1 -name snippet -editable 0 -resizable 1 -stretchable 1 \ 03205 -wrap 0 -maxwidth 50 -formatcommand pref_ui::snippets_format_snippet 03206 03207 bind $widgets(snippets_tl) <<TablelistSelect>> [list pref_ui::snippets_select] 03208 bind [$widgets(snippets_tl) bodytag] <Double-Button-1> [list pref_ui::snippets_edit] 03209 03210 grid rowconfigure $w.sf.tf.tf 1 -weight 1 03211 grid columnconfigure $w.sf.tf.tf 0 -weight 1 03212 grid $w.sf.tf.tf.tl -row 0 -column 0 -sticky news -rowspan 2 03213 grid [$w.sf.tf.tf.tl cornerpath] -row 0 -column 1 -sticky news 03214 grid $w.sf.tf.tf.vb -row 1 -column 1 -sticky ns 03215 grid $w.sf.tf.tf.hb -row 2 -column 0 -sticky ew 03216 03217 ttk::frame $w.sf.tf.bf 03218 ttk::button $w.sf.tf.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::snippets_add] 03219 set widgets(snippets_del) [ttk::button $w.sf.tf.bf.del -style BButton -text [msgcat::mc "Delete"] \ 03220 -command [list pref_ui::snippets_del] -state disabled] 03221 03222 pack $w.sf.tf.bf.add -side left -padx 2 -pady 2 03223 pack $w.sf.tf.bf.del -side left -padx 2 -pady 2 03224 03225 pack $w.sf.tf.sf -fill x 03226 pack $w.sf.tf.tf -fill both -expand yes 03227 pack $w.sf.tf.bf -fill x 03228 03229 ############## 03230 # EDIT FRAME # 03231 ############## 03232 03233 set widgets(snippets_ef) [ttk::frame $w.sf.ef] 03234 03235 ttk::frame $w.sf.ef.kf 03236 ttk::label $w.sf.ef.kf.l -text [format "%s: " [msgcat::mc "Keyword"]] 03237 set widgets(snippets_keyword) [ttk::entry $w.sf.ef.kf.e -validate key -validatecommand [list pref_ui::snippets_keyword_changed %P]] 03238 03239 pack $w.sf.ef.kf.l -side left -padx 2 -pady 2 03240 pack $w.sf.ef.kf.e -side left -padx 2 -pady 2 -fill x -expand yes 03241 03242 array set sb_opts [theme::get_category_options text_scrollbar 1] 03243 03244 ttk::labelframe $w.sf.ef.tf -text [msgcat::mc "Snippet Text"] 03245 frame $w.sf.ef.tf.tf 03246 set widgets(snippets_text) [ctext $w.sf.ef.tf.tf.t -wrap none \ 03247 -xscrollcommand [list $w.sf.ef.tf.tf.hb set] -yscrollcommand [list $w.sf.ef.tf.tf.vb set]] 03248 scroller::scroller $w.sf.ef.tf.tf.vb {*}[array get sb_opts] -orient vertical -autohide 1 -command [list $w.sf.ef.tf.tf.t yview] 03249 scroller::scroller $w.sf.ef.tf.tf.hb {*}[array get sb_opts] -orient horizontal -autohide 0 -command [list $w.sf.ef.tf.tf.t xview] 03250 03251 bind $widgets(snippets_text) <<Modified>> [list if {[pref_ui::snippets_text_changed]} break] 03252 03253 update_theme $widgets(snippets_text) 03254 03255 theme::register_widget $widgets(snippets_text) syntax_prefs 03256 theme::register_widget $w.sf.ef.tf.tf.vb text_scrollbar 03257 theme::register_widget $w.sf.ef.tf.tf.hb text_scrollbar 03258 03259 indent::add_bindings $widgets(snippets_text) 03260 03261 set modifier [expr {([tk windowingsystem] eq "aqua") ? "Command" : "Control"}] 03262 03263 bind $widgets(snippets_text) <$modifier-c> { 03264 %W copy 03265 break 03266 } 03267 bind $widgets(snippets_text) <$modifier-x> { 03268 %W cut 03269 break 03270 } 03271 bind $widgets(snippets_text) <$modifier-v> { 03272 %W paste 03273 break 03274 } 03275 03276 grid rowconfigure $w.sf.ef.tf.tf 0 -weight 1 03277 grid columnconfigure $w.sf.ef.tf.tf 0 -weight 1 03278 grid $w.sf.ef.tf.tf.t -row 0 -column 0 -sticky news 03279 grid $w.sf.ef.tf.tf.vb -row 0 -column 1 -sticky ns 03280 grid $w.sf.ef.tf.tf.hb -row 1 -column 0 -sticky ew 03281 03282 pack $w.sf.ef.tf.tf -fill both -expand yes 03283 03284 set bwidth [msgcat::mcmax "Insert" "Save" "Cancel"] 03285 03286 ttk::frame $w.sf.ef.bf 03287 set widgets(snippets_ins) [ttk::button $w.sf.ef.bf.insert -style BButton -text [msgcat::mc "Insert"] -width $bwidth -command [list pref_ui::snippets_insert]] 03288 set widgets(snippets_save) [ttk::button $w.sf.ef.bf.save -style BButton -text [msgcat::mc "Save"] \ 03289 -width $bwidth -command [list pref_ui::snippets_save] -state disabled] 03290 ttk::button $w.sf.ef.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width $bwidth -command [list pref_ui::snippets_cancel] 03291 03292 pack $w.sf.ef.bf.insert -side left -padx 2 -pady 2 03293 pack $w.sf.ef.bf.cancel -side right -padx 2 -pady 2 03294 pack $w.sf.ef.bf.save -side right -padx 2 -pady 2 03295 03296 pack $w.sf.ef.kf -fill x 03297 pack $w.sf.ef.tf -fill both -expand yes 03298 pack $w.sf.ef.bf -fill x 03299 03300 # Display the table frame 03301 pack $w.sf.tf -fill both -expand yes 03302 03303 # Setup the snippet insert menu 03304 set widgets(snippets_ins_menu) [menu $w.sf.insPopup -tearoff 0] 03305 $widgets(snippets_ins_menu) add cascade -label [format "%s / %s" [msgcat::mc "Date"] [msgcat::mc "Time"]] -menu [menu $w.sf.datePopup -tearoff 0] 03306 $widgets(snippets_ins_menu) add cascade -label [msgcat::mc "File"] -menu [menu $w.sf.filePopup -tearoff 0] 03307 $widgets(snippets_ins_menu) add separator 03308 $widgets(snippets_ins_menu) add command -label [msgcat::mc "Selected Text"] -command [list pref_ui::snippets_insert_str "\$SELECTED_TEXT"] 03309 $widgets(snippets_ins_menu) add command -label [msgcat::mc "Clipboard"] -command [list pref_ui::snippets_insert_str "\$CLIPBOARD"] 03310 $widgets(snippets_ins_menu) add command -label [msgcat::mc "Clipboard History"] -command [list pref_ui::snippets_insert_str "\$CLIPHIST\[1\]"] 03311 $widgets(snippets_ins_menu) add separator 03312 $widgets(snippets_ins_menu) add command -label [msgcat::mc "Tab Stop"] -command [list pref_ui::snippets_insert_str "\${1}"] 03313 $widgets(snippets_ins_menu) add command -label [msgcat::mc "Cursor"] -command [list pref_ui::snippets_insert_str "\$0"] 03314 03315 # Setup the date/time submenu 03316 $w.sf.datePopup add command -label "01/13/2001" -command [list pref_ui::snippets_insert_str "\$CURRENT_DATE"] 03317 $w.sf.datePopup add command -label "2001/01/13" -command [list pref_ui::snippets_insert_str "\$CURRENT_DATE2"] 03318 $w.sf.datePopup add command -label "01:01 PM" -command [list pref_ui::snippets_insert_str "\$CURRENT_TIME"] 03319 $w.sf.datePopup add separator 03320 $w.sf.datePopup add command -label "Jan" -command [list pref_ui::snippets_insert_str "\$CURRENT_MON"] 03321 $w.sf.datePopup add command -label "January" -command [list pref_ui::snippets_insert_str "\$CURRENT_MONTH"] 03322 $w.sf.datePopup add command -label " 1" -command [list pref_ui::snippets_insert_str "\$CURRENT_MON1"] 03323 $w.sf.datePopup add command -label "01" -command [list pref_ui::snippets_insert_str "\$CURRENT_MON2"] 03324 $w.sf.datePopup add separator 03325 $w.sf.datePopup add command -label "Mon" -command [list pref_ui::snippets_insert_str "\$CURRENT_DAYN"] 03326 $w.sf.datePopup add command -label "Monday" -command [list pref_ui::snippets_insert_str "\$CURRENT_DAYNAME"] 03327 $w.sf.datePopup add command -label "1" -command [list pref_ui::snippets_insert_str "\$CURRENT_DAY1"] 03328 $w.sf.datePopup add command -label "01" -command [list pref_ui::snippets_insert_str "\$CURRENT_DAY2"] 03329 $w.sf.datePopup add separator 03330 $w.sf.datePopup add command -label "01" -command [list pref_ui::snippets_insert_str "\$CURRENT_YEAR2"] 03331 $w.sf.datePopup add command -label "2001" -command [list pref_ui::snippets_insert_str "\$CURRENT_YEAR"] 03332 03333 # Setup the file submenu 03334 $w.sf.filePopup add command -label [msgcat::mc "Current Directory"] -command [list pref_ui::snippets_insert_str "\$DIRECTORY"] 03335 $w.sf.filePopup add command -label [msgcat::mc "Current File Pathname"] -command [list pref_ui::snippets_insert_str "\$FILEPATH"] 03336 $w.sf.filePopup add command -label [msgcat::mc "Current Filename"] -command [list pref_ui::snippets_insert_str "\$FILENAME"] 03337 $w.sf.filePopup add separator 03338 $w.sf.filePopup add command -label [msgcat::mc "Current Line"] -command [list pref_ui::snippets_insert_str "\$CURRENT_LINE"] 03339 $w.sf.filePopup add command -label [msgcat::mc "Current Word"] -command [list pref_ui::snippets_insert_str "\$CURRENT_WORD"] 03340 $w.sf.filePopup add separator 03341 $w.sf.filePopup add command -label [msgcat::mc "Current Line Number"] -command [list pref_ui::snippets_insert_str "\$LINE_NUMBER"] 03342 $w.sf.filePopup add command -label [msgcat::mc "Current Line Column"] -command [list pref_ui::snippets_insert_str "\$LINE_INDEX"] 03343 03344 # Populate the snippets table 03345 snippets_set_language $selected_language 03346 03347 ################## 03348 # COMPLETERS TAB # 03349 ################## 03350 03351 $w.nb add [ttk::frame $w.nb.opt] -text [msgcat::mc "Options"] 03352 03353 ttk::labelframe $w.nb.opt.scf -text [set wstr [msgcat::mc "Snippet Completion Characters"]] 03354 pack [ttk::checkbutton $w.nb.opt.scf.s -text [format " %s" [msgcat::mc "Space"]] -variable pref_ui::snip_compl(space) -command [list pref_ui::set_snip_compl]] -fill x -padx 2 -pady 2 03355 pack [ttk::checkbutton $w.nb.opt.scf.t -text [format " %s" [msgcat::mc "Tab"]] -variable pref_ui::snip_compl(tab) -command [list pref_ui::set_snip_compl]] -fill x -padx 2 -pady 2 03356 pack [ttk::checkbutton $w.nb.opt.scf.r -text [format " %s" [msgcat::mc "Return"]] -variable pref_ui::snip_compl(return) -command [list pref_ui::set_snip_compl]] -fill x -padx 2 -pady 2 03357 03358 register $w.nb.opt.scf.s $wstr Editor/SnippetCompleters 03359 03360 pack $w.nb.opt.scf -fill x -padx 2 -pady 2 03361 03362 make_spacer $w.nb.opt 03363 make_cb $w.nb.opt.sfai [msgcat::mc "Format snippet indentation after insert"] Editor/SnippetFormatAfterInsert 03364 03365 pack $w.nb -fill both -expand yes 03366 03367 } 03368 03369 ###################################################################### 03370 # Format the given snippet 03371 proc snippets_format_snippet {value} { 03372 03373 set lines [split $value \n] 03374 03375 if {[llength $lines] <= 4} { 03376 return [join $lines \n] 03377 } else { 03378 return [join [concat [lrange $lines 0 2] ...] \n] 03379 } 03380 03381 } 03382 03383 ###################################################################### 03384 # Performs real-time search of the snippet table. 03385 proc snippets_search {value} { 03386 03387 variable widgets 03388 03389 if {$value eq ""} { 03390 for {set i 0} {$i < [$widgets(snippets_tl) size]} {incr i} { 03391 $widgets(snippets_tl) rowconfigure $i -hide 0 03392 } 03393 } else { 03394 for {set i 0} {$i < [$widgets(snippets_tl) size]} {incr i} { 03395 if {[string match -nocase "*$value*" [$widgets(snippets_tl) cellcget $i,keyword -text]] || \ 03396 [string match -nocase "*$value*" [$widgets(snippets_tl) cellcget $i,snippet -text]]} { 03397 $widgets(snippets_tl) rowconfigure $i -hide 0 03398 } else { 03399 $widgets(snippets_tl) rowconfigure $i -hide 1 03400 } 03401 } 03402 } 03403 03404 return 1 03405 03406 } 03407 03408 ###################################################################### 03409 # Handles a change of selection in the snippets table. Basically, this 03410 # just causes the delete button to be enabled. 03411 proc snippets_select {} { 03412 03413 variable widgets 03414 03415 if {[$widgets(snippets_tl) curselection] eq ""} { 03416 $widgets(snippets_del) configure -state disabled 03417 } else { 03418 $widgets(snippets_del) configure -state normal 03419 } 03420 03421 } 03422 03423 ###################################################################### 03424 # Adds a new snippet. 03425 proc snippets_add {} { 03426 03427 variable widgets 03428 variable snip_data 03429 03430 # Indicate that the current type of snippet editing is an add 03431 set snip_data(edit_type) "add" 03432 03433 # Set the selected syntax 03434 syntax::set_language $widgets(snippets_text) $snip_data(lang) 03435 03436 # Display the editing frame 03437 pack forget $widgets(snippets_tf) 03438 pack $widgets(snippets_ef) -fill both -expand yes 03439 03440 # Place the focus on the keyword entry field 03441 focus $widgets(snippets_keyword) 03442 03443 } 03444 03445 ###################################################################### 03446 # Edits the currently selected snippet in the table. 03447 proc snippets_edit {} { 03448 03449 variable widgets 03450 variable snip_data 03451 03452 # Get the currently selected row 03453 set selected [$widgets(snippets_tl) curselection] 03454 03455 # Indicate that the current type of snippet editing is an edit 03456 set snip_data(edit_type) "edit" 03457 set snip_data(edit_row) $selected 03458 03459 # Display the editing frame 03460 pack forget $widgets(snippets_tf) 03461 pack $widgets(snippets_ef) -fill both -expand yes 03462 03463 # Insert the widget information in the entry and text fields 03464 $widgets(snippets_keyword) insert end [$widgets(snippets_tl) cellcget $selected,keyword -text] 03465 $widgets(snippets_text) insert end [$widgets(snippets_tl) cellcget $selected,snippet -text] 03466 03467 # Disable the save button 03468 $widgets(snippets_save) configure -state disabled 03469 03470 # Place the focus on the text widget 03471 focus $widgets(snippets_text).t 03472 03473 } 03474 03475 ###################################################################### 03476 # Deletes the currently selected row in the table and performs a save 03477 # operation. 03478 proc snippets_del {} { 03479 03480 variable widgets 03481 03482 # Get the currently selected row 03483 set selected [$widgets(snippets_tl) curselection] 03484 03485 # Get the snippet keyword 03486 set keyword [$widgets(snippets_tl) cellcget $selected,keyword -text] 03487 03488 # Ask the user if they really want to delete the entry 03489 set ans [tk_messageBox -parent .prefwin -type okcancel -default cancel -icon question \ 03490 -message [format "%s %s" [msgcat::mc "Delete snippet"] $keyword]] 03491 03492 if {$ans eq "ok"} { 03493 $widgets(snippets_tl) delete $selected 03494 snippets_save_table 03495 } 03496 03497 } 03498 03499 ###################################################################### 03500 # Create the language menu. 03501 proc snippets_create_menu {w} { 03502 03503 variable widgets 03504 03505 # Create the menu 03506 set widgets(snippets_lang_menu) [menu $w.langPopup -tearoff 0] 03507 03508 # Populate the menu 03509 syntax::populate_syntax_menu $widgets(snippets_lang_menu) pref_ui::snippets_set_language pref_ui::snip_data(lang) "All" [syntax::get_all_languages] 03510 03511 return $widgets(snippets_lang_menu) 03512 03513 } 03514 03515 ###################################################################### 03516 # Sets the current language. 03517 proc snippets_set_language {lang} { 03518 03519 variable widgets 03520 variable snip_data 03521 03522 # Save the snippets data 03523 set snip_data(lang) $lang 03524 03525 # Update the language menubutton text 03526 $widgets(snippets_lang) configure -text $lang 03527 03528 # Set language of text widget 03529 syntax::set_language $widgets(snippets_text) $lang 03530 03531 # Loads the snippet tabl 03532 snippets_load_table $lang 03533 03534 } 03535 03536 ###################################################################### 03537 # Loads the current language into the snippets table. 03538 proc snippets_load_table {lang} { 03539 03540 variable widgets 03541 variable snip_data 03542 03543 # Clear the table 03544 $widgets(snippets_tl) delete 0 end 03545 03546 # Get the snippets list and add it to the table. 03547 foreach item [snippets::load_list $lang] { 03548 $widgets(snippets_tl) insert end $item 03549 } 03550 03551 } 03552 03553 ###################################################################### 03554 # Saves the current snippets table to file. 03555 proc snippets_save_table {} { 03556 03557 variable widgets 03558 variable snip_data 03559 03560 snippets::save_list [$widgets(snippets_tl) get 0 end] $snip_data(lang) 03561 03562 } 03563 03564 ###################################################################### 03565 # Called when the snippet keyword entry value changes. 03566 proc snippets_keyword_changed {value} { 03567 03568 variable widgets 03569 03570 if {([$widgets(snippets_text) get 1.0 end-1c] ne "") && ($value ne "")} { 03571 $widgets(snippets_save) configure -state normal 03572 } else { 03573 $widgets(snippets_save) configure -state disabled 03574 } 03575 03576 return 1 03577 03578 } 03579 03580 ###################################################################### 03581 # Called when the snippet text widget changed. 03582 proc snippets_text_changed {} { 03583 03584 variable widgets 03585 03586 if {([$widgets(snippets_text) get 1.0 end-1c] ne "") && 03587 ([$widgets(snippets_keyword) get] ne "")} { 03588 $widgets(snippets_save) configure -state normal 03589 } else { 03590 $widgets(snippets_save) configure -state disabled 03591 } 03592 03593 return 1 03594 03595 } 03596 03597 ###################################################################### 03598 # Displays the insert menu. 03599 proc snippets_insert {} { 03600 03601 variable widgets 03602 03603 set menu_width [winfo reqwidth $widgets(snippets_ins_menu)] 03604 set menu_height [winfo reqheight $widgets(snippets_ins_menu)] 03605 set w_width [winfo width $widgets(snippets_ins)] 03606 set w_x [winfo rootx $widgets(snippets_ins)] 03607 set w_y [winfo rooty $widgets(snippets_ins)] 03608 03609 set x $w_x 03610 set y [expr $w_y - ($menu_height + 4)] 03611 03612 tk_popup $widgets(snippets_ins_menu) $x $y 03613 03614 } 03615 03616 ###################################################################### 03617 # Inserts the given string into the snippets text widget. 03618 proc snippets_insert_str {str} { 03619 03620 variable widgets 03621 03622 # Insert the string 03623 $widgets(snippets_text) insert insert $str 03624 03625 # Give the text widget focus. 03626 focus $widgets(snippets_text).t 03627 03628 } 03629 03630 ###################################################################### 03631 # Save the snippet information to the table and then perform a table save. 03632 proc snippets_save {} { 03633 03634 variable widgets 03635 variable snip_data 03636 03637 # Get the frame contents 03638 set keyword [$widgets(snippets_keyword) get] 03639 set content [gui::scrub_text $widgets(snippets_text)] 03640 03641 # Add/modify to the table 03642 switch $snip_data(edit_type) { 03643 "add" { $widgets(snippets_tl) insert end [list $keyword $content] } 03644 "edit" { $widgets(snippets_tl) rowconfigure $snip_data(edit_row) -text [list $keyword $content] } 03645 } 03646 03647 # Save the table 03648 snippets_save_table 03649 03650 # Clear the fields 03651 $widgets(snippets_keyword) delete 0 end 03652 $widgets(snippets_text) delete 1.0 end 03653 $widgets(snippets_save) configure -state disabled 03654 03655 # Display the table frame 03656 pack forget $widgets(snippets_ef) 03657 pack $widgets(snippets_tf) -fill both -expand yes 03658 03659 } 03660 03661 ###################################################################### 03662 # Cancels the snippet editing process and displays the snippet table. 03663 proc snippets_cancel {} { 03664 03665 variable widgets 03666 03667 # Clear the fields 03668 $widgets(snippets_keyword) delete 0 end 03669 $widgets(snippets_text) delete 1.0 end 03670 $widgets(snippets_save) configure -state disabled 03671 03672 # Display the table frame 03673 pack forget $widgets(snippets_ef) 03674 pack $widgets(snippets_tf) -fill both -expand yes 03675 03676 } 03677 03678 ############# 03679 # SHORTCUTS # 03680 ############# 03681 03682 ###################################################################### 03683 # Create the shortcuts panel. 03684 proc create_shortcuts {w} { 03685 03686 variable widgets 03687 variable prefs 03688 03689 if {[tk windowingsystem] eq "aqua"} { 03690 set mod_width 6 03691 } else { 03692 set mod_width 20 03693 } 03694 03695 ttk::frame $w.sf 03696 wmarkentry::wmarkentry $w.sf.search -width 30 -watermark [msgcat::mc "Search Shortcuts"] \ 03697 -validate key -validatecommand [list pref_ui::shortcut_search %P] 03698 ttk::button $w.sf.revert -style BButton -text [msgcat::mc "Use Default"] -command [list pref_ui::shortcut_use_default] 03699 03700 pack $w.sf.search -side left -padx 2 -pady 2 03701 pack $w.sf.revert -side right -padx 2 -pady 2 03702 03703 ttk::frame $w.tf 03704 set widgets(shortcut_tl) [tablelist::tablelist $w.tf.tl \ 03705 -columns [list 0 [msgcat::mc "Menu Item"] 0 [msgcat::mc "Shortcut"] 0 {}] \ 03706 -height 20 -exportselection 0 -stretch all -borderwidth 0 -highlightthickness 0 \ 03707 -tooltipaddcommand pref_ui::shortcut_show_tooltip -tooltipdelcommand pref_ui::shortcut_hide_tooltip \ 03708 -yscrollcommand [list $w.tf.vb set]] 03709 scroller::scroller $w.tf.vb -orient vertical -command [list $w.tf.tl yview] 03710 03711 utils::tablelist_configure $widgets(shortcut_tl) 03712 03713 $widgets(shortcut_tl) columnconfigure 0 -name label -editable 0 -resizable 0 -stretchable 1 -maxwidth 50 03714 $widgets(shortcut_tl) columnconfigure 1 -name shortcut -editable 0 -resizable 0 -stretchable 0 -formatcommand [list pref_ui::shortcut_format] 03715 $widgets(shortcut_tl) columnconfigure 2 -name clear -hide 1 03716 03717 bind [$widgets(shortcut_tl) bodytag] <Return> [list pref_ui::shortcut_table_select] 03718 bind [$widgets(shortcut_tl) bodytag] <Key-space> [list pref_ui::shortcut_table_select] 03719 bind [$widgets(shortcut_tl) bodytag] <Escape> [list pref_ui::shortcut_cancel] 03720 bind [$widgets(shortcut_tl) bodytag] <Delete> [list pref_ui::shortcut_clear] 03721 bind [$widgets(shortcut_tl) bodytag] <Double-Button-1> [list pref_ui::shortcut_table_select] 03722 03723 set bwidth [msgcat::mcmax "Clear" "Set" "Cancel"] 03724 03725 set widgets(shortcut_frame) [ttk::frame $w.tf.sf] 03726 ttk::label $w.tf.sf.l -text [format "%s: " [msgcat::mc "Shortcut"]] 03727 set widgets(shortcut_mod) [ttk::combobox $w.tf.sf.mod -width $mod_width -height 5 -state readonly] 03728 set widgets(shortcut_sym) [ttk::combobox $w.tf.sf.sym -width 5 -height 5 -state readonly] 03729 set widgets(shortcut_clear) [ttk::button $w.tf.sf.clear -style BButton -text [msgcat::mc "Clear"] -width $bwidth -command [list pref_ui::shortcut_clear]] 03730 set widgets(shortcut_update) [ttk::button $w.tf.sf.update -style BButton -text [msgcat::mc "Set"] -width $bwidth -state disabled -command [list pref_ui::shortcut_update]] 03731 ttk::button $w.tf.sf.cancel -style BButton -text [msgcat::mc "Cancel"] -width $bwidth -command [list pref_ui::shortcut_cancel] 03732 03733 bind $widgets(shortcut_mod) <<ComboboxSelected>> [list pref_ui::shortcut_changed] 03734 bind $widgets(shortcut_mod) <Escape> [list pref_ui::shortcut_cancel] 03735 bind $widgets(shortcut_sym) <<ComboboxSelected>> [list pref_ui::shortcut_changed] 03736 bind $widgets(shortcut_sym) <Escape> [list pref_ui::shortcut_cancel] 03737 bind $widgets(shortcut_clear) <Escape> [list pref_ui::shortcut_cancel] 03738 bind $widgets(shortcut_update) <Escape> [list pref_ui::shortcut_cancel] 03739 bind $w.tf.sf.cancel <Escape> [list pref_ui::shortcut_cancel] 03740 03741 pack $w.tf.sf.l -side left -padx 2 -pady 2 03742 pack $w.tf.sf.mod -side left -padx 2 -pady 2 03743 pack $w.tf.sf.sym -side left -padx 2 -pady 2 03744 pack $w.tf.sf.cancel -side right -padx 2 -pady 2 03745 pack $w.tf.sf.update -side right -padx 2 -pady 2 03746 pack $w.tf.sf.clear -side right -padx 2 -pady 2 03747 03748 set widgets(shortcut_note) [ttk::frame $w.tf.nf] 03749 ttk::label $w.tf.nf.l -style HLabel -text [msgcat::mc "Select a shortcut and hit the Return or Space key to edit the shortcut"] 03750 03751 pack $w.tf.nf.l -fill x -padx 2 -pady 2 03752 03753 grid rowconfigure $w.tf 1 -weight 1 03754 grid columnconfigure $w.tf 0 -weight 1 03755 grid $w.tf.tl -row 0 -column 0 -sticky news -rowspan 2 03756 grid [$w.tf.tl cornerpath] -row 0 -column 1 -sticky news 03757 grid $w.tf.vb -row 1 -column 1 -sticky ns 03758 grid $w.tf.sf -row 2 -column 0 -sticky ew -columnspan 2 03759 grid $w.tf.nf -row 3 -column 0 -sticky ew -columnspan 2 03760 03761 # Hide the shortcut frame 03762 grid remove $w.tf.sf 03763 03764 pack $w.sf -fill x 03765 pack $w.tf -fill both -expand yes -padx 2 -pady 2 03766 03767 # Register the option for search 03768 register $widgets(shortcut_tl) [msgcat::mc "Menu bindings"] Shortcuts 03769 register $widgets(shortcut_tl) [msgcat::mc "Shortcuts"] Shortcuts 03770 03771 # Populate the table 03772 populate_shortcut_table .menubar 03773 03774 } 03775 03776 ###################################################################### 03777 # Performs a real-time search of the given value. 03778 proc shortcut_search {value} { 03779 03780 variable widgets 03781 03782 if {$value eq ""} { 03783 for {set i 0} {$i < [$widgets(shortcut_tl) size]} {incr i} { 03784 $widgets(shortcut_tl) rowconfigure $i -hide 0 03785 } 03786 } else { 03787 for {set i 0} {$i < [$widgets(shortcut_tl) size]} {incr i} { 03788 if {[string match -nocase *$value* [$widgets(shortcut_tl) cellcget $i,label -text]]} { 03789 $widgets(shortcut_tl) rowconfigure $i -hide 0 03790 } else { 03791 $widgets(shortcut_tl) rowconfigure $i -hide 1 03792 } 03793 } 03794 } 03795 03796 return 1 03797 03798 } 03799 03800 ###################################################################### 03801 # Checks with the user to verify that they want to revert to using the 03802 # default menu bindings. If the answer was yes, 03803 proc shortcut_use_default {} { 03804 03805 variable widgets 03806 03807 set msg [msgcat::mc "Delete user bindings and use default?"] 03808 set detail [msgcat::mc "This operation cannot be reversed."] 03809 03810 # Get confirmation from the user 03811 set ans [tk_messageBox -parent .prefwin -icon question -type yesno -default yes -message $msg -detail $detail] 03812 03813 if {$ans eq "yes"} { 03814 03815 # Clear the shortcut editor (in case its visible) 03816 shortcut_cancel 03817 03818 # Revert the bindings and set them up using the new values 03819 bindings::use_default 03820 03821 # Clear the shortcut table 03822 $widgets(shortcut_tl) delete 0 end 03823 03824 # Re-populate the shortcut table with the updated values 03825 populate_shortcut_table .menubar 03826 03827 } 03828 03829 } 03830 03831 ###################################################################### 03832 # Returns true if the current symbol displayed in the symbol widget is 03833 # a function key. 03834 proc shortcut_sym_is_funckey {} { 03835 03836 variable widgets 03837 03838 return [regexp {^F\d+$} [$widgets(shortcut_sym) get]] 03839 03840 } 03841 03842 ###################################################################### 03843 # Called whenever the modifier or symbol combobox change. Handles the 03844 # state of the Update button and update the values available in the 03845 # combobox value lists. 03846 proc shortcut_changed {} { 03847 03848 variable widgets 03849 03850 # Get the widget contents 03851 set mod [$widgets(shortcut_mod) get] 03852 set sym [$widgets(shortcut_sym) get] 03853 03854 # Make sure that the Update button is enabled 03855 if {(($mod ne "") && ($sym ne "")) || [shortcut_sym_is_funckey]} { 03856 $widgets(shortcut_update) configure -state normal 03857 } 03858 03859 # Update the modifier and symbol lists after checking for matches 03860 shortcut_check_matches 03861 03862 } 03863 03864 ###################################################################### 03865 # Check the current value in the comboboxes and compares them against 03866 # the values in the table. Updates the combobox value lists with the 03867 # available values that will not cause a mismatch to occur. 03868 proc shortcut_check_matches {} { 03869 03870 variable widgets 03871 variable mod_dict 03872 variable sym_dict 03873 03874 # Get the current modifier 03875 if {[tk windowingsystem] eq "aqua"} { 03876 set curr_mod [list] 03877 foreach elem [split [$widgets(shortcut_mod) get] ""] { 03878 lappend curr_mod [lindex [bindings::accelerator_mapping $elem] 1] 03879 } 03880 } else { 03881 set curr_mod [split [$widgets(shortcut_mod) get] -] 03882 } 03883 03884 # Get the current symbol 03885 set curr_sym [$widgets(shortcut_sym) get] 03886 03887 # Create dictionaries from the mod_dict and sym_dict dictionaries 03888 set mods [dict create {*}[dict get $mod_dict]] 03889 set syms [dict create {*}[dict get $sym_dict]] 03890 03891 # If the symbol widget is not displaying a function key, remove the empty space modifier 03892 if {![shortcut_sym_is_funckey]} { 03893 catch { dict unset mods {} } 03894 } 03895 03896 # If we are on macOS, we need to remove dead keys and other keys that 03897 # would cause problems 03898 if {[tk windowingsystem] eq "aqua"} { 03899 if {[lsearch [list E I U Up Down Left Right] $curr_sym] != -1} { 03900 catch { dict unset mods Alt } 03901 } 03902 if {$curr_mod eq "Alt"} { 03903 catch { dict unset syms E I U Up Down Left Right } 03904 } 03905 } 03906 03907 # Iterate through the table finding partial matches 03908 foreach tl_shortcut [$widgets(shortcut_tl) getcolumn shortcut] { 03909 if {$tl_shortcut ne ""} { 03910 if {[string range $tl_shortcut end-1 end] eq "--"} { 03911 set tl_list [split [string range $tl_shortcut 0 end-2] -] 03912 lappend tl_list "-" 03913 } else { 03914 set tl_list [split $tl_shortcut -] 03915 } 03916 if {[llength $tl_list] == 1} { 03917 set tl_mod "" 03918 } else { 03919 set tl_mod [lrange $tl_list 0 end-1] 03920 } 03921 set tl_sym [lindex $tl_list end] 03922 if {$curr_mod eq $tl_mod} { 03923 catch { dict unset syms $tl_sym } 03924 } 03925 if {$curr_sym eq $tl_sym} { 03926 catch { dict unset mods $tl_mod } 03927 } 03928 } 03929 } 03930 03931 # Set the widgets 03932 $widgets(shortcut_mod) configure -values [dict values $mods] 03933 $widgets(shortcut_sym) configure -values [dict values $syms] 03934 03935 } 03936 03937 ###################################################################### 03938 # Displays a tooltip if the current cell contains snipped text. 03939 proc shortcut_show_tooltip {tbl row col} { 03940 03941 if {($row >= 0) && [$tbl iselemsnipped $row,$col full_text]} { 03942 tooltip::tooltip $tbl $full_text 03943 } 03944 03945 } 03946 03947 ###################################################################### 03948 # Removes the tooltip. 03949 proc shortcut_hide_tooltip {tbl} { 03950 03951 tooltip::tooltip clear $tbl 03952 03953 } 03954 03955 ###################################################################### 03956 # Edits the named shortcut item 03957 proc shortcut_edit_item {mnu lbl} { 03958 03959 variable widgets 03960 03961 set mnu_path "" 03962 while {$mnu ne ".menubar"} { 03963 set parent_mnu [winfo parent $mnu] 03964 for {set i 0} {$i <= [$parent_mnu index end]} {incr i} { 03965 if {([$parent_mnu type $i] eq "cascade") && ([$parent_mnu entrycget $i -menu] eq $mnu)} { 03966 set mnu_path "[$parent_mnu entrycget $i -label]/$mnu_path" 03967 break 03968 } 03969 } 03970 set mnu $parent_mnu 03971 } 03972 03973 # Create the full label based on the menu and label name 03974 set lbl "$mnu_path$lbl" 03975 03976 # Search the table for the matching menu item (if none is found return) 03977 if {[set row [$widgets(shortcut_tl) searchcolumn label $lbl]] == -1} { 03978 return 03979 } 03980 03981 # Select the row in the tabl 03982 $widgets(shortcut_tl) selection clear 0 end 03983 $widgets(shortcut_tl) selection set $row 03984 $widgets(shortcut_tl) see $row 03985 03986 # Initiate the table selection 03987 shortcut_table_select 03988 03989 } 03990 03991 ###################################################################### 03992 # Handles a selection of the shortcut table. 03993 proc shortcut_table_select {} { 03994 03995 variable widgets 03996 03997 # Get the current selection 03998 set selected [$widgets(shortcut_tl) curselection] 03999 04000 if {$selected eq ""} { 04001 04002 # Hide the shortcut frame 04003 grid remove $widgets(shortcut_frame) 04004 grid $widgets(shortcut_note) 04005 04006 } else { 04007 04008 # Get the current shortcut menu from the table 04009 set shortcut [$widgets(shortcut_tl) cellcget $selected,shortcut -text] 04010 set value [list "" "" "" "" ""] 04011 04012 # If the shortcut contains the minus key, pull it off and adjust the rest of the shortcut string 04013 if {[string range $shortcut end-1 end] eq "--"} { 04014 lset value 4 "-" 04015 set shortcut [string range $shortcut 0 end-2] 04016 } 04017 04018 # Setup the value list 04019 if {[tk windowingsystem] eq "aqua"} { 04020 foreach elem [split $shortcut -] { 04021 lset value {*}[bindings::accelerator_mapping $elem] 04022 } 04023 } else { 04024 foreach elem [split $shortcut -] { 04025 lset value [lindex [bindings::accelerator_mapping $elem] 0] $elem 04026 } 04027 } 04028 04029 # Set the current modifier and symbol 04030 if {[tk windowingsystem] eq "aqua"} { 04031 $widgets(shortcut_mod) set [join [lrange $value 0 3] ""] 04032 } else { 04033 $widgets(shortcut_mod) set [join [concat {*}[lrange $value 0 3]] "-"] 04034 } 04035 $widgets(shortcut_sym) set [lindex $value 4] 04036 04037 # Make sure the Clear button state is set correctly 04038 if {$shortcut eq ""} { 04039 $widgets(shortcut_clear) configure -state disabled 04040 } else { 04041 $widgets(shortcut_clear) configure -state normal 04042 } 04043 04044 # Disable the Update button 04045 $widgets(shortcut_update) configure -state disabled 04046 04047 # Update the modifier and symbol lists after checking for matches 04048 shortcut_check_matches 04049 04050 # Display the shortcut frame 04051 grid remove $widgets(shortcut_note) 04052 grid $widgets(shortcut_frame) 04053 04054 # Set the focus on the modifier 04055 focus $widgets(shortcut_mod) 04056 04057 } 04058 04059 } 04060 04061 ###################################################################### 04062 # Called prior to posting the modifier menu. 04063 proc shortcut_create_modifiers {} { 04064 04065 variable widgets 04066 variable mod_dict 04067 04068 set mod_dict [dict create] 04069 04070 switch [tk windowingsystem] { 04071 aqua { 04072 set mods [list {} Cmd Ctrl Alt \ 04073 Ctrl-Cmd Alt-Cmd Shift-Cmd Ctrl-Shift Ctrl-Alt Shift-Alt \ 04074 Ctrl-Alt-Cmd Ctrl-Alt-Shift Ctrl-Shift-Cmd Alt-Shift-Cmd \ 04075 Ctrl-Alt-Shift-Cmd] 04076 } 04077 win32 - 04078 x11 { 04079 set mods [list {} Ctrl Alt \ 04080 Shift-Ctrl Ctrl-Alt Shift-Alt \ 04081 Shift-Ctrl-Alt] 04082 } 04083 } 04084 04085 if {[tk windowingsystem] eq "aqua"} { 04086 foreach mod $mods { 04087 set value [list "" "" "" ""] 04088 foreach elem [split $mod -] { 04089 lset value {*}[bindings::accelerator_mapping $elem] 04090 } 04091 dict set mod_dict $mod [join $value ""] 04092 } 04093 } else { 04094 foreach mod $mods { 04095 dict set mod_dict $mod $mod 04096 } 04097 } 04098 04099 } 04100 04101 ###################################################################### 04102 # Called prior to posting the symbol menu. 04103 proc shortcut_create_symbols {} { 04104 04105 variable widgets 04106 variable sym_dict 04107 04108 set sym_dict [dict create] 04109 set syms [list A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0 1 2 3 \ 04110 4 5 6 7 8 9 ~ ! @ \# \$ % ^ & {\*} ( ) _ + ` - = \{ \} \[ \] | \\ : \ 04111 {;} \" \' < , > . {\?} / Up Down Left Right Space Tab \ 04112 F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12] 04113 04114 if {[tk windowingsystem] eq "aqua"} { 04115 foreach sym $syms { 04116 dict set sym_dict $sym [lindex [bindings::accelerator_mapping $sym] 1] 04117 } 04118 } else { 04119 foreach sym $syms { 04120 dict set sym_dict $sym $sym 04121 } 04122 } 04123 04124 } 04125 04126 ###################################################################### 04127 # Clears the shortcut values and saves the change. 04128 proc shortcut_clear {} { 04129 04130 variable widgets 04131 04132 # Get the currently selected row 04133 set selected [$widgets(shortcut_tl) curselection] 04134 04135 # Set the shortcut cell value 04136 $widgets(shortcut_tl) cellconfigure $selected,shortcut -text "" 04137 $widgets(shortcut_tl) cellconfigure $selected,clear -text 1 04138 04139 # Save the table to the menu binding file 04140 shortcut_save 04141 04142 # Close the shortcut after clearing 04143 shortcut_cancel 04144 04145 } 04146 04147 ###################################################################### 04148 # Updates the shortcut table with the current value in the editor. 04149 # Hides the shortcut editor frame after the update occurs. 04150 proc shortcut_update {} { 04151 04152 variable widgets 04153 04154 set value "" 04155 set sym [$widgets(shortcut_sym) get] 04156 04157 if {[set mod [$widgets(shortcut_mod) get]] ne ""} { 04158 if {$mod ne ""} { 04159 if {[tk windowingsystem] eq "aqua"} { 04160 set value [list "" "" "" "" ""] 04161 foreach elem [list {*}[split $mod ""] $sym] { 04162 lset value {*}[bindings::accelerator_mapping $elem] 04163 } 04164 set value [join [concat {*}$value] -] 04165 } else { 04166 set value "$mod-$sym" 04167 } 04168 } 04169 } else { 04170 set value $sym 04171 } 04172 04173 # Get the currently selected shortcut 04174 set selected [$widgets(shortcut_tl) curselection] 04175 04176 # Set the shortcut cell value 04177 $widgets(shortcut_tl) cellconfigure $selected,shortcut -text $value 04178 $widgets(shortcut_tl) cellconfigure $selected,clear -text 0 04179 04180 # Save the table to the menu binding file 04181 shortcut_save 04182 04183 # Close the editor 04184 shortcut_cancel 04185 04186 } 04187 04188 ###################################################################### 04189 # Saves the shortcut table to the menu binding file. 04190 proc shortcut_save {} { 04191 04192 variable widgets 04193 04194 set rows [list] 04195 set max 0 04196 04197 # Get the table rows to save 04198 for {set i 0} {$i < [$widgets(shortcut_tl) size]} {incr i} { 04199 lassign [$widgets(shortcut_tl) get $i] mnu_path shortcut cleared 04200 if {($shortcut ne "") || $cleared} { 04201 if {[set mnu_len [string length $mnu_path]] > $max} { 04202 set max $mnu_len 04203 } 04204 lappend rows [list $mnu_path $shortcut] 04205 } 04206 } 04207 04208 # Save the given bindings to the menu bindings file 04209 bindings::save $max $rows 04210 04211 } 04212 04213 ###################################################################### 04214 # Closes the shortcut editor frame. 04215 proc shortcut_cancel {} { 04216 04217 variable widgets 04218 04219 # Remove the shortcut editor frame 04220 grid remove $widgets(shortcut_frame) 04221 grid $widgets(shortcut_note) 04222 04223 # Put the focus back on the shortcut table 04224 focus [$widgets(shortcut_tl) bodypath] 04225 04226 } 04227 04228 ###################################################################### 04229 # Formats the shortcut value in the shortcut table. 04230 proc shortcut_format {value} { 04231 04232 if {[tk windowingsystem] eq "aqua"} { 04233 set new_value [list "" "" "" "" ""] 04234 if {[string range $value end-1 end] eq "--"} { 04235 lset new_value 4 "-" 04236 set value [string range $value 0 end-2] 04237 } 04238 foreach elem [split $value -] { 04239 lset new_value {*}[bindings::accelerator_mapping $elem] 04240 } 04241 set value [join $new_value ""] 04242 } 04243 04244 return $value 04245 04246 } 04247 04248 ###################################################################### 04249 # Recursively adds all menu commands, checkbuttons and radiobuttons to 04250 # the shortcut table. 04251 proc populate_shortcut_table {mnu {prefix ""}} { 04252 04253 variable widgets 04254 04255 # If there are no elements return 04256 if {[set last [$mnu index end]] eq "none"} { 04257 return 04258 } 04259 04260 for {set i 0} {$i <= $last} {incr i} { 04261 set type [$mnu type $i] 04262 switch $type { 04263 cascade { 04264 if {[string index [$mnu entrycget $i -label] 0] ne " "} { 04265 set lbl [string trim [$mnu entrycget $i -label]] 04266 populate_shortcut_table [$mnu entrycget $i -menu] "$prefix$lbl/" 04267 } 04268 } 04269 command - 04270 checkbutton - 04271 radiobutton { 04272 set lbl [string trim [$mnu entrycget $i -label]] 04273 if {(($type ne "command") || ([$mnu entrycget $i -command] ne "")) && ([string index [$mnu entrycget $i -label] 0] ne " ")} { 04274 set name "$prefix$lbl" 04275 $widgets(shortcut_tl) insert end [list $name [$mnu entrycget $i -accelerator] [bindings::is_cleared $name]] 04276 } 04277 } 04278 } 04279 } 04280 04281 } 04282 04283 ########### 04284 # PLUGINS # 04285 ########### 04286 04287 ###################################################################### 04288 # Creates the plugins panel. 04289 proc create_plugins {w} { 04290 04291 variable widgets 04292 variable prefs 04293 04294 set widgets(plugins_mb) [ttk::menubutton $w.mb -text [msgcat::mc "Select a plugin"] -menu [menu $w.pluginsMenu -tearoff 0]] 04295 set widgets(plugins_nb) [ttk::notebook $w.nb -style Plain.TNotebook] 04296 04297 pack $widgets(plugins_mb) -padx 2 -pady 2 04298 pack $widgets(plugins_nb) -fill both -expand yes -padx 2 -pady 2 04299 04300 $widgets(plugins_nb) add [ttk::frame $widgets(plugins_nb)._none] 04301 $widgets(plugins_nb) hide $widgets(plugins_nb)._none 04302 04303 # Create the plugin frames 04304 foreach plugin [plugins::handle_on_pref_ui $widgets(plugins_nb)] { 04305 $w.pluginsMenu add command -label $plugin -command [list pref_ui::handle_plugins_change $plugin] 04306 } 04307 04308 } 04309 04310 ###################################################################### 04311 # Handles a change to the currently selected plugin. Changes the text 04312 # in the menubutton and displays the plugin's preference frame. 04313 proc handle_plugins_change {plugin} { 04314 04315 variable widgets 04316 04317 # Change the menubutton text 04318 $widgets(plugins_mb) configure -text $plugin 04319 04320 # Select the needed frame 04321 $widgets(plugins_nb) select $widgets(plugins_nb).$plugin 04322 04323 04324 } 04325 04326 ################# 04327 # DOCUMENTATION # 04328 ################# 04329 04330 ###################################################################### 04331 # Creates the documentation preference panel, populates and initializes it. 04332 proc create_documentation {w} { 04333 04334 variable widgets 04335 variable prefs 04336 04337 ttk::frame $w.tf 04338 set widgets(doc,table) [tablelist::tablelist $w.tf.tl \ 04339 -columns [list 0 [msgcat::mc "Name"] 0 URL] \ 04340 -exportselection 0 -stretch all -editselectedonly 1 \ 04341 -borderwidth 0 -highlightthickness 0 \ 04342 -movablerows 1 -movecursor [ttk::cursor move] -selectmode single \ 04343 -yscrollcommand [list utils::set_yscrollbar $w.tf.vb]] 04344 scroller::scroller $w.tf.vb -orient vertical -command [list $w.tf.tl yview] 04345 04346 utils::tablelist_configure $w.tf.tl 04347 04348 $w.tf.tl columnconfigure 0 -name name -editable 1 -resizable 1 -stretchable 1 04349 $w.tf.tl columnconfigure 1 -name url -editable 1 -resizable 1 -stretchable 1 04350 04351 bind $w.tf.tl <<TablelistSelect>> [list pref_ui::documentation_selected] 04352 bind $w.tf.tl <<TablelistCellUpdated>> [list pref_ui::documentation_save] 04353 bind $w.tf.tl <<TablelistRowMoved>> [list pref_ui::documentation_save] 04354 04355 grid rowconfigure $w.tf 1 -weight 1 04356 grid columnconfigure $w.tf 0 -weight 1 04357 grid $w.tf.tl -row 0 -column 0 -sticky news -rowspan 2 04358 grid [$w.tf.tl cornerpath] -row 0 -column 1 -sticky news 04359 grid $w.tf.vb -row 1 -column 1 -sticky ns 04360 04361 ttk::frame $w.bf 04362 ttk::button $w.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::documentation_add] 04363 set widgets(doc,delete) [ttk::button $w.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::documentation_delete] -state disabled] 04364 set widgets(doc,test) [ttk::button $w.bf.test -style BButton -text [msgcat::mc "Test"] -command [list pref_ui::documentation_test] -state disabled] 04365 04366 pack $w.bf.add -side left -padx 2 -pady 2 04367 pack $w.bf.del -side left -padx 2 -pady 2 04368 pack $w.bf.test -side right -padx 2 -pady 2 04369 04370 pack $w.tf -fill both -expand yes 04371 pack $w.bf -fill x 04372 04373 # Register the table 04374 register $w.tf.tl [msgcat::mc "Language Documentation"] Documentation/References 04375 04376 # Initialize the table on initialization 04377 register_initialization pref_ui::documentation_populate 04378 04379 } 04380 04381 ###################################################################### 04382 # Called whenever a documentation row is selected in the table. 04383 proc documentation_selected {} { 04384 04385 variable widgets 04386 04387 if {[set selected [$widgets(doc,table) curselection]] ne ""} { 04388 $widgets(doc,delete) configure -state normal 04389 $widgets(doc,test) configure -state normal 04390 } else { 04391 $widgets(doc,delete) configure -state disabled 04392 $widgets(doc,test) configure -state disabled 04393 } 04394 04395 } 04396 04397 ###################################################################### 04398 # Adds a documentation row to the table. 04399 proc documentation_add {} { 04400 04401 variable widgets 04402 04403 toplevel .prefwin.docwin 04404 wm title .prefwin.docwin [format "%s URL" [msgcat::mc "Add Language Reference"]] 04405 wm transient .prefwin.docwin .prefwin 04406 wm resizable .prefwin.docwin 0 0 04407 04408 ttk::frame .prefwin.docwin.f 04409 ttk::label .prefwin.docwin.f.ul -text "URL: " 04410 ttk::entry .prefwin.docwin.f.url -validate key -validatecommand [list pref_ui::docwin_validate %P] -width 60 04411 04412 bind .prefwin.docwin.f.url <Return> [list .prefwin.docwin.bf.ok invoke] 04413 04414 pack .prefwin.docwin.f.ul -side left -padx 2 -pady 2 04415 pack .prefwin.docwin.f.url -side left -padx 2 -pady 2 04416 04417 set bwidth [msgcat::mcmax "Add" "Cancel"] 04418 04419 ttk::frame .prefwin.docwin.bf 04420 ttk::button .prefwin.docwin.bf.ok -style BButton -text [msgcat::mc "Add"] -width $bwidth -command { 04421 set url [.prefwin.docwin.f.url get] 04422 set name [pref_ui::docwin_get_title $url] 04423 set row [$pref_ui::widgets(doc,table) insert end [list $name $url]] 04424 $pref_ui::widgets(doc,table) see $row 04425 $pref_ui::widgets(doc,table) selection clear 0 end 04426 $pref_ui::widgets(doc,table) selection set $row 04427 $pref_ui::widgets(doc,delete) configure -state normal 04428 $pref_ui::widgets(doc,test) configure -state normal 04429 after idle [list pref_ui::documentation_save] 04430 destroy .prefwin.docwin 04431 } -state disabled 04432 ttk::button .prefwin.docwin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width $bwidth -command { 04433 destroy .prefwin.docwin 04434 } 04435 04436 pack .prefwin.docwin.bf.cancel -side right -padx 2 -pady 2 04437 pack .prefwin.docwin.bf.ok -side right -padx 2 -pady 2 04438 04439 pack .prefwin.docwin.f -fill both -expand yes 04440 pack .prefwin.docwin.bf -fill x 04441 04442 # Place the window in the middle of the preference window 04443 ::tk::PlaceWindow .prefwin.docwin widget .prefwin 04444 04445 # Get the grab and focus 04446 ::tk::SetFocusGrab .prefwin.docwin .prefwin.docwin.f.url 04447 04448 # Wait for the window to be closed 04449 tkwait window .prefwin.docwin 04450 04451 # Restore the focus and grab 04452 ::tk::RestoreFocusGrab .prefwin.docwin .prefwin.docwin.f.url 04453 04454 } 04455 04456 ###################################################################### 04457 # Validates the given entry field value along with the other value and 04458 # control the state of the Add button. 04459 proc docwin_validate {value} { 04460 04461 variable widgets 04462 04463 if {$value ne ""} { 04464 .prefwin.docwin.bf.ok configure -state active 04465 } else { 04466 .prefwin.docwin.bf.ok configure -state disabled 04467 } 04468 04469 return 1 04470 04471 } 04472 04473 ###################################################################### 04474 # Downloads the webpage and returns the title tag found in the HTML response. 04475 proc docwin_get_title {url} { 04476 04477 # If the URL contains a {query} substring, replace it with "foobar" 04478 set url [string map {\{query\} foobar} $url] 04479 04480 # Set the default value of title 04481 set title [msgcat::mc "Unknown"] 04482 04483 # Attempt to open the URL 04484 if {[catch { http::geturl $url } token]} { 04485 return $title 04486 } 04487 04488 # Check the return status 04489 if {([http::status $token] eq "ok") && ([http::ncode $token] == 200)} { 04490 set content [http::data $token] 04491 regexp -nocase {<title>(.*?)</title>} $content -> title 04492 } 04493 04494 # Cleanup the token 04495 http::cleanup $token 04496 04497 return $title 04498 04499 } 04500 04501 ###################################################################### 04502 # Deletes the currently selected row in the table. 04503 proc documentation_delete {} { 04504 04505 variable widgets 04506 variable prefs 04507 04508 # Get the currently selected row 04509 set selected [$widgets(doc,table) curselection] 04510 04511 # Delete the row in the table 04512 $widgets(doc,table) delete $selected 04513 04514 # Delete the preference value 04515 set prefs(Documentation/References) [lreplace $prefs(Documentation/References) $selected $selected] 04516 04517 # Set the delete/test button state to invalid 04518 $widgets(doc,delete) configure -state disabled 04519 $widgets(doc,test) configure -state disabled 04520 04521 } 04522 04523 ###################################################################### 04524 # Displays the given URL in a web browser. 04525 proc documentation_test {} { 04526 04527 variable widgets 04528 04529 # Get the currently selected row 04530 set selected [$widgets(doc,table) curselection] 04531 04532 # Get the URL to display 04533 if {[set url [$widgets(doc,table) cellcget $selected,url -text]] ne ""} { 04534 utils::open_file_externally $url 0 04535 } 04536 04537 } 04538 04539 ###################################################################### 04540 # Populates the given documentation table with the list of current results. 04541 proc documentation_populate {} { 04542 04543 variable widgets 04544 variable prefs 04545 04546 # Clear the table 04547 $widgets(doc,table) delete 0 end 04548 04549 # Populate the table 04550 foreach pref $prefs(Documentation/References) { 04551 $widgets(doc,table) insert end $pref 04552 } 04553 04554 } 04555 04556 ###################################################################### 04557 # Saves the contents of the current state of the documentation table. 04558 proc documentation_save {} { 04559 04560 variable widgets 04561 variable prefs 04562 04563 set references [list] 04564 for {set i 0} {$i < [$widgets(doc,table) size]} {incr i} { 04565 lappend references [list [$widgets(doc,table) cellcget $i,name -text] [$widgets(doc,table) cellcget $i,url -text]] 04566 } 04567 04568 # Set the Documentation/References preference variable with the list of values 04569 set prefs(Documentation/References) $references 04570 04571 } 04572 04573 ############ 04574 # ADVANCED # 04575 ############ 04576 04577 ###################################################################### 04578 # Creates the advanced panel. 04579 proc create_advanced {w} { 04580 04581 variable widgets 04582 variable prefs 04583 04584 ttk::notebook $w.nb 04585 04586 ########### 04587 # GENERAL # 04588 ########### 04589 04590 $w.nb add [set a [ttk::frame $w.nb.a]] -text [msgcat::mc "General"] 04591 04592 make_mb $a.dme [msgcat::mc "Default Markdown Export Extension"] General/DefaultMarkdownExportExtension [list html htm xhtml] 1 04593 make_spacer $a 1 04594 make_fp $a.dted [msgcat::mc "Default Theme Export Directory"] General/DefaultThemeExportDirectory dir {} 1 04595 make_fp $a.dped [msgcat::mc "Default Plugin Export Directory"] General/DefaultPluginExportDirectory dir {} 1 04596 04597 ############### 04598 # DEVELOPMENT # 04599 ############### 04600 04601 $w.nb add [set b [ttk::frame $w.nb.b]] -text [msgcat::mc "Development"] 04602 04603 make_cb $b.dm [msgcat::mc "Enable development mode"] Debug/DevelopmentMode 04604 make_cb $b.sdl [msgcat::mc "Show diagnostic logfile at startup"] Debug/ShowDiagnosticLogfileAtStartup 04605 make_cb $b.sc [msgcat::mc "Show Tcl console at startup"] View/ShowConsole 04606 make_spacer $b 04607 04608 make_fp $b.ld [msgcat::mc "Logfile Directory"] Debug/LogDirectory dir [list -title [msgcat::mc "Choose Logfile Directory"]] 04609 04610 make_spacer $b 04611 04612 ttk::labelframe $b.pf -text [msgcat::mc "Profiler Options"] 04613 make_mb $b.pf.prs [msgcat::mc "Sorting Column"] Tools/ProfileReportSortby [list calls real cpu real_per_call cpu_per_call] 04614 make_spacer $b.pf 04615 make_entry $b.pf.pro [msgcat::mc "Report Options"] Tools/ProfileReportOptions 04616 pack $b.pf -fill x -padx 2 -pady 10 04617 04618 ############## 04619 # NFS MOUNTS # 04620 ############## 04621 04622 $w.nb add [set c [ttk::frame $w.nb.c]] -text [set wstr [format "NFS %s" [msgcat::mc "Mounts"]]] 04623 04624 ttk::frame $c.f 04625 set widgets(advanced_tl) [tablelist::tablelist $c.f.tl \ 04626 -columns [list 0 [msgcat::mc "Host"] 0 [format "NFS %s" [msgcat::mc "Base Directory"]] 0 [msgcat::mc "Remote Base Directory"]] \ 04627 -exportselection 0 -stretch all -editselectedonly 1 -showseparators 1 \ 04628 -borderwidth 0 -highlightthickness 0 \ 04629 -editendcommand [list pref_ui::nfs_edit_end_command] \ 04630 -xscrollcommand [list utils::set_xscrollbar $c.f.hb] \ 04631 -yscrollcommand [list utils::set_yscrollbar $c.f.vb]] 04632 scroller::scroller $c.f.vb -orient vertical -command [list $c.f.tl yview] 04633 scroller::scroller $c.f.hb -orient horizontal -command [list $c.f.tl xview] 04634 04635 register $widgets(advanced_tl) $wstr NFSMounts 04636 04637 utils::tablelist_configure $widgets(advanced_tl) 04638 04639 $widgets(advanced_tl) columnconfigure 0 -name host -editable 1 -resizable 1 -stretchable 1 04640 $widgets(advanced_tl) columnconfigure 1 -name nfs -editable 1 -resizable 1 -stretchable 1 04641 $widgets(advanced_tl) columnconfigure 2 -name remote -editable 1 -resizable 1 -stretchable 1 04642 04643 bind $widgets(advanced_tl) <<TablelistSelect>> [list pref_ui::handle_nfs_select] 04644 04645 grid rowconfigure $c.f 1 -weight 1 04646 grid columnconfigure $c.f 0 -weight 1 04647 grid $c.f.tl -row 0 -column 0 -sticky news -rowspan 2 04648 grid [$c.f.tl cornerpath] -row 0 -column 1 -sticky news 04649 grid $c.f.vb -row 1 -column 1 -sticky ns 04650 grid $c.f.hb -row 2 -column 0 -sticky ew 04651 04652 ttk::frame $c.bf 04653 set widgets(advanced_nfs_add) [ttk::button $c.bf.add -style BButton -text [msgcat::mc "Add"] -command [list pref_ui::nfs_add]] 04654 set widgets(advanced_nfs_del) [ttk::button $c.bf.del -style BButton -text [msgcat::mc "Delete"] -command [list pref_ui::nfs_delete] -state disabled] 04655 04656 pack $c.bf.add -side left -padx 2 -pady 2 04657 pack $c.bf.del -side left -padx 2 -pady 2 04658 04659 pack $c.f -fill both -expand yes 04660 pack $c.bf -fill x 04661 04662 pack $w.nb -fill both -expand yes 04663 04664 # Initialize widget values 04665 foreach {host values} $prefs(NFSMounts) { 04666 lassign $values nfs_mount remote_mount 04667 $widgets(advanced_tl) insert end [list $host $nfs_mount $remote_mount] 04668 } 04669 04670 ################## 04671 # PROXY SETTINGS # 04672 ################## 04673 04674 $w.nb add [set d [ttk::frame $w.nb.d]] -text [set wstr [msgcat::mc "Proxy Settings"]] 04675 04676 make_entry $d.ph [msgcat::mc "Proxy Host"] General/ProxyHost 04677 make_entry $d.pp [msgcat::mc "Proxy Port"] General/ProxyPort 04678 make_help $d [msgcat::mc "Proxy settings are used when URL requests need to be made by TKE. If you do not require a proxy server, leave these entries empty."] 04679 04680 } 04681 04682 ###################################################################### 04683 # Sets the NFSMounts preference value to match the current state of the 04684 # table. 04685 proc set_nfs_mounts {} { 04686 04687 variable widgets 04688 variable prefs 04689 04690 set values [list] 04691 04692 for {set i 0} {$i < [$widgets(advanced_tl) size]} {incr i} { 04693 lassign [$widgets(advanced_tl) get $i] host nfs remote 04694 if {($host ne "") && ($nfs ne "") && ($remote ne "")} { 04695 lappend values $host [list $nfs $remote] 04696 } else { 04697 return 04698 } 04699 } 04700 04701 set prefs(NFSMounts) $values 04702 04703 } 04704 04705 ###################################################################### 04706 # Called when the tablelist cell is done being edited. 04707 proc nfs_edit_end_command {tbl row col value} { 04708 04709 after 1 [list pref_ui::set_nfs_mounts] 04710 04711 return $value 04712 04713 } 04714 04715 ###################################################################### 04716 # Adds a new line to the NFSMount table, selects it and forces it into 04717 # edit mode. 04718 proc nfs_add {} { 04719 04720 variable widgets 04721 04722 # Insert the blank row into the table 04723 set row [$widgets(advanced_tl) insert end [list "" "" ""]] 04724 04725 # Clear any selections and make the first cell editable 04726 $widgets(advanced_tl) selection clear 0 end 04727 $widgets(advanced_tl) editcell $row,host 04728 04729 # Disable the delete button 04730 $widgets(advanced_nfs_del) configure -state disabled 04731 04732 } 04733 04734 ###################################################################### 04735 # Deletes the currently selected table row. 04736 proc nfs_delete {} { 04737 04738 variable widgets 04739 04740 # Delete the current selection 04741 $widgets(advanced_tl) delete [$widgets(advanced_tl) curselection] 04742 04743 # Disable the delete button 04744 $widgets(advanced_nfs_del) configure -state disabled 04745 04746 # Update the NFSMounts preference value 04747 set_nfs_mounts 04748 04749 } 04750 04751 ###################################################################### 04752 # Handles any changes in the selection of the NFSMounts table. 04753 proc handle_nfs_select {} { 04754 04755 variable widgets 04756 04757 if {[$widgets(advanced_tl) curselection] ne ""} { 04758 $widgets(advanced_nfs_del) configure -state normal 04759 } else { 04760 $widgets(advanced_nfs_del) configure -state disabled 04761 } 04762 04763 } 04764 04765 ###################################################################### 04766 # Updates the theme for the given text widget. We'll just reuse the 04767 # procedure in gui since it does exactly what we want. 04768 proc update_theme {txt} { 04769 04770 gui::update_theme $txt 04771 04772 } 04773 04774 # Create the modifiers and symbols 04775 shortcut_create_modifiers 04776 shortcut_create_symbols 04777 04778 }